initial implementation of --explain
Currently it only displays explanations of options like --in and --copies. In the future, it should explain preferred content expression evaluation and other decisions. The explanations of a few things could be better. In particular, "standard" will just appear as-is (or as "!standard" if it doesn't match), rather than explaining why the standard preferred content expression for the group matches or not. Currently as implemented, it goes to stdout, and so commands like git-annex find that have custom output will not display --explain information. Perhaps that should change, dunno. Sponsored-by: Dartmouth College's DANDI project
This commit is contained in:
parent
cf40e2d4b6
commit
f25eeedeac
12 changed files with 122 additions and 46 deletions
|
@ -21,6 +21,7 @@ module Utility.Matcher (
|
|||
Token(..),
|
||||
Matcher(..),
|
||||
MatchDesc(..),
|
||||
MatchResult(..),
|
||||
syntaxToken,
|
||||
generate,
|
||||
match,
|
||||
|
@ -31,7 +32,7 @@ module Utility.Matcher (
|
|||
isEmpty,
|
||||
combineMatchers,
|
||||
introspect,
|
||||
describeMatchDesc,
|
||||
describeMatchResult,
|
||||
|
||||
prop_matcher_sane
|
||||
) where
|
||||
|
@ -52,7 +53,9 @@ data Matcher op = MAny
|
|||
| MOp op
|
||||
deriving (Show, Eq, Foldable)
|
||||
|
||||
data MatchDesc op
|
||||
newtype MatchDesc = MatchDesc String
|
||||
|
||||
data MatchResult op
|
||||
= MatchedOperation Bool op
|
||||
| MatchedAnd
|
||||
| MatchedOr
|
||||
|
@ -139,7 +142,7 @@ match :: (op -> v -> Bool) -> Matcher op -> v -> Bool
|
|||
match a m v = fst $ runWriter $ match' a m v
|
||||
|
||||
{- Like match, but accumulates a description of why it did or didn't match. -}
|
||||
match' :: (op -> v -> Bool) -> Matcher op -> v -> Writer [MatchDesc op] Bool
|
||||
match' :: (op -> v -> Bool) -> Matcher op -> v -> Writer [MatchResult op] Bool
|
||||
match' a m v = matchMrun' m (\op -> pure (a op v))
|
||||
|
||||
{- Runs a monadic Matcher, where Operations are actions in the monad. -}
|
||||
|
@ -151,9 +154,9 @@ matchM m v = matchMrun m $ \op -> op v
|
|||
matchMrun :: Monad m => Matcher op -> (op -> m Bool) -> m Bool
|
||||
matchMrun m run = fst <$> runWriterT (matchMrun' m run)
|
||||
|
||||
{- Like matchMRun, but accumulates a description of why it did or didn't match. -}
|
||||
{- Like matchMrun, but accumulates a description of why it did or didn't match. -}
|
||||
matchMrun'
|
||||
:: (MonadWriter [MatchDesc op] (t m), MonadTrans t, Monad m)
|
||||
:: (MonadWriter [MatchResult op] (t m), MonadTrans t, Monad m)
|
||||
=> Matcher op
|
||||
-> (op -> m Bool)
|
||||
-> t m Bool
|
||||
|
@ -211,13 +214,15 @@ combineMatchers a b
|
|||
introspect :: (a -> Bool) -> Matcher a -> Bool
|
||||
introspect = any
|
||||
|
||||
{- Converts a [MatchDesc] into a description of what matched and didn't
|
||||
{- Converts a [MatchResult] into a description of what matched and didn't
|
||||
- match. -}
|
||||
describeMatchDesc :: (op -> Bool -> String) -> [MatchDesc op] -> String
|
||||
describeMatchDesc descop = unwords . go . simplify True
|
||||
describeMatchResult :: (op -> Bool -> MatchDesc) -> [MatchResult op] -> String
|
||||
describeMatchResult descop = unwords . go . simplify True
|
||||
where
|
||||
go [] = []
|
||||
go (MatchedOperation b op:rest) = descop op b : go rest
|
||||
go (MatchedOperation b op:rest) =
|
||||
let MatchDesc d = descop op b
|
||||
in d : go rest
|
||||
go (MatchedAnd:rest) = "and" : go rest
|
||||
go (MatchedOr:rest) = "or" : go rest
|
||||
go (MatchedNot:rest) = "not" : go rest
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue