aboutsummaryrefslogtreecommitdiff
path: root/Command/MetaData.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-02-12 21:12:22 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-02-12 21:30:33 -0400
commitcb0dad5172b743679d90c7fd6e490d4927ea5a76 (patch)
tree0f487cc027688a9e47749c9030099ed877e467a2 /Command/MetaData.hs
parent41e5f8dfe79d6db8b0bd1492d8f28caf6b24ef5f (diff)
add metadata command to get/set metadata
Adds metadata log, and command. Note that unsetting field values seems to currently be broken. And in general this has had all of 2 minutes worth of testing. This commit was sponsored by Julien Lefrique.
Diffstat (limited to 'Command/MetaData.hs')
-rw-r--r--Command/MetaData.hs73
1 files changed, 73 insertions, 0 deletions
diff --git a/Command/MetaData.hs b/Command/MetaData.hs
new file mode 100644
index 000000000..f2c4abcea
--- /dev/null
+++ b/Command/MetaData.hs
@@ -0,0 +1,73 @@
+{- git-annex command
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.MetaData where
+
+import Common.Annex
+import Command
+import Logs.MetaData
+import Types.MetaData
+
+import qualified Data.Set as S
+
+def :: [Command]
+def = [command "metadata" (paramPair paramFile (paramRepeating "FIELD[+-]=VALUE")) 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)
+ where
+ go (k, _b) = do
+ showStart "metadata" file
+ next $ perform k (map parse settings)
+start _ = error "specify a file and the metadata to set"
+
+perform :: Key -> [Action] -> CommandPerform
+perform k actions = do
+ m <- getCurrentMetaData k
+ if null actions
+ then next $ cleanup m
+ else do
+ let m' = foldr apply m actions
+ addMetaData k m'
+ next $ cleanup m'
+
+cleanup :: MetaData -> CommandCleanup
+cleanup m = do
+ showLongNote $ unlines $ concatMap showmeta $ fromMetaData $ currentMetaData m
+ 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 :: Action -> MetaData -> MetaData
+apply (AddMeta f v) m = updateMetaData f v m
+apply (DelMeta f oldv) m = updateMetaData f (unsetMetaValue oldv) m
+apply (SetMeta f v) m = updateMetaData f v $
+ foldr (updateMetaData f) m $
+ map unsetMetaValue $ S.toList $ currentMetaDataValues f m