metacata command can now operate on many files at once
This commit is contained in:
parent
361aee0470
commit
0e9a72b356
4 changed files with 65 additions and 48 deletions
3
Annex.hs
3
Annex.hs
|
@ -58,6 +58,7 @@ import Types.UUID
|
|||
import Types.FileMatcher
|
||||
import Types.NumCopies
|
||||
import Types.LockPool
|
||||
import Types.MetaData
|
||||
import qualified Utility.Matcher
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
|
@ -109,6 +110,7 @@ data AnnexState = AnnexState
|
|||
, lockpool :: LockPool
|
||||
, flags :: M.Map String Bool
|
||||
, fields :: M.Map String String
|
||||
, modmeta :: [ModMeta]
|
||||
, cleanup :: M.Map String (Annex ())
|
||||
, inodeschanged :: Maybe Bool
|
||||
, useragent :: Maybe String
|
||||
|
@ -146,6 +148,7 @@ newState c r = AnnexState
|
|||
, lockpool = M.empty
|
||||
, flags = M.empty
|
||||
, fields = M.empty
|
||||
, modmeta = []
|
||||
, cleanup = M.empty
|
||||
, inodeschanged = Nothing
|
||||
, useragent = Nothing
|
||||
|
|
|
@ -8,6 +8,7 @@
|
|||
module Command.MetaData where
|
||||
|
||||
import Common.Annex
|
||||
import qualified Annex
|
||||
import Command
|
||||
import Logs.MetaData
|
||||
import Types.MetaData
|
||||
|
@ -15,27 +16,32 @@ import Types.MetaData
|
|||
import qualified Data.Set as S
|
||||
|
||||
def :: [Command]
|
||||
def = [command "metadata" (paramPair paramFile (paramRepeating "FIELD[+-]=VALUE")) seek
|
||||
def = [withOptions [setOption] $ command "metadata" paramPaths seek
|
||||
SectionUtility "sets metadata of a file"]
|
||||
|
||||
seek :: CommandSeek
|
||||
seek = withWords start
|
||||
|
||||
start :: [String] -> CommandStart
|
||||
start (file:settings) = ifAnnexed file
|
||||
go
|
||||
(error $ "not an annexed file, so cannot add metadata: " ++ file)
|
||||
setOption :: Option
|
||||
setOption = Option ['s'] ["set"] (ReqArg mkmod "field[+-]=value") "set metadata"
|
||||
where
|
||||
go (k, _b) = do
|
||||
showStart "metadata" file
|
||||
next $ perform k (map parse settings)
|
||||
start _ = error "specify a file and the metadata to set"
|
||||
mkmod p = case parseModMeta p of
|
||||
Left e -> error e
|
||||
Right modmeta -> Annex.changeState $
|
||||
\s -> s { Annex.modmeta = modmeta:Annex.modmeta s }
|
||||
|
||||
perform :: Key -> [Action] -> CommandPerform
|
||||
seek :: CommandSeek
|
||||
seek ps = do
|
||||
modmeta <- Annex.getState Annex.modmeta
|
||||
withFilesInGit (whenAnnexed $ start modmeta) ps
|
||||
|
||||
start :: [ModMeta] -> FilePath -> (Key, Backend) -> CommandStart
|
||||
start ms file (k, _) = do
|
||||
showStart "metadata" file
|
||||
next $ perform k ms
|
||||
|
||||
perform :: Key -> [ModMeta] -> CommandPerform
|
||||
perform k [] = next $ cleanup k
|
||||
perform k as = do
|
||||
perform k ms = do
|
||||
oldm <- getCurrentMetaData k
|
||||
let m = foldr (apply oldm) newMetaData as
|
||||
let m = foldl' unionMetaData newMetaData $ map (modMeta oldm) ms
|
||||
addMetaData k m
|
||||
next $ cleanup k
|
||||
|
||||
|
@ -46,27 +52,3 @@ cleanup k = do
|
|||
return True
|
||||
where
|
||||
showmeta (f, vs) = map (\v -> fromMetaField f ++ "=" ++ fromMetaValue v) $ S.toList vs
|
||||
|
||||
data Action
|
||||
= AddMeta MetaField MetaValue
|
||||
| DelMeta MetaField MetaValue
|
||||
| SetMeta MetaField MetaValue
|
||||
|
||||
parse :: String -> Action
|
||||
parse p = case lastMaybe f of
|
||||
Just '+' -> AddMeta (mkf f') v
|
||||
Just '-' -> DelMeta (mkf f') v
|
||||
_ -> SetMeta (mkf f) v
|
||||
where
|
||||
(f, sv) = separate (== '=') p
|
||||
f' = beginning f
|
||||
v = toMetaValue sv
|
||||
mkf fld = fromMaybe (badfield fld) (toMetaField fld)
|
||||
badfield fld = error $ "Illegal metadata field name, \"" ++ fld ++ "\""
|
||||
|
||||
apply :: MetaData -> Action -> MetaData -> MetaData
|
||||
apply _ (AddMeta f v) m = updateMetaData f v m
|
||||
apply _ (DelMeta f oldv) m = updateMetaData f (unsetMetaValue oldv) m
|
||||
apply oldm (SetMeta f v) m = updateMetaData f v $
|
||||
foldr (updateMetaData f) m $
|
||||
map unsetMetaValue $ S.toList $ currentMetaDataValues f oldm
|
||||
|
|
|
@ -12,6 +12,8 @@ module Types.MetaData (
|
|||
MetaField,
|
||||
MetaValue,
|
||||
CurrentlySet(..),
|
||||
serialize,
|
||||
deserialize,
|
||||
MetaSerializable,
|
||||
toMetaField,
|
||||
fromMetaField,
|
||||
|
@ -27,8 +29,9 @@ module Types.MetaData (
|
|||
currentMetaData,
|
||||
currentMetaDataValues,
|
||||
getAllMetaData,
|
||||
serialize,
|
||||
deserialize,
|
||||
ModMeta(..),
|
||||
modMeta,
|
||||
parseModMeta,
|
||||
prop_metadata_sane,
|
||||
prop_metadata_serialize
|
||||
) where
|
||||
|
@ -180,6 +183,35 @@ removeEmptyFields (MetaData m) = MetaData $ M.filter (not . S.null) m
|
|||
getAllMetaData :: MetaField -> MetaData -> S.Set MetaValue
|
||||
getAllMetaData f (MetaData m) = fromMaybe S.empty (M.lookup f m)
|
||||
|
||||
{- Ways that existing metadata can be modified -}
|
||||
data ModMeta
|
||||
= AddMeta MetaField MetaValue
|
||||
| DelMeta MetaField MetaValue
|
||||
| SetMeta MetaField MetaValue -- removes any existing values
|
||||
|
||||
{- Applies a ModMeta, generating the new MetaData.
|
||||
- Note that the new MetaData does not include all the
|
||||
- values set in the input metadata. It only contains changed values. -}
|
||||
modMeta :: MetaData -> ModMeta -> MetaData
|
||||
modMeta _ (AddMeta f v) = updateMetaData f v newMetaData
|
||||
modMeta _ (DelMeta f oldv) = updateMetaData f (unsetMetaValue oldv) newMetaData
|
||||
modMeta m (SetMeta f v) = updateMetaData f v $
|
||||
foldr (updateMetaData f) newMetaData $
|
||||
map unsetMetaValue $ S.toList $ currentMetaDataValues f m
|
||||
|
||||
{- Parses field=value, field+=value, field-=value -}
|
||||
parseModMeta :: String -> Either String ModMeta
|
||||
parseModMeta p = case lastMaybe f of
|
||||
Just '+' -> AddMeta <$> mkf f' <*> v
|
||||
Just '-' -> DelMeta <$> mkf f' <*> v
|
||||
_ -> SetMeta <$> mkf f <*> v
|
||||
where
|
||||
(f, sv) = separate (== '=') p
|
||||
f' = beginning f
|
||||
v = pure (toMetaValue sv)
|
||||
mkf fld = maybe (Left $ badfield fld) Right (toMetaField fld)
|
||||
badfield fld = "Illegal metadata field name, \"" ++ fld ++ "\""
|
||||
|
||||
{- Avoid putting too many fields in the map; extremely large maps make
|
||||
- the seriaization test slow due to the sheer amount of data.
|
||||
- It's unlikely that more than 100 fields of metadata will be used. -}
|
||||
|
|
|
@ -695,22 +695,22 @@ subdirectories).
|
|||
|
||||
# UTILITY COMMANDS
|
||||
|
||||
* `metadata file [field=value field+=value field-=value ...]`
|
||||
* `metadata [path ...] [-s field=value -s field+=value -s field-=value ...]`
|
||||
|
||||
Each file can have any number of metadata fields attached to it,
|
||||
which each in turn have any number of values. This sets metadata
|
||||
for a file, or if run without any values, shows its current metadata.
|
||||
for the specified file or files, or if run without any values, shows
|
||||
the current metadata.
|
||||
|
||||
To set a field's value, removing any old value(s), use field=value.
|
||||
To set a field's value, removing any old value(s), use -s field=value.
|
||||
|
||||
To add an additional value, use field+=value.
|
||||
To add an additional value, use -s field+=value.
|
||||
|
||||
To remove a value, use field-=value.
|
||||
To remove a value, use -s field-=value.
|
||||
|
||||
For example, to set some tags on a file:
|
||||
|
||||
git annex metadata annexscreencast.ogv tag+=video tag+=screencast
|
||||
|
||||
git annex metadata annexscreencast.ogv -s tag+=video -s tag+=screencast
|
||||
|
||||
* `migrate [path ...]`
|
||||
|
||||
|
|
Loading…
Reference in a new issue