c1b4d76e6b
matchNeedsFileContent is not used yet, but shows how to add information about terminals. That one would be needed for https://git-annex.branchable.com/todo/sync_fast_import/ Note the tricky bit in Annex.FileMatcher.call where it folds over the included matcher to propagate the information. This commit was sponsored by Svenne Krap on Patreon.
100 lines
2.8 KiB
Haskell
100 lines
2.8 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2016 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.MatchExpression where
|
|
|
|
import Command
|
|
import Annex.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
|
|
, largeFilesExpression :: Bool
|
|
, matchinfo :: MatchInfo
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser MatchExpressionOptions
|
|
optParser desc = MatchExpressionOptions
|
|
<$> argument str (metavar desc)
|
|
<*> switch
|
|
( long "largefiles"
|
|
<> help "parse as annex.largefiles expression"
|
|
)
|
|
<*> (MatchingInfo . addkeysize <$> dataparser)
|
|
where
|
|
dataparser = ProvidedInfo
|
|
<$> 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 "mimetype" (strOption
|
|
( long "mimetype" <> metavar paramValue
|
|
<> help "specify mime type to match against"
|
|
))
|
|
<*> optinfo "mimeencoding" (strOption
|
|
( long "mimeencoding" <> metavar paramValue
|
|
<> help "specify mime encoding 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, make its size also be provided.
|
|
addkeysize p = case providedKey p of
|
|
Right k -> case fromKey keySize k of
|
|
Just sz -> p { providedFileSize = Right sz }
|
|
Nothing -> p
|
|
Left _ -> p
|
|
|
|
seek :: MatchExpressionOptions -> CommandSeek
|
|
seek o = do
|
|
parser <- if largeFilesExpression o
|
|
then mkMatchExpressionParser
|
|
else do
|
|
u <- getUUID
|
|
pure $ preferredContentParser $ preferredContentTokens $ PCD
|
|
{ matchStandard = Right matchAll
|
|
, matchGroupWanted = Right matchAll
|
|
, getGroupMap = groupMap
|
|
, configMap = M.empty
|
|
, repoUUID = Just u
|
|
}
|
|
case parsedToMatcher $ parser ((matchexpr o)) of
|
|
Left e -> liftIO $ bail $ "bad expression: " ++ e
|
|
Right matcher -> ifM (checkmatcher matcher)
|
|
( liftIO exitSuccess
|
|
, liftIO exitFailure
|
|
)
|
|
where
|
|
checkmatcher matcher = matchMrun matcher $ \op ->
|
|
matchAction op S.empty (matchinfo o)
|
|
|
|
bail :: String -> IO a
|
|
bail s = do
|
|
hPutStrLn stderr s
|
|
exitWith $ ExitFailure 42
|