diff --git a/examples/Constrained/Examples/CheatSheet.hs b/examples/Constrained/Examples/CheatSheet.hs index 335bc3b..6ec92d6 100644 --- a/examples/Constrained/Examples/CheatSheet.hs +++ b/examples/Constrained/Examples/CheatSheet.hs @@ -364,7 +364,7 @@ tightFit0 = constrained' $ \x y -> -- TypeSpec (Cartesian TrueSpec (MemberSpec [0])) [] -- --- -- assert $ Equal (Fst (ToGeneric v_3)) v_1 --- Env {unEnv = fromList [(v_0,EnvValue 0)]} +-- Env (fromList [(v_0,EnvValue 0)]) -- genFromSpecT ErrorSpec{} with explanation: -- [1..-1] diff --git a/src/Constrained/Base.hs b/src/Constrained/Base.hs index f3fac96..8b6ac32 100644 --- a/src/Constrained/Base.hs +++ b/src/Constrained/Base.hs @@ -101,10 +101,6 @@ import Constrained.GenT import Constrained.Generic import Constrained.List hiding (toList) import Constrained.TypeErrors -import Control.Monad.Writer ( - Writer, - tell, - ) import Data.Foldable ( toList, ) @@ -524,12 +520,6 @@ class alternateShow :: TypeSpec a -> BinaryShow alternateShow _ = NonBinary - monadConformsTo :: a -> TypeSpec a -> Writer [String] Bool - monadConformsTo x spec = - if conformsTo @a x spec - then pure True - else tell ["Fails by " ++ show spec] >> pure False - -- | For some types (especially finite ones) there may be much better ways to construct -- a Specification than the default method of just adding a large 'bad' list to TypSpec. This -- function allows each HasSpec instance to decide. diff --git a/src/Constrained/Conformance.hs b/src/Constrained/Conformance.hs index 394138b..5e53baa 100644 --- a/src/Constrained/Conformance.hs +++ b/src/Constrained/Conformance.hs @@ -14,7 +14,6 @@ module Constrained.Conformance ( conformsToSpec, conformsToSpecE, satisfies, - checkPred, checkPredsE, ) where @@ -34,59 +33,9 @@ import Data.Semigroup (sconcat) import Prettyprinter hiding (cat) import Test.QuickCheck (Property, Testable, property) --- ========================================================================= - --- | Does the Pred evaluate to true under the given Env. --- If it doesn't, some explanation appears in the failure of the monad 'm' -checkPred :: forall m. MonadGenError m => Env -> Pred -> m Bool -checkPred env = \case - p@(ElemPred bool term xs) -> do - v <- runTerm env term - case (elem v xs, bool) of - (True, True) -> pure True - (True, False) -> fatalErrorNE ("notElemPred reduces to True" :| [show p]) - (False, True) -> fatalErrorNE ("elemPred reduces to False" :| [show p]) - (False, False) -> pure True - Monitor {} -> pure True - Subst x t p -> checkPred env $ substitutePred x t p - Assert t -> runTerm env t - GenHint {} -> pure True - p@(Reifies t' t f) -> do - val <- runTerm env t - val' <- runTerm env t' - explainNE (NE.fromList ["Reification:", " " ++ show p]) $ pure (f val == val') - ForAll t (x :-> p) -> do - set <- runTerm env t - and - <$> sequence - [ checkPred env' p - | v <- forAllToList set - , let env' = Env.extend x v env - ] - Case t bs -> do - v <- runTerm env t - runCaseOn v (mapList thing bs) (\x val ps -> checkPred (Env.extend x val env) ps) - When bt p -> do - b <- runTerm env bt - if b then checkPred env p else pure True - TruePred -> pure True - FalsePred es -> explainNE es $ pure False - DependsOn {} -> pure True - And ps -> checkPreds env ps - Let t (x :-> p) -> do - val <- runTerm env t - checkPred (Env.extend x val env) p - Exists k (x :-> p) -> do - a <- runGE $ k (errorGE . explain "checkPred: Exists" . runTerm env) - checkPred (Env.extend x a env) p - Explain es p -> explainNE es $ checkPred env p - -checkPreds :: (MonadGenError m, Traversable t) => Env -> t Pred -> m Bool -checkPreds env ps = and <$> mapM (checkPred env) ps - -- ========================================================== --- | Like checkPred, But it takes [Pred] rather than a single Pred, +-- | Like checkPredE, But it takes [Pred] rather than a single Pred, -- and it builds a much more involved explanation if it fails. -- Does the Pred evaluate to True under the given Env? -- If it doesn't, an involved explanation appears in the (Just message) @@ -101,8 +50,9 @@ checkPredsE msgs env ps = [] -> Nothing (x : xs) -> Just (NE.nub (sconcat (x NE.:| xs))) --- | An involved explanation for a single Pred --- The most important explanations come when an assertion fails. +-- | Does the Pred evaluate to true under the given Env. An involved +-- explanation for a single Pred in case of failure and `Nothing` otherwise. +-- The most important explanations come when an assertion fails. checkPredE :: Env -> NE.NonEmpty String -> Pred -> Maybe (NE.NonEmpty String) checkPredE env msgs = \case p@(ElemPred bool t xs) -> diff --git a/src/Constrained/Env.hs b/src/Constrained/Env.hs index 06bbba3..7794fc9 100644 --- a/src/Constrained/Env.hs +++ b/src/Constrained/Env.hs @@ -27,7 +27,7 @@ import Prettyprinter import Prelude hiding (lookup) -- | Typed environments for mapping @t`Var` a@ to @a@ -newtype Env = Env {unEnv :: Map EnvKey EnvValue} +newtype Env = Env (Map EnvKey EnvValue) deriving newtype (Semigroup, Monoid) deriving stock (Show) diff --git a/src/Constrained/Syntax.hs b/src/Constrained/Syntax.hs index 2399c37..3e72e23 100644 --- a/src/Constrained/Syntax.hs +++ b/src/Constrained/Syntax.hs @@ -51,7 +51,6 @@ module Constrained.Syntax ( computeDependencies, solvableFrom, respecting, - dependency, applyNameHints, envFromPred, isLit, @@ -834,10 +833,6 @@ applyNameHints spec = spec -- | `Graph` specialized to dependencies for variables type DependGraph = Graph.Graph Name --- | A variable depends on a thing witha buch of other variables -dependency :: HasVariables t => Name -> t -> DependGraph -dependency x (freeVarSet -> xs) = Graph.dependency x xs - -- | Everything to the left depends on everything from the right, except themselves irreflexiveDependencyOn :: forall t t'. (HasVariables t, HasVariables t') => t -> t' -> DependGraph