blob: a75101dcec45ad7dac39a80ed08dc20dbf23d377 (
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
74
75
|
{- git-annex command
-
- Copyright 2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.MatchExpression where
import Command
import Annex.FileMatcher
import Types.FileMatcher
import Utility.DataUnits
import Utility.Matcher
import Annex.UUID
import Logs.Group
import qualified Data.Map as M
import qualified Data.Set as S
cmd :: Command
cmd = noCommit $
command "matchexpression" SectionPlumbing
"checks if a preferred content expression matches"
paramExpression
(seek <$$> optParser)
data MatchExpressionOptions = MatchExpressionOptions
{ matchexpr :: String
, matchinfo :: MatchInfo
}
optParser :: CmdParamsDesc -> Parser MatchExpressionOptions
optParser desc = MatchExpressionOptions
<$> argument str (metavar desc)
<*> (addkeysize <$> dataparser)
where
dataparser = MatchingInfo
<$> optinfo "file" (strOption
( long "file" <> metavar paramFile
<> help "specify filename to match against"
))
<*> optinfo "key" (option (str >>= parseKey)
( long "key" <> metavar paramKey
<> help "specify key to match against"
))
<*> optinfo "size" (option (str >>= maybe (fail "parse error") return . readSize dataUnits)
( long "size" <> metavar paramSize
<> help "specify size to match against"
))
optinfo datadesc mk = (Right <$> mk)
<|> (pure $ Left $ missingdata datadesc)
missingdata datadesc = bail $ "cannot match this expression without " ++ datadesc ++ " data"
-- When a key is provided, use its size.
addkeysize i@(MatchingInfo f (Right k) _) = case keySize k of
Just sz -> MatchingInfo f (Right k) (Right sz)
Nothing -> i
addkeysize i = i
seek :: MatchExpressionOptions -> CommandSeek
seek o = do
u <- getUUID
case parsedToMatcher $ preferredContentParser matchAll matchAll groupMap M.empty (Just u) (matchexpr o) of
Left e -> liftIO $ bail $ "bad expression: " ++ e
Right matcher -> ifM (checkmatcher matcher)
( liftIO exitSuccess
, liftIO exitFailure
)
where
checkmatcher matcher = matchMrun matcher $ \a -> a S.empty (matchinfo o)
bail :: String -> IO a
bail s = do
hPutStrLn stderr s
exitWith $ ExitFailure 42
|
