blob: f2c4abceadf8c036ea1030418968080d31511e33 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
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
|
