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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
{- git-annex command
-
- Copyright 2014-2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.MetaData where
import Command
import Annex.MetaData
import Annex.VectorClock
import Logs.MetaData
import Annex.WorkTree
import Messages.JSON (JSONActionItem(..), AddJSONActionItemFields(..))
import Types.Messages
import Utility.Aeson
import Limit
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.UTF8 as BU
import Control.Concurrent
cmd :: Command
cmd = withAnnexOptions [jsonOptions, annexedMatchingOptions] $
command "metadata" SectionMetaData
"sets or gets metadata of a file"
paramPaths (seek <$$> optParser)
data MetaDataOptions = MetaDataOptions
{ forFiles :: CmdParams
, getSet :: GetSet
, keyOptions :: Maybe KeyOptions
, batchOption :: BatchMode
}
data GetSet = Get MetaField | GetAll | Set [ModMeta]
optParser :: CmdParamsDesc -> Parser MetaDataOptions
optParser desc = MetaDataOptions
<$> cmdParams desc
<*> ((Get <$> getopt) <|> (Set <$> some modopts) <|> pure GetAll)
<*> optional parseKeyOptions
<*> parseBatchOption False
where
getopt = option (eitherReader (mkMetaField . T.pack))
( long "get" <> short 'g' <> metavar paramField
<> help "get single metadata field"
)
modopts = option (eitherReader parseModMeta)
( long "set" <> short 's' <> metavar "FIELD[+-]=VALUE"
<> help "set or unset metadata value"
)
<|> (AddMeta tagMetaField . toMetaValue . encodeBS <$> strOption
( long "tag" <> short 't' <> metavar "TAG"
<> help "set a tag"
))
<|> (DelMeta tagMetaField . Just . toMetaValue . encodeBS <$> strOption
( long "untag" <> short 'u' <> metavar "TAG"
<> help "remove a tag"
))
<|> option (eitherReader (\f -> DelMeta <$> mkMetaField (T.pack f) <*> pure Nothing))
( long "remove" <> short 'r' <> metavar "FIELD"
<> help "remove all values of a field"
)
<|> flag' DelAllMeta
( long "remove-all"
<> help "remove all metadata"
)
seek :: MetaDataOptions -> CommandSeek
seek o = case batchOption o of
NoBatch -> do
c <- currentVectorClock
let ww = WarnUnmatchLsFiles
let seeker = AnnexedFileSeeker
{ startAction = start c o
, checkContentPresent = Nothing
, usesLocationLog = False
}
let seekaction = case getSet o of
Get _ -> withFilesInGitAnnex ww
GetAll -> withFilesInGitAnnex ww
Set _ -> withFilesInGitAnnexNonRecursive ww
"Not recursively setting metadata. Use --force to do that."
withKeyOptions (keyOptions o) False seeker
(commandAction . startKeys c o)
(seekaction seeker)
=<< workTreeItems ww (forFiles o)
Batch fmt -> withMessageState $ \s -> case outputType s of
JSONOutput _ -> ifM limited
( giveup "combining --batch with file matching options is not currently supported"
, batchOnly (keyOptions o) (forFiles o) $
batchInput fmt parseJSONInput
(commandAction . batchCommandStart . startBatch)
)
_ -> giveup "--batch is currently only supported in --json mode"
start :: CandidateVectorClock -> MetaDataOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
start c o si file k = startKeys c o (si, k, mkActionItem (k, afile))
where
afile = AssociatedFile (Just file)
startKeys :: CandidateVectorClock -> MetaDataOptions -> (SeekInput, Key, ActionItem) -> CommandStart
startKeys c o (si, k, ai) = case getSet o of
Get f -> startingCustomOutput k $ do
l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
liftIO $ forM_ l $
B8.putStrLn . fromMetaValue
next $ return True
_ -> starting "metadata" ai si $
perform c o k
perform :: CandidateVectorClock -> MetaDataOptions -> Key -> CommandPerform
perform c o k = case getSet o of
Set ms -> do
oldm <- getCurrentMetaData k
let m = combineMetaData $ map (modMeta oldm) ms
addMetaDataClocked k m c
next $ cleanup k
_ -> next $ cleanup k
cleanup :: Key -> CommandCleanup
cleanup k = do
m <- getCurrentMetaData k
case toJSON' (AddJSONActionItemFields m) of
Object o -> maybeShowJSON $ AesonObject o
_ -> noop
showLongNote $ unlines $ concatMap showmeta $
map unwrapmeta (fromMetaData m)
return True
where
unwrapmeta (f, v) = (fromMetaField f, map fromMetaValue (S.toList v))
showmeta (f, vs) = map ((T.unpack f ++ "=") ++) (map decodeBS vs)
parseJSONInput :: String -> Annex (Either String (Either RawFilePath Key, MetaData))
parseJSONInput i = case eitherDecode (BU.fromString i) of
Left e -> return (Left e)
Right v -> do
let m = case itemFields v of
Nothing -> emptyMetaData
Just m' -> m'
case (itemKey v, itemFile v) of
(Just k, _) -> return $
Right (Right k, m)
(Nothing, Just f) -> do
f' <- liftIO $ relPathCwdToFile (toRawFilePath f)
return $ Right (Left f', m)
(Nothing, Nothing) -> return $
Left "JSON input is missing either file or key"
startBatch :: (SeekInput, (Either RawFilePath Key, MetaData)) -> CommandStart
startBatch (si, (i, (MetaData m))) = case i of
Left f -> do
mk <- lookupKeyStaged f
case mk of
Just k -> go k (mkActionItem (k, AssociatedFile (Just f)))
Nothing -> return Nothing
Right k -> go k (mkActionItem k)
where
go k ai = starting "metadata" ai si $ do
let o = MetaDataOptions
{ forFiles = []
, getSet = if MetaData m == emptyMetaData
then GetAll
else Set $ map mkModMeta (M.toList m)
, keyOptions = Nothing
, batchOption = NoBatch
}
t <- currentVectorClock
-- It would be bad if two batch mode changes used exactly
-- the same timestamp, since the order of adds and removals
-- of the same metadata value would then be indeterminate.
-- To guarantee that never happens, delay 1 microsecond,
-- so the timestamp will always be different. This is
-- probably less expensive than cleaner methods,
-- such as taking from a list of increasing timestamps.
liftIO $ threadDelay 1
perform t o k
mkModMeta (f, s)
| S.null s = DelMeta f Nothing
| otherwise = SetMeta f s
|
