git-annex/Command/MatchExpression.hs
Joey Hess 518a51a8a0
--explain for preferred/required content matching
And annex.largefiles and annex.addunlocked.

Also git-annex matchexpression --explain explains why its input
expression matches or fails to match.

When there is no limit, avoid explaining why the lack of limit
matches. This is also done when no preferred content expression is set,
although in a few cases it defaults to a non-empty matcher, which will
be explained.

Sponsored-by: Dartmouth College's DANDI project
2023-07-26 14:50:04 -04:00

98 lines
2.8 KiB
Haskell

{- git-annex command
-
- Copyright 2016-2023 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 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"
)
<*> (MatchingUserInfo . addkeysize <$> dataparser)
where
dataparser = UserProvidedInfo
<$> 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 userProvidedKey p of
Right k -> case fromKey keySize k of
Just sz -> p { userProvidedFileSize = 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 (MatcherDesc "provided expression") $ parser ((matchexpr o)) of
Left e -> liftIO $ bail $ "bad expression: " ++ e
Right matcher -> ifM (checkmatcher matcher)
( liftIO exitSuccess
, liftIO exitFailure
)
where
checkmatcher matcher = checkMatcher' matcher (matchinfo o) S.empty
bail :: String -> IO a
bail s = do
hPutStrLn stderr s
exitWith $ ExitFailure 42