prednote 0.28.0.2 → 0.30.0.0

raw patch · 8 files changed

+532/−369 lines, 8 filesdep +transformersdep ~QuickCheckdep ~basedep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

Dependency ranges changed: QuickCheck, base, containers, contravariant, quickpull, rainbow, split, text

API changes (from Hackage documentation)

Files

• genCabal.hs +97/−122
• lib/Prednote/Comparisons.hs +167/−30
• lib/Prednote/Core.hs +131/−86
• lib/Prednote/Expressions.hs +12/−11
• lib/Prednote/Expressions/Infix.hs +16/−16
• lib/Prednote/Expressions/RPN.hs +16/−14
• prednote.cabal +86/−85
• tests/Prednote/Core/Instances.hs +7/−5

@@ -1,81 +1,50 @@ -- Generates the Cabal file for prednote.--- Written to use version 0.10.0.2 of the Cartel+-- Written to use version 0.14.2.0 of the Cartel -- library.  module Main where -import qualified Cartel as C--versionInts :: [Int]-versionInts = [0,28,0,2]--base :: C.Package-base = C.closedOpen "base" [4,5,0,0] [5]--rainbowLower :: [Int]-rainbowLower = [0,20,0,4]--rainbowUpper :: [Int]-rainbowUpper = [0,21]--rainbow :: C.Package-rainbow = C.closedOpen "rainbow" rainbowLower rainbowUpper--rainbow_tests :: C.Package-rainbow_tests = C.closedOpen "rainbow-tests" rainbowLower rainbowUpper--text :: C.Package-text = C.closedOpen "text" [0,11,2,0] [1,3]--containers :: C.Package-containers = C.closedOpen "containers" [0,4,2,1] [0,6]--barecheck :: C.Package-barecheck = C.closedOpen "barecheck" [0,2,0,0] [0,3]--quickcheck :: C.Package-quickcheck = C.closedOpen "QuickCheck" [2,5] [2,8]+import Cartel+import Control.Applicative -commonProperties :: C.Properties-commonProperties = C.empty-  { C.prVersion = C.Version versionInts-  , C.prLicenseFile = "LICENSE"-  , C.prCopyright = "Copyright 2013-2015 Omari Norman"-  , C.prAuthor = "Omari Norman"-  , C.prMaintainer = "omari@smileystation.com"-  , C.prStability = "Experimental"-  , C.prHomepage = "http://www.github.com/massysett/prednote"-  , C.prBugReports = "http://www.github.com/massysett/prednote/issues"-  , C.prCategory = "Data"-  , C.prSynopsis = "Evaluate and display trees of predicates"-  }+versionInts :: [Word]+versionInts = [0,30,0,0] -repo :: C.Repository-repo = C.empty-  { C.repoVcs = C.Git-  , C.repoKind = C.Head-  , C.repoLocation = "git://github.com/massysett/prednote.git"-  , C.repoBranch = "master"-  }+base :: Package+base = closedOpen "base" [4,5,0,0] [5] -ghcOptions :: [String]-ghcOptions = ["-Wall"]+rainbow :: Package+rainbow = closedOpen "rainbow" [0,20,0,4] [0,21] --- Dependencies+text :: Package+text = closedOpen "text" [0,11,2,0] [1,3] -split :: C.Package-split = C.closedOpen "split" [0,2,2] [0,3]+containers :: Package+containers = closedOpen "containers" [0,4,2,1] [0,6] -quickpull :: C.Package-quickpull = C.closedOpen "quickpull" [0,4] [0,5]+barecheck :: Package+barecheck = closedOpen "barecheck" [0,2,0,0] [0,3] -contravariant :: C.Package-contravariant = C.closedOpen "contravariant" [1,2] [1,3]+quickcheck :: Package+quickcheck = closedOpen "QuickCheck" [2,5] [2,8] -properties :: C.Properties-properties = commonProperties-  { C.prName = "prednote"-  , C.prDescription =+properties :: Properties+properties = blank+  { name = "prednote"+  , version = versionInts+  , cabalVersion = Just (1,14)+  , buildType = Just simple+  , license = Just bsd3+  , licenseFile = "LICENSE"+  , copyright = "Copyright 2013-2015 Omari Norman"+  , author = "Omari Norman"+  , maintainer = "omari@smileystation.com"+  , stability = "Experimental"+  , homepage = "http://www.github.com/massysett/prednote"+  , bugReports = "http://www.github.com/massysett/prednote/issues"+  , category = "Data"+  , synopsis = "Evaluate and display trees of predicates"+  , description =     [ "Build and evaluate trees of predicates. For example, you might build"     , "a predicate of the type Int -> Bool. You do this by assembling"     , "several predicates into a tree. You can then verbosely evaluate"@@ -85,16 +54,34 @@     , "given predicate, and to parse infix or RPN expressions into a tree of"     , "predicates."     ]-  , C.prTestedWith = map (\ls -> (C.GHC, C.eq ls))+  , testedWith = map (\ls -> (ghc, eq ls))     [ [7,6,3], [7,8,2] ]-  , C.prExtraSourceFiles =+  , extraSourceFiles =     [ "README.md"     , "changelog"     , "genCabal.hs"     ]+   } -libDepends :: [C.Package]+ghcOpts :: [String]+ghcOpts = ["-Wall"]++-- Dependencies++split :: Package+split = closedOpen "split" [0,2,2] [0,3]++quickpull :: Package+quickpull = closedOpen "quickpull" [0,4] [0,5]++contravariant :: Package+contravariant = closedOpen "contravariant" [1,2] [1,3]++transformers :: Package+transformers = closedOpen "transformers" [0,3,0,0] [0,5]++libDepends :: [Package] libDepends =   [ base   , rainbow@@ -102,87 +89,75 @@   , text   , containers   , contravariant+  , transformers   ]  library   :: [String]   -- ^ Library modules-  -> C.Library-library ms = C.Library-  [ C.LibExposedModules ms-  , C.buildDepends libDepends-  , C.hsSourceDirs ["lib"]-  , C.ghcOptions ghcOptions-  , C.defaultLanguage C.Haskell2010+  -> [LibraryField]+library ms =+  [ exposedModules ms+  , buildDepends libDepends+  , hsSourceDirs ["lib"]+  , ghcOptions ghcOpts+  , haskell2010   ]  tests-  :: [String]+  :: FlagName+  -- ^ Visual-tests flag+  -> [String]   -- ^ Library modules   -> [String]   -- ^ Test modules-  -> (C.TestSuite, C.Executable)-tests ls ts =-  ( C.TestSuite "prednote-tests" $+  -> (Section, Section)+  -- ^ The prednote-tests test suite, and the prednote-visual-tests+  -- executable+tests fl ls ts =+  ( testSuite "prednote-tests" $     commonTestOpts ls ts ++-    [ C.TestMainIs "prednote-tests.hs"-    , C.TestType C.ExitcodeStdio+    [ mainIs "prednote-tests.hs"+    , exitcodeStdio     ]-  , C.Executable "prednote-visual-tests" $-    [ C.ExeMainIs "prednote-visual-tests.hs"-    , C.cif (C.flag "visual-tests")-       ( commonTestOpts ls ts ++-        [ C.buildable True-        ]-       )-      [ C.buildable False+  , executable "prednote-visual-tests" $+    [ mainIs "prednote-visual-tests.hs"+    , condBlock (flag fl)+       ( buildable True, commonTestOpts ls ts)+      [ buildable False       ]     ]   )  commonTestOpts-  :: C.Field a+  :: HasBuildInfo a   => [String]   -- ^ Library modules   -> [String]   -- ^ Test modules   -> [a] commonTestOpts ls ts =-  [ C.hsSourceDirs ["lib", "tests"]-  , C.otherModules (ls ++ ts)-  , C.ghcOptions ghcOptions-  , C.defaultLanguage C.Haskell2010-  , C.buildDepends $ quickcheck : quickpull : libDepends+  [ hsSourceDirs ["lib", "tests"]+  , otherModules (ls ++ ts)+  , ghcOptions ghcOpts+  , haskell2010+  , buildDepends $ quickcheck : quickpull : libDepends   ] -visualTests :: C.Flag-visualTests = C.Flag-  { C.flName = "visual-tests"-  , C.flDescription = "Build the prednote-visual-tests executable"-  , C.flDefault = False-  , C.flManual = True+visualTests :: Applicative m => Betsy m FlagName+visualTests = makeFlag "visual-tests" $ FlagOpts+  { flagDescription = "Build the prednote-visual-tests executable"+  , flagDefault = False+  , flagManual = True   }  -cabal-  :: [String]-  -- ^ Modules for library-  -> [String]-  -- ^ Modules for tests-  -> C.Cabal-cabal ls ts = C.empty-  { C.cProperties = properties-  , C.cRepositories = [repo]-  , C.cLibrary = Just $ library ls-  , C.cTestSuites = [testSuite]-  , C.cExecutables = [executable]-  , C.cFlags = [visualTests]-  }-  where-    (testSuite, executable) = tests ls ts- main :: IO ()-main = do-  libMods <- C.modules "lib"-  testMods <- C.modules "tests"-  C.render "genCabal.hs" $ cabal libMods testMods+main = defaultMain $ do+  fl <- visualTests+  libMods <- modules "lib"+  testMods <- modules "tests"+  let (tsts, vis) = tests fl libMods testMods+      lib = library libMods+      repo = githubHead "massysett" "prednote"+  return (properties, lib, [tsts, vis])

@@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Prednote.Comparisons-  ( compareBy+  ( -- * Comparisions that do not run in a context+    compareBy   , compare   , equalBy   , equal@@ -15,6 +16,18 @@   , greaterEqBy   , lessEqBy   , notEqBy++  -- * Comparisions that run in a context+  , compareByM+  , equalByM+  , compareByMaybeM+  , greaterByM+  , lessByM+  , greaterEqByM+  , lessEqByM+  , notEqByM++  -- * Parsing comparers   , parseComparer   ) where @@ -28,12 +41,12 @@ -- | Build a Pred that compares items.  The idea is that the item on -- the right hand side is baked into the 'Pred' and that the 'Pred' -- compares this single right-hand side to each left-hand side item.-compareBy-  :: Show a+compareByM+  :: (Show a, Functor f)   => Text   -- ^ Description of the right-hand side -  -> (a -> Ordering)+  -> (a -> f Ordering)   -- ^ How to compare the left-hand side to the right-hand side.   -- Return LT if the item is less than the right hand side; GT if   -- greater; EQ if equal to the right hand side.@@ -43,17 +56,39 @@   -- order for the Predbox to be True; otherwise it is False. The subject   -- will be on the left hand side. -  -> Pred a+  -> PredM f a -compareBy rhsDesc get ord = predicate cond pd+compareByM rhsDesc get ord = predicateM cond pd   where     cond = "is" <+> ordDesc <+> rhsDesc     ordDesc = case ord of       EQ -> "equal to"       LT -> "less than"       GT -> "greater than"-    pd a = get a == ord+    pd a = fmap (== ord) (get a) +-- | Build a Pred that compares items.  The idea is that the item on+-- the right hand side is baked into the 'Pred' and that the 'Pred'+-- compares this single right-hand side to each left-hand side item.+compareBy+  :: Show a+  => Text+  -- ^ Description of the right-hand side++  -> (a -> Ordering)+  -- ^ How to compare the left-hand side to the right-hand side.+  -- Return LT if the item is less than the right hand side; GT if+  -- greater; EQ if equal to the right hand side.++  -> Ordering+  -- ^ When subjects are compared, this ordering must be the result in+  -- order for the Predbox to be True; otherwise it is False. The subject+  -- will be on the left hand side.++  -> Pred a++compareBy rhsDesc get ord = compareByM rhsDesc (fmap return get) ord+ -- | Overloaded version of 'compareBy'.  compare@@ -72,6 +107,23 @@  -- | Builds a 'Pred' that tests items for equality. +equalByM+  :: (Show a, Functor f)++  => Text+  -- ^ Description of the right-hand side++  -> (a -> f Bool)+  -- ^ How to compare an item against the right hand side.  Return+  -- 'True' if the items are equal; 'False' otherwise.++  -> PredM f a+equalByM rhsDesc = predicateM cond+  where+    cond = "is equal to" <+> rhsDesc++-- | Builds a 'Pred' that tests items for equality.+ equalBy   :: Show a @@ -83,9 +135,7 @@   -- 'True' if the items are equal; 'False' otherwise.    -> Pred a-equalBy rhsDesc = predicate cond-  where-    cond = "is equal to" <+> rhsDesc+equalBy rhsDesc f = equalByM rhsDesc (fmap return f)  -- | Overloaded version of 'equalBy'. @@ -99,12 +149,12 @@   -- | Builds a 'Pred' for items that might fail to return a comparison.-compareByMaybe-  :: Show a+compareByMaybeM+  :: (Functor f, Show a)   => Text   -- ^ Description of the right-hand side -  -> (a -> Maybe Ordering)+  -> (a -> f (Maybe Ordering))   -- ^ How to compare an item against the right hand side. Return LT if   -- the item is less than the right hand side; GT if greater; EQ if   -- equal to the right hand side.@@ -114,19 +164,42 @@   -- order for the Predbox to be True; otherwise it is False. The subject   -- will be on the left hand side. -  -> Pred a+  -> PredM f a -compareByMaybe rhsDesc get ord = predicate cond pd+compareByMaybeM rhsDesc get ord = predicateM cond pd   where     cond = "is" <+> ordDesc <+> rhsDesc     ordDesc = case ord of       EQ -> "equal to"       LT -> "less than"       GT -> "greater than"-    pd a = case get a of-      Nothing -> False-      Just o -> o == ord+    pd a = fmap f (get a)+      where+        f x = case x of+          Nothing -> False+          Just o -> o == ord ++-- | Builds a 'Pred' for items that might fail to return a comparison.+compareByMaybe+  :: Show a+  => Text+  -- ^ Description of the right-hand side++  -> (a -> Maybe Ordering)+  -- ^ How to compare an item against the right hand side. Return LT if+  -- the item is less than the right hand side; GT if greater; EQ if+  -- equal to the right hand side.++  -> Ordering+  -- ^ When subjects are compared, this ordering must be the result in+  -- order for the Predbox to be True; otherwise it is False. The subject+  -- will be on the left hand side.++  -> Pred a++compareByMaybe rhsDesc get ord = compareByMaybeM rhsDesc (fmap return get) ord+ greater   :: (Show a, Ord a) @@ -169,6 +242,19 @@   -> Pred a notEq = not . equal +greaterByM+  :: (Show a, Functor f)+  => Text+  -- ^ Description of right-hand side++  -> (a -> f Ordering)+  -- ^ How to compare an item against the right hand side. Return LT+  -- if the item is less than the right hand side; GT if greater; EQ+  -- if equal to the right hand side.++  -> PredM f a+greaterByM desc get = compareByM desc get GT+ greaterBy   :: Show a   => Text@@ -180,9 +266,22 @@   -- if equal to the right hand side.    -> Pred a-greaterBy desc get = compareBy desc get GT+greaterBy desc get = greaterByM desc (fmap return get)  +lessByM+  :: (Show a, Functor f)+  => Text+  -- ^ Description of right-hand side++  -> (a -> f Ordering)+  -- ^ How to compare an item against the right hand side. Return LT+  -- if the item is less than the right hand side; GT if greater; EQ+  -- if equal to the right hand side.++  -> PredM f a+lessByM desc get = compareByM desc get LT+ lessBy   :: Show a   => Text@@ -194,8 +293,23 @@   -- if equal to the right hand side.    -> Pred a-lessBy desc get = compareBy desc get LT+lessBy desc get = lessByM desc (fmap return get) +greaterEqByM+  :: (Functor f, Monad f, Show a)+  => Text+  -- ^ Description of right-hand side++  -> (a -> f Ordering)+  -- ^ How to compare an item against the right hand side. Return LT+  -- if the item is less than the right hand side; GT if greater; EQ+  -- if equal to the right hand side.++  -> PredM f a+greaterEqByM desc get = greaterByM desc get ||| equalByM desc f'+  where+    f' = fmap (fmap (== EQ)) get+ greaterEqBy   :: Show a   => Text@@ -207,9 +321,22 @@   -- if equal to the right hand side.    -> Pred a-greaterEqBy desc get = greaterBy desc get ||| equalBy desc f'+greaterEqBy desc get = greaterEqByM desc (fmap return get)++lessEqByM+  :: (Functor f, Monad f, Show a)+  => Text+  -- ^ Description of right-hand side++  -> (a -> f Ordering)+  -- ^ How to compare an item against the right hand side. Return LT+  -- if the item is less than the right hand side; GT if greater; EQ+  -- if equal to the right hand side.++  -> PredM f a+lessEqByM desc get = lessByM desc get ||| equalByM desc f'   where-    f' = fmap (== EQ) get+    f' = fmap (fmap (== EQ)) get  lessEqBy   :: Show a@@ -222,10 +349,20 @@   -- if equal to the right hand side.    -> Pred a-lessEqBy desc get = lessBy desc get ||| equalBy desc f'-  where-    f' = fmap (== EQ) get+lessEqBy desc get = lessEqByM desc (fmap return get) +notEqByM+  :: (Functor f, Show a)+  => Text+  -- ^ Description of right-hand side++  -> (a -> f Bool)+  -- ^ How to compare an item against the right hand side.  Return+  -- 'True' if equal; 'False' otherwise.++  -> PredM f a+notEqByM desc = not . equalByM desc+ notEqBy   :: Show a   => Text@@ -236,21 +373,21 @@   -- 'True' if equal; 'False' otherwise.    -> Pred a-notEqBy desc = not . equalBy desc-+notEqBy desc f = notEqByM desc (fmap return f)  -- | Parses a string that contains text, such as @>=@, which indicates -- which comparer to use.  Returns the comparer. parseComparer-  :: Text+  :: (Monad f, Functor f)+  => Text   -- ^ The string with the comparer to be parsed -  -> (Ordering -> Pred a)+  -> (Ordering -> PredM f a)   -- ^ A function that, when given an ordering, returns a 'Pred'.   -- Typically you will get this by partial application of 'compare',   -- 'compareBy', or 'compareByMaybe'. -  -> Maybe (Pred a)+  -> Maybe (PredM f a)   -- ^ If an invalid comparer string is given, Nothing; otherwise, the   -- 'Pred'. parseComparer t f

@@ -1,8 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} module Prednote.Core   ( -- * Predicates and their creation-    Pred(..)+    PredM(..)+  , Pred   , predicate+  , predicateM    -- * Predicate combinators   -- ** Primitive combinators@@ -40,6 +42,8 @@    -- * Evaluating predicates   , test+  , testM+  , runPred   , verboseTest   , verboseTestStdout @@ -71,6 +75,8 @@ import qualified Data.Text as X import Data.Text (Text) import Data.List (intersperse)+import Data.Functor.Identity+import Control.Applicative  -- | Describes the condition; for example, for a @'Pred' 'Int'@, -- this might be @is greater than 5@; for a @'Pred' 'String'@, this@@ -135,75 +141,106 @@ -- | Predicates.  Is an instance of 'Contravariant', which allows you -- to change the type using 'contramap'.  Though the constructor is -- exported, ordinarily you shouldn't need to use it; other functions--- in this module create 'Pred' and manipulate them as needed.-newtype Pred a = Pred (a -> Result)+-- in this module create 'PredM' and manipulate them as needed.+--+-- The @f@ type variable is an arbitrary context; ordinarily this type+-- will be an instance of 'Monad', and some of the bindings in this+-- module require this.  That allows you to run predicate computations+-- that run in some sort of context, allowing you to perform IO,+-- examine state, or whatever.  If you only want to do pure+-- computations, just use the 'Pred' type synonym.+newtype PredM f a = PredM { runPredM :: (a -> f Result) } -instance Show (Pred a) where+-- | Predicates that do not run in any context.+type Pred = PredM Identity++-- | Runs pure 'Pred' computations.+runPred :: Pred a -> a -> Result+runPred (PredM f) a = runIdentity $ f a++instance Show (PredM f a) where   show _ = "Pred" -instance Contravariant Pred where-  contramap f (Pred g) = Pred (g . f)+instance Contravariant (PredM f) where+  contramap f (PredM g) = PredM (g . f) --- | Creates a new 'Pred'.  In @predicate cond f@, @cond@ describes--- the condition, while @f@ gives the predicate function.  For--- example, if @f@ is @(> 5)@, then @cond@ might be @"is greater than--- 5"@.+-- | Creates a new 'PredM' that run in some arbitrary context.  In+-- @predicateM cond f@, @cond@ describes the condition, while @f@+-- gives the predicate function.  For example, if @f@ is @(> 5)@, then+-- @cond@ might be @"is greater than 5"@.+predicateM+  :: (Show a, Functor f)+  => Text+  -> (a -> f Bool)+  -- ^ Predicate function; this is in an arbitrary context, allowing+  -- you to perform IO, examine and change state, etc.  If you do not+  -- need to use a context, see 'predicate'.+  -> PredM f a+predicateM tCond p = PredM f+  where+    f a = fmap mkResult $ p a+      where+        mkResult b = Result (Labeled [] r)+          where+            r | b = Right (PTerminal val cond)+              | otherwise = Left (FTerminal val cond)+            cond = Condition [fromText tCond]+            val = Value . X.pack . show $ a++-- | Creates a new 'Pred' that do not run in any context.  In+-- @predicate cond f@, @cond@ describes the condition, while @f@ gives+-- the predicate function.  For example, if @f@ is @(> 5)@, then+-- @cond@ might be @"is greater than 5"@. predicate   :: Show a   => Text   -> (a -> Bool)   -> Pred a-predicate tCond p = Pred f-  where-    f a = Result (Labeled [] r)-      where-        r | p a = Right (PTerminal val cond)-          | otherwise = Left (FTerminal val cond)-        cond = Condition [fromText tCond]-        val = Value . X.pack . show $ a-+predicate lbl f = predicateM lbl (fmap return f)  -- | And.  Returns 'True' if both argument 'Pred' return 'True'.  Is -- lazy in its second argment; if the first argument returns 'False', -- the second is ignored.-(&&&) :: Pred a -> Pred a -> Pred a-(Pred fL) &&& r = Pred f-  where-    f a = Result (Labeled [] rslt)-      where-        rslt = case splitResult $ fL a of-          Left n -> Left (FAnd (Left n))-          Right g -> case splitResult $ fR a of-            Left b -> Left (FAnd (Right (g, b)))-            Right g' -> Right (PAnd g g')-        Pred fR = r+(&&&) :: Monad m => PredM m a -> PredM m a -> PredM m a+(PredM fL) &&& r = PredM $ \a -> do+  resL <- fL a+  ei <- case splitResult resL of+    Left n -> return (Left (FAnd (Left n)))+    Right g -> do+      let PredM fR = r+      resR <- fR a+      return $ case splitResult resR of+        Left b -> Left (FAnd (Right (g, b)))+        Right g' -> Right (PAnd g g')+  return (Result (Labeled [] ei))+ infixr 3 &&&   -- | Or.  Returns 'True' if either argument 'Pred' returns 'True'.  Is -- lazy in its second argument; if the first argument returns 'True', -- the second argument is ignored.-(|||) :: Pred a -> Pred a -> Pred a-(Pred fL) ||| r = Pred f-  where-    Pred fR = r-    f a = Result (Labeled [] rslt)-      where-        rslt = case splitResult $ fL a of-          Left b -> case splitResult $ fR a of-            Left b' -> Left $ FOr b b'-            Right g -> Right $ POr (Right (b, g))-          Right g -> Right $ POr (Left g)+(|||) :: Monad m => PredM m a -> PredM m a -> PredM m a+(PredM fL) ||| r = PredM $ \a -> do+  resL <- fL a+  ei <- case splitResult resL of+    Left b -> do+      let PredM fR = r+      resR <- fR a+      return $ case splitResult resR of+        Left b' -> Left $ FOr b b'+        Right g -> Right $ POr (Right (b, g))+    Right g -> return (Right (POr (Left g)))+  return (Result (Labeled [] ei))   infixr 2 ||| - -- | Negation.  Returns 'True' if the argument 'Pred' returns 'False'.-not :: Pred a -> Pred a-not (Pred f) = Pred g+not :: Functor m => PredM m a -> PredM m a+not (PredM f) = PredM $ \a -> fmap g (f a)   where     g a = Result (Labeled [] rslt)       where-        rslt = case splitResult $ f a of+        rslt = case splitResult a of           Left b -> Right (PNot b)           Right y -> Left (FNot y) @@ -213,13 +250,13 @@ -- of @l@ if @e@ is 'Left' or the result of @r@ if @e@ is 'Right'.  Is -- lazy, so the the argument 'Pred' that is not used is ignored. switch-  :: Pred a-  -> Pred b-  -> Pred (Either a b)-switch pa pb = Pred (either fa fb)+  :: PredM m a+  -> PredM m b+  -> PredM m (Either a b)+switch pa pb = PredM (either fa fb)   where-    Pred fa = pa-    Pred fb = pb+    PredM fa = pa+    PredM fb = pb  -- | Did this 'Result' pass or fail? resultToBool :: Result -> Bool@@ -228,29 +265,28 @@   -- | Always returns 'True'-true :: Show a => Pred a-true = predicate "always returns True" (const True)+true :: (Show a, Applicative f) => PredM f a+true = predicateM "always returns True" (const (pure True))  -- | Always returns 'False'-false :: Show a => Pred a-false = predicate "always returns False" (const False)+false :: (Show a, Applicative f) => PredM f a+false = predicateM "always returns False" (const (pure False))  -- | Always returns its argument-same :: Pred Bool-same = predicate "is returned" id-+same :: Applicative f => PredM f Bool+same = predicateM "is returned" (pure . id)  -- | Adds descriptive text to a 'Pred'.  Gives useful information for -- the user.  The label is added to the top 'Pred' in the tree; any -- existing labels are also retained.  Labels that were added last -- will be printed first.  For an example of this, see the source code -- for 'any' and 'all'.-addLabel :: Text -> Pred a -> Pred a-addLabel s (Pred f) = Pred f'+addLabel :: Functor f => Text -> PredM f a -> PredM f a+addLabel s (PredM f) = PredM f'   where-    f' a = Result (Labeled (Label s : ss) ei)+    f' a = fmap g (f a)       where-        Result (Labeled ss ei) = f a+        g (Result (Labeled ss ei)) = Result (Labeled (Label s : ss) ei)   -- | Represents the end of a list.@@ -262,7 +298,7 @@ -- | Like 'Prelude.any'; is 'True' if any of the list items are -- 'True'.  An empty list returns 'False'.  Is lazy; will stop -- processing if it encounters a 'True' item.-any :: Pred a -> Pred [a]+any :: (Functor m, Monad m, Applicative m) => PredM m a -> PredM m [a] any pa = contramap f (switch (addLabel "cons cell" pConsCell) pEnd)   where     pConsCell =@@ -276,7 +312,7 @@ -- | Like 'Prelude.all'; is 'True' if none of the list items is -- 'False'.  An empty list returns 'True'.  Is lazy; will stop -- processing if it encouters a 'False' item.-all :: Pred a -> Pred [a]+all :: (Functor m, Monad m, Applicative m) => PredM m a -> PredM m [a] all pa = contramap f (switch (addLabel "cons cell" pConsCell) pEnd)   where     pConsCell =@@ -295,11 +331,12 @@  -- | Create a 'Pred' for 'Maybe'. maybe-  :: Pred Nothing+  :: Functor m+  => PredM m Nothing   -- ^ What to do on 'Nothing'.  Usually you wil use 'true' or 'false'.-  -> Pred a+  -> PredM m a   -- ^ Analyzes 'Just' values.-  -> Pred (Maybe a)+  -> PredM m (Maybe a) maybe emp pa = contramap f   (switch (addLabel "Nothing" emp) (addLabel "Just value" pa))   where@@ -318,28 +355,31 @@ explainNot = ["(not)"]  -- | Runs a 'Pred' against a value.+testM :: Functor f => PredM f a -> a -> f Bool+testM (PredM p) = fmap (either (const False) (const True))+  . fmap splitResult . p++-- | Runs a 'Pred' against a value, without a context. test :: Pred a -> a -> Bool-test (Pred p) = either (const False) (const True)-  . splitResult . p+test p a = runIdentity $ testM p a + -- | Runs a 'Pred' against a particular value; also returns a list of -- 'Chunk' describing the steps of evaulation.-verboseTest :: Pred a -> a -> ([Chunk], Bool)-verboseTest (Pred f) a = (cks, resultToBool rslt)+verboseTestM :: Functor f => PredM f a -> a -> f ([Chunk], Bool)+verboseTestM (PredM f) a = fmap g (f a)   where-    rslt = f a-    cks = resultToChunks rslt+    g rslt = (resultToChunks rslt, resultToBool rslt) +verboseTest :: Pred a -> a -> ([Chunk], Bool)+verboseTest p a = runIdentity $ verboseTestM p a --- | Like 'verboseTest', but results are printed to standard output.--- Primarily for use in debugging or in a REPL.-verboseTestStdout :: Pred a -> a -> IO Bool-verboseTestStdout p a = do-  let (cks, r) = verboseTest p a-  t <- smartTermFromEnv IO.stdout-  putChunks t cks-  return r +-- | Obtain a list of 'Chunk' describing the evaluation process.+resultToChunks :: Result -> [Chunk]+resultToChunks = either (failedToChunks 0) (passedToChunks 0)+  . splitResult+ -- | A colorful label for 'True' values. lblTrue :: [Chunk] lblTrue = ["[", fore green <> "TRUE", "]"]@@ -390,11 +430,6 @@   = [fromText v] <+> c  -- | Obtain a list of 'Chunk' describing the evaluation process.-resultToChunks :: Result -> [Chunk]-resultToChunks = either (failedToChunks 0) (passedToChunks 0)-  . splitResult---- | Obtain a list of 'Chunk' describing the evaluation process. passedToChunks   :: Int   -- ^ Number of levels of indentation@@ -437,3 +472,13 @@             Right (y, n) -> nextPass y <> nextFail n       FOr n1 n2 -> (explainOr, nextFail n1 <> nextFail n2, (<+>))       FNot y -> (explainNot, nextPass y, (<+>))++-- | Like 'verboseTest', but results are printed to standard output.+-- Primarily for use in debugging or in a REPL.+verboseTestStdout :: Pred a -> a -> IO Bool+verboseTestStdout p a = do+  let (cks, r) = verboseTest p a+  t <- smartTermFromEnv IO.stdout+  putChunks t cks+  return r+

@@ -23,32 +23,32 @@ import Prelude hiding (maybe)  -- | A single type for both RPN tokens and infix tokens.-newtype Token a = Token { unToken :: I.InfixToken a }+newtype Token m a = Token { unToken :: I.InfixToken m a }  type Error = X.Text  -- | Creates Operands from 'Pred'.-operand :: Pred a -> Token a+operand :: PredM m a -> Token m a operand p = Token (I.TokRPN (R.TokOperand p))  -- | The And operator-opAnd :: Token a+opAnd :: Token m a opAnd = Token (I.TokRPN (R.TokOperator R.OpAnd))  -- | The Or operator-opOr :: Token a+opOr :: Token m a opOr = Token (I.TokRPN (R.TokOperator R.OpOr))  -- | The Not operator-opNot :: Token a+opNot :: Token m a opNot = Token (I.TokRPN (R.TokOperator R.OpNot))  -- | Open parentheses-openParen :: Token a+openParen :: Token m a openParen = Token (I.TokParen I.Open)  -- | Close parentheses-closeParen :: Token a+closeParen :: Token m a closeParen = Token (I.TokParen I.Close)  -- | Is this an infix or RPN expression?@@ -57,7 +57,7 @@   | RPN   deriving (Eq, Show) -toksToRPN :: [Token a] -> Maybe [R.RPNToken a]+toksToRPN :: [Token m a] -> Maybe [R.RPNToken m a] toksToRPN toks   = let toEither t = case unToken t of           I.TokRPN tok -> Right tok@@ -71,9 +71,10 @@ -- RPN expression, or multiple stack values remaining.) Works by first -- changing infix expressions to RPN ones. parseExpression-  :: ExprDesc-  -> [Token a]-  -> Either Error (Pred a)+  :: (Functor m, Monad m)+  => ExprDesc+  -> [Token m a]+  -> Either Error (PredM m a) parseExpression e toks = do   rpnToks <- case e of     Infix -> Prelude.maybe (Left "unbalanced parentheses\n") Right

@@ -7,8 +7,8 @@ import qualified Prednote.Expressions.RPN as R import qualified Data.Foldable as Fdbl -data InfixToken a-  = TokRPN (R.RPNToken a)+data InfixToken f a+  = TokRPN (R.RPNToken f a)   | TokParen Paren  data Paren = Open | Close@@ -25,9 +25,9 @@ -- output (this is done in the createRPN function.)  processInfixToken-  :: ([OpStackVal], [R.RPNToken a])-  -> InfixToken a-  -> Maybe ([OpStackVal], [R.RPNToken a])+  :: ([OpStackVal], [R.RPNToken f a])+  -> InfixToken f a+  -> Maybe ([OpStackVal], [R.RPNToken f a]) processInfixToken (os, ts) t = case t of   TokRPN tok -> return $ processRPNToken (os, ts) tok   TokParen p -> processParen (os, ts) p@@ -49,9 +49,9 @@ -- -- And has higher precedence than Or. processRPNToken-  :: ([OpStackVal], [R.RPNToken a])-  -> R.RPNToken a-  -> ([OpStackVal], [R.RPNToken a])+  :: ([OpStackVal], [R.RPNToken f a])+  -> R.RPNToken f a+  -> ([OpStackVal], [R.RPNToken f a]) processRPNToken (os, ts) t = case t of   p@(R.TokOperand _) -> (os, p:ts)   R.TokOperator d -> case d of@@ -64,7 +64,7 @@ -- | Pops operators from the operator stack and places then in the -- output queue, as long as there is an And operator on the top of the -- operator stack.-popper :: [OpStackVal] -> [R.RPNToken a] -> ([OpStackVal], [R.RPNToken a])+popper :: [OpStackVal] -> [R.RPNToken f a] -> ([OpStackVal], [R.RPNToken f a]) popper os ts = case os of   [] -> (os, ts)   x:xs -> case x of@@ -80,8 +80,8 @@ -- but not onto the output stack. Fails if the stack has no open -- parentheses. popThroughOpen-  :: ([OpStackVal], [R.RPNToken a])-  -> Maybe ([OpStackVal], [R.RPNToken a])+  :: ([OpStackVal], [R.RPNToken f a])+  -> Maybe ([OpStackVal], [R.RPNToken f a]) popThroughOpen (os, ts) = case os of   [] -> Nothing   v:vs -> case v of@@ -92,9 +92,9 @@ -- Close parenthesis, pops operators off the operator stack through -- the next open parenthesis on the operator stack. processParen-  :: ([OpStackVal], [R.RPNToken a])+  :: ([OpStackVal], [R.RPNToken f a])   -> Paren-  -> Maybe ([OpStackVal], [R.RPNToken a])+  -> Maybe ([OpStackVal], [R.RPNToken f a]) processParen (os, ts) p = case p of   Open -> Just (StkOpenParen : os, ts)   Close -> popThroughOpen (os, ts)@@ -104,11 +104,11 @@ -- RPN expression; the RPN parser must catch this. createRPN   :: Fdbl.Foldable f-  => f (InfixToken a)+  => f (InfixToken m a)   -- ^ The input tokens, with the beginning of the expression on the   -- left side of the sequence. -  -> Maybe [R.RPNToken a]+  -> Maybe [R.RPNToken m a]   -- ^ The output sequence of tokens, with the beginning of the   -- expression on the left side of the list. createRPN ts = do@@ -118,7 +118,7 @@ -- | Pops remaining items off operator stack. Fails if there is an -- open paren left on the stack, as this indicates mismatched -- parenthesis.-popRemainingOperators :: [OpStackVal] -> [R.RPNToken a] -> Maybe [R.RPNToken a]+popRemainingOperators :: [OpStackVal] -> [R.RPNToken f a] -> Maybe [R.RPNToken f a] popRemainingOperators os ts = case os of   [] -> return ts   x:xs -> case x of

@@ -7,15 +7,14 @@ module Prednote.Expressions.RPN where  import qualified Data.Foldable as Fdbl-import Prednote.Core (Pred) import qualified Prednote.Core as P-import Prednote.Core ((&&&), (|||))+import Prednote.Core ((&&&), (|||), PredM) import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as X -data RPNToken a-  = TokOperand (Pred a)+data RPNToken f a+  = TokOperand (PredM f a)   | TokOperator Operator  data Operator@@ -24,13 +23,14 @@   | OpNot   deriving Show -pushOperand :: Pred a -> [Pred a] -> [Pred a]+pushOperand :: PredM f a -> [PredM f a] -> [PredM f a] pushOperand p ts = p : ts  pushOperator-  :: Operator-  -> [Pred a]-  -> Either Text [Pred a]+  :: (Monad m, Functor m)+  => Operator+  -> [PredM m a]+  -> Either Text [PredM m a] pushOperator o ts = case o of   OpAnd -> case ts of     x:y:zs -> return $ (y &&& x) : zs@@ -46,9 +46,10 @@             <> "\" operator\n"  pushToken-  :: [Pred a]-  -> RPNToken a-  -> Either Text [Pred a]+  :: (Functor f, Monad f)+  => [PredM f a]+  -> RPNToken f a+  -> Either Text [PredM f a] pushToken ts t = case t of   TokOperand p -> return $ pushOperand p ts   TokOperator o -> pushOperator o ts@@ -60,9 +61,10 @@ -- operands left on the stack; the stack must contain exactly one -- operand in order to succeed. parseRPN-  :: Fdbl.Foldable f-  => f (RPNToken a)-  -> Either Text (Pred a)+  :: (Functor m, Monad m)+  => Fdbl.Foldable f+  => f (RPNToken m a)+  -> Either Text (PredM m a) parseRPN ts = do   trees <- Fdbl.foldlM pushToken [] ts   case trees of

@@ -3,14 +3,15 @@ -- http://www.github.com/massysett/cartel -- -- Script name used to generate: genCabal.hs--- Generated on: 2015-01-12 07:59:16.893944 EST--- Cartel library version: 0.10.0.2+-- Generated on: 2015-02-15 23:19:37.435298 EST+-- Cartel library version: 0.14.2.0+ name: prednote-version: 0.28.0.2+version: 0.30.0.0 cabal-version: >= 1.14-build-type: Simple license: BSD3 license-file: LICENSE+build-type: Simple copyright: Copyright 2013-2015 Omari Norman author: Omari Norman maintainer: omari@smileystation.com@@ -28,104 +29,104 @@   given predicate, and to parse infix or RPN expressions into a tree of   predicates. category: Data-tested-with: GHC == 7.6.3, GHC == 7.8.2+tested-with:+  GHC == 7.6.3+  GHC == 7.8.2 extra-source-files:-    README.md-  , changelog-  , genCabal.hs--source-repository head-  type: git-  location: git://github.com/massysett/prednote.git-  branch: master--Flag visual-tests-  Description: Build the prednote-visual-tests executable-  Default: False-  Manual: True+  README.md+  changelog+  genCabal.hs  Library   exposed-modules:-      Prednote-    , Prednote.Comparisons-    , Prednote.Core-    , Prednote.Expressions-    , Prednote.Expressions.Infix-    , Prednote.Expressions.RPN+    Prednote+    Prednote.Comparisons+    Prednote.Core+    Prednote.Expressions+    Prednote.Expressions.Infix+    Prednote.Expressions.RPN   build-depends:-      base ((> 4.5.0.0 || == 4.5.0.0) && < 5)-    , rainbow ((> 0.20.0.4 || == 0.20.0.4) && < 0.21)-    , split ((> 0.2.2 || == 0.2.2) && < 0.3)-    , text ((> 0.11.2.0 || == 0.11.2.0) && < 1.3)-    , containers ((> 0.4.2.1 || == 0.4.2.1) && < 0.6)-    , contravariant ((> 1.2 || == 1.2) && < 1.3)+      base >= 4.5.0.0 && < 5+    , rainbow >= 0.20.0.4 && < 0.21+    , split >= 0.2.2 && < 0.3+    , text >= 0.11.2.0 && < 1.3+    , containers >= 0.4.2.1 && < 0.6+    , contravariant >= 1.2 && < 1.3+    , transformers >= 0.3.0.0 && < 0.5   hs-source-dirs:-      lib+    lib   ghc-options:-      -Wall+    -Wall   default-language: Haskell2010 +Test-Suite prednote-tests+  hs-source-dirs:+    lib+    tests+  other-modules:+    Prednote+    Prednote.Comparisons+    Prednote.Core+    Prednote.Expressions+    Prednote.Expressions.Infix+    Prednote.Expressions.RPN+    Decrees+    Instances+    Prednote.Core.Instances+    Prednote.Core.Properties+    Rainbow.Types.Instances+  ghc-options:+    -Wall+  default-language: Haskell2010+  build-depends:+      QuickCheck >= 2.5 && < 2.8+    , quickpull >= 0.4 && < 0.5+    , base >= 4.5.0.0 && < 5+    , rainbow >= 0.20.0.4 && < 0.21+    , split >= 0.2.2 && < 0.3+    , text >= 0.11.2.0 && < 1.3+    , containers >= 0.4.2.1 && < 0.6+    , contravariant >= 1.2 && < 1.3+    , transformers >= 0.3.0.0 && < 0.5+  main-is: prednote-tests.hs+  type: exitcode-stdio-1.0+ Executable prednote-visual-tests   main-is: prednote-visual-tests.hs   if flag(visual-tests)+    buildable: True     hs-source-dirs:-        lib-      , tests+      lib+      tests     other-modules:-        Prednote-      , Prednote.Comparisons-      , Prednote.Core-      , Prednote.Expressions-      , Prednote.Expressions.Infix-      , Prednote.Expressions.RPN-      , Decrees-      , Instances-      , Prednote.Core.Instances-      , Prednote.Core.Properties-      , Rainbow.Types.Instances+      Prednote+      Prednote.Comparisons+      Prednote.Core+      Prednote.Expressions+      Prednote.Expressions.Infix+      Prednote.Expressions.RPN+      Decrees+      Instances+      Prednote.Core.Instances+      Prednote.Core.Properties+      Rainbow.Types.Instances     ghc-options:-        -Wall+      -Wall     default-language: Haskell2010     build-depends:-        QuickCheck ((> 2.5 || == 2.5) && < 2.8)-      , quickpull ((> 0.4 || == 0.4) && < 0.5)-      , base ((> 4.5.0.0 || == 4.5.0.0) && < 5)-      , rainbow ((> 0.20.0.4 || == 0.20.0.4) && < 0.21)-      , split ((> 0.2.2 || == 0.2.2) && < 0.3)-      , text ((> 0.11.2.0 || == 0.11.2.0) && < 1.3)-      , containers ((> 0.4.2.1 || == 0.4.2.1) && < 0.6)-      , contravariant ((> 1.2 || == 1.2) && < 1.3)-    buildable: True+        QuickCheck >= 2.5 && < 2.8+      , quickpull >= 0.4 && < 0.5+      , base >= 4.5.0.0 && < 5+      , rainbow >= 0.20.0.4 && < 0.21+      , split >= 0.2.2 && < 0.3+      , text >= 0.11.2.0 && < 1.3+      , containers >= 0.4.2.1 && < 0.6+      , contravariant >= 1.2 && < 1.3+      , transformers >= 0.3.0.0 && < 0.5   else     buildable: False -Test-Suite prednote-tests-  hs-source-dirs:-      lib-    , tests-  other-modules:-      Prednote-    , Prednote.Comparisons-    , Prednote.Core-    , Prednote.Expressions-    , Prednote.Expressions.Infix-    , Prednote.Expressions.RPN-    , Decrees-    , Instances-    , Prednote.Core.Instances-    , Prednote.Core.Properties-    , Rainbow.Types.Instances-  ghc-options:-      -Wall-  default-language: Haskell2010-  build-depends:-      QuickCheck ((> 2.5 || == 2.5) && < 2.8)-    , quickpull ((> 0.4 || == 0.4) && < 0.5)-    , base ((> 4.5.0.0 || == 4.5.0.0) && < 5)-    , rainbow ((> 0.20.0.4 || == 0.20.0.4) && < 0.21)-    , split ((> 0.2.2 || == 0.2.2) && < 0.3)-    , text ((> 0.11.2.0 || == 0.11.2.0) && < 1.3)-    , containers ((> 0.4.2.1 || == 0.4.2.1) && < 0.6)-    , contravariant ((> 1.2 || == 1.2) && < 1.3)-  main-is: prednote-tests.hs-  type: exitcode-stdio-1.0+Flag visual-tests+  description: Build the prednote-visual-tests executable+  default: False+  manual: True

@@ -1,3 +1,4 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Prednote.Core.Instances where @@ -5,12 +6,13 @@ import Test.QuickCheck hiding (Result) import Control.Monad import Prednote.Core--instance CoArbitrary a => Arbitrary (Pred a) where-  arbitrary = fmap Pred arbitrary+import qualified Data.Text as X -instance Arbitrary a => CoArbitrary (Pred a) where-  coarbitrary (Pred f) = coarbitrary f+instance (CoArbitrary a, Show a) => Arbitrary (Pred a) where+  arbitrary = do+    txt <- fmap X.pack arbitrary+    fn <- arbitrary+    return $ predicate txt fn  instance Arbitrary Condition where   arbitrary = fmap Condition arbitrary