@@ -14,7 +14,6 @@ module Constrained.Conformance (
1414 conformsToSpec ,
1515 conformsToSpecE ,
1616 satisfies ,
17- checkPred ,
1817 checkPredsE ,
1918) where
2019
@@ -34,59 +33,9 @@ import Data.Semigroup (sconcat)
3433import Prettyprinter hiding (cat )
3534import Test.QuickCheck (Property , Testable , property )
3635
37- -- =========================================================================
38-
39- -- | Does the Pred evaluate to true under the given Env.
40- -- If it doesn't, some explanation appears in the failure of the monad 'm'
41- checkPred :: forall m . MonadGenError m => Env -> Pred -> m Bool
42- checkPred env = \ case
43- p@ (ElemPred bool term xs) -> do
44- v <- runTerm env term
45- case (elem v xs, bool) of
46- (True , True ) -> pure True
47- (True , False ) -> fatalErrorNE (" notElemPred reduces to True" :| [show p])
48- (False , True ) -> fatalErrorNE (" elemPred reduces to False" :| [show p])
49- (False , False ) -> pure True
50- Monitor {} -> pure True
51- Subst x t p -> checkPred env $ substitutePred x t p
52- Assert t -> runTerm env t
53- GenHint {} -> pure True
54- p@ (Reifies t' t f) -> do
55- val <- runTerm env t
56- val' <- runTerm env t'
57- explainNE (NE. fromList [" Reification:" , " " ++ show p]) $ pure (f val == val')
58- ForAll t (x :-> p) -> do
59- set <- runTerm env t
60- and
61- <$> sequence
62- [ checkPred env' p
63- | v <- forAllToList set
64- , let env' = Env. extend x v env
65- ]
66- Case t bs -> do
67- v <- runTerm env t
68- runCaseOn v (mapList thing bs) (\ x val ps -> checkPred (Env. extend x val env) ps)
69- When bt p -> do
70- b <- runTerm env bt
71- if b then checkPred env p else pure True
72- TruePred -> pure True
73- FalsePred es -> explainNE es $ pure False
74- DependsOn {} -> pure True
75- And ps -> checkPreds env ps
76- Let t (x :-> p) -> do
77- val <- runTerm env t
78- checkPred (Env. extend x val env) p
79- Exists k (x :-> p) -> do
80- a <- runGE $ k (errorGE . explain " checkPred: Exists" . runTerm env)
81- checkPred (Env. extend x a env) p
82- Explain es p -> explainNE es $ checkPred env p
83-
84- checkPreds :: (MonadGenError m , Traversable t ) => Env -> t Pred -> m Bool
85- checkPreds env ps = and <$> mapM (checkPred env) ps
86-
8736-- ==========================================================
8837
89- -- | Like checkPred , But it takes [Pred] rather than a single Pred,
38+ -- | Like checkPredE , But it takes [Pred] rather than a single Pred,
9039-- and it builds a much more involved explanation if it fails.
9140-- Does the Pred evaluate to True under the given Env?
9241-- If it doesn't, an involved explanation appears in the (Just message)
@@ -101,8 +50,9 @@ checkPredsE msgs env ps =
10150 [] -> Nothing
10251 (x : xs) -> Just (NE. nub (sconcat (x NE. :| xs)))
10352
104- -- | An involved explanation for a single Pred
105- -- The most important explanations come when an assertion fails.
53+ -- | Does the Pred evaluate to true under the given Env. An involved
54+ -- explanation for a single Pred in case of failure and `Nothing` otherwise.
55+ -- The most important explanations come when an assertion fails.
10656checkPredE :: Env -> NE. NonEmpty String -> Pred -> Maybe (NE. NonEmpty String )
10757checkPredE env msgs = \ case
10858 p@ (ElemPred bool t xs) ->
0 commit comments