packages feed

prednote 0.26.0.4 → 0.28.0.0

raw patch · 20 files changed

+1107/−835 lines, 20 filesdep +QuickCheckdep +quickpulldep ~contravariantnew-component:exe:prednote-visual-tests

Dependencies added: QuickCheck, quickpull

Dependency ranges changed: contravariant

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2013-2014, Omari Norman+Copyright (c) 2013-2015, Omari Norman  All rights reserved.
README.md view
@@ -24,11 +24,19 @@ You can view the results of building and testing on Travis by clicking the button below: -[![Build Status](https://travis-ci.org/massysett/prednote.svg?branch=v0.26.0.4)](https://travis-ci.org/massysett/prednote)+[![Build Status](https://travis-ci.org/massysett/prednote.svg?branch=master)](https://travis-ci.org/massysett/prednote)  If you have trouble building prednote due to dependency issues, try looking at the previous test results, as they will show you package versions that were used to build prednote successfully.++## Something similar++See also rematch:++http://hackage.haskell.org/package/rematch++which is apparently based on a Java library called hamcrest.  ## License
changelog view
@@ -1,3 +1,11 @@+0.28.0.0+  * Completely new API and internals; is simpler and allows+    for predicates on sum types.++0.24.0.4++  * Dependency bumps.+ 0.24.0.2    * added wrap function.
+ genCabal.hs view
@@ -0,0 +1,188 @@+-- Generates the Cabal file for prednote.+-- Written to use version 0.10.0.2 of the Cartel+-- library.++module Main where++import qualified Cartel as C++versionInts :: [Int]+versionInts = [0,28,0,0]++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]++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"+  }++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"+  }++ghcOptions :: [String]+ghcOptions = ["-Wall"]++-- Dependencies++split :: C.Package+split = C.closedOpen "split" [0,2,2] [0,3]++quickpull :: C.Package+quickpull = C.closedOpen "quickpull" [0,4] [0,5]++contravariant :: C.Package+contravariant = C.closedOpen "contravariant" [1,2] [1,3]++properties :: C.Properties+properties = commonProperties+  { C.prName = "prednote"+  , C.prDescription =+    [ "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"+    , "this tree, showing why a particular result is reached."+    , ""+    , "prednote also provides modules to test several subjects against a"+    , "given predicate, and to parse infix or RPN expressions into a tree of"+    , "predicates."+    ]+  , C.prTestedWith = map (\ls -> (C.GHC, C.eq ls))+    [ [7,6,3], [7,8,2] ]+  , C.prExtraSourceFiles =+    [ "README.md"+    , "changelog"+    , "genCabal.hs"+    ]+  }++libDepends :: [C.Package]+libDepends =+  [ base+  , rainbow+  , split+  , text+  , containers+  , contravariant+  ]++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+  ]++tests+  :: [String]+  -- ^ Library modules+  -> [String]+  -- ^ Test modules+  -> (C.TestSuite, C.Executable)+tests ls ts =+  ( C.TestSuite "prednote-tests" $+    commonTestOpts ls ts +++    [ C.TestMainIs "prednote-tests.hs"+    , C.TestType C.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+      ]+    ]+  )++commonTestOpts+  :: C.Field 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+  ]++visualTests :: C.Flag+visualTests = C.Flag+  { C.flName = "visual-tests"+  , C.flDescription = "Build the prednote-visual-tests executable"+  , C.flDefault = False+  , C.flManual = 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
lib/Prednote.hs view
@@ -1,118 +1,23 @@--- | This module provides everything you need for most uses of Prednote.--- The core type of Prednote is the 'Pred', which is a rose--- 'Tree' of predicates along with some additional information, such--- as a 'plan', which shows you how the 'Pred' will be evaluated--- without actually having to apply it to a particular subject.  When--- evaluating a 'Pred', you can also display a 'report' describing the--- evaluation process.------ This module builds 'Pred' with 'report's that make sparing use of--- color; for example, 'True' results have @[TRUE]@ indicated in--- green, @[FALSE]@ in red, and /short circuits/ (that is, 'Pred' that--- were evaluated without evaluating all their child 'Pred') indicated--- in yellow.  They are also nicely indented to indicate the structure--- of the 'Tree'.------ If you want more control over how your results are formatted,--- examine "Prednote.Core" and "Prednote.Format".--- "Prednote.Comparisons" builds on this module to provide 'Pred' to--- use for common comparisons (such as greater than, less than, etc.)--- "Prednote.Expressions" helps you parse infix or postfix (i.e. RPN)--- expressions.+-- | Prednote - annotated predicates ----- This module exports some names that conflict with Prelude names, so--- you might want to do something like+-- This module exports all the types and functions you will ordinarily+-- need.  Many names clash with Prelude names, because these names+-- made the most sense.  But I didn't make any clashing operators, as+-- I'm not that much of a masochist.  So you will probably want to do+-- something like -- -- > import qualified Prednote as P+-- > import Prednote ((|||), (&&&))+--+-- For more documentation, first see "Prednote.Prebuilt", and then+-- "Prednote.Comparisons" and then "Prednote.Expressions".  You will+-- need "Prednote.Core" only if you want to tinker under the hood. module Prednote-  ( -- * Pred-    Pred--    -- * Visibility--    -- | Upon evaluation, each 'Pred' has a visibility, indicated with-    -- 'Visible'.  It can be either 'shown' or 'hidden'.  The-    -- visibility of a 'Pred' does not affect any of the results, nor-    -- does it affect how the 'Pred' is shown in the 'plan'; rather,-    -- it affects only how the result of the 'Pred' is shown in the-    -- 'report'.  If a 'Pred' is 'hidden', its value and the value of-    -- its children is not shown in the 'report'.--  , C.Visible-  , C.shown-  , C.hidden-  , P.visibility-  , P.reveal-  , P.hide-  , P.showTrue-  , P.showFalse--    -- * Predicates--    -- | These 'Pred' have no child 'Pred'.--  , P.predicate-  , P.true-  , P.false-  , P.same--  -- * Combinators--  -- | These functions combine one more more 'Pred' to create a new-  -- 'Pred'; the argument 'Pred' become children of the new 'Pred'.--  , P.all-  , (&&&)-  , P.any-  , (|||)-  , P.not-  , P.wrap--  -- ** Fanout--  -- | These functions allow you to take a single subject and split it-  -- into multiple subjects, applying a 'Pred' to each subject that-  -- results.  As a simple example, this allows you to build a 'Pred'-  -- ['Int'] that combines 'Pred' that test individual 'Int' along-  -- with 'Pred' that examine the entire list of ['Int'].--  , P.fanAll-  , P.fanAny-  , P.fanAtLeast--  -- * Reports and plans--  -- | A 'plan' displays a 'Pred' without evaluating it, while a-  -- 'report' shows the process through which a 'Pred' was evaluated-  -- for a particular subject.--  , C.Output-  , plan-  , C.evaluate-  , report--  -- * Evaluation and reporting--  -- | These functions use 'report', 'C.evaluate', or both.--  , C.test-  , C.testV-  , C.filter-  , C.filterV+  ( module Prednote.Comparisons+  , module Prednote.Expressions+  , module Prednote.Core   ) where -import qualified Prednote.Prebuilt as P-import Prednote.Prebuilt ((&&&), (|||))-import Prednote.Core (Pred)-import qualified Prednote.Core as C-import Rainbow-import Data.Tree---- | Indents and formats static labels for display.  This is a 'plan'--- for how the 'Pred' would be applied.-plan :: Pred a -> [Chunk]-plan = C.plan 0---- | Indents and formats output for display.-report :: Tree C.Output -> [Chunk]-report = C.report 0+import Prednote.Comparisons+import Prednote.Expressions+import Prednote.Core
lib/Prednote/Comparisons.hs view
@@ -1,27 +1,38 @@ {-# LANGUAGE OverloadedStrings #-}-module Prednote.Comparisons where+module Prednote.Comparisons+  ( compareBy+  , compare+  , equalBy+  , equal+  , compareByMaybe+  , greater+  , less+  , greaterEq+  , lessEq+  , notEq+  , greaterBy+  , lessBy+  , greaterEqBy+  , lessEqBy+  , notEqBy+  , parseComparer+  ) where -import Prednote.Prebuilt-import Prednote.Format-import qualified Prednote.Core as C-import Data.Text (Text)-import qualified Data.Text as X+import Prednote.Core import Prelude hiding (compare, not) import qualified Prelude+import Data.Monoid+import qualified Data.Text as X+import Data.Text (Text)  -- | 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-  :: Text-  -- ^ Description of the type of thing that is being matched--  -> Text+  :: Show a+  => Text   -- ^ Description of the right-hand side -  -> (a -> Text)-  -- ^ Describes the left-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@@ -32,26 +43,22 @@   -- order for the Predbox to be True; otherwise it is False. The subject   -- will be on the left hand side. -  -> C.Pred a+  -> Pred a -compareBy typeDesc rhsDesc lhsDesc get ord = predicate stat dyn pd+compareBy rhsDesc get ord = predicate cond pd   where-    stat = typeDesc <+> "is" <+> ordDesc <+> rhsDesc+    cond = "is" <+> ordDesc <+> rhsDesc     ordDesc = case ord of       EQ -> "equal to"       LT -> "less than"       GT -> "greater than"-    dyn a = typeDesc <+> lhsDesc a <+> "is" <+> ordDesc <+> rhsDesc     pd a = get a == ord  -- | Overloaded version of 'compareBy'.  compare   :: (Show a, Ord a)-  => Text-  -- ^ Description of the type of thing that is being matched--  -> a+  => a   -- ^ Right-hand side    -> Ordering@@ -59,59 +66,44 @@   -- order for the Predbox to be True; otherwise it is False. The subject   -- will be on the left hand side. -  -> C.Pred a-compare typeDesc rhs ord =-  compareBy typeDesc (X.pack . show $ rhs) (X.pack . show)-            (`Prelude.compare` rhs) ord+  -> Pred a+compare rhs ord =+  compareBy (X.pack . show $ rhs) (`Prelude.compare` rhs) ord  -- | Builds a 'Pred' that tests items for equality.  equalBy-  :: Text-  -- ^ Description of the type of thing that is being matched+  :: Show a -  -> Text+  => Text   -- ^ Description of the right-hand side -  -> (a -> Text)-  -- ^ Describes the left-hand side-   -> (a -> Bool)   -- ^ How to compare an item against the right hand side.  Return   -- 'True' if the items are equal; 'False' otherwise. -  -> C.Pred a-equalBy typeDesc rhsDesc lhsDesc get = predicate stat dyn get+  -> Pred a+equalBy rhsDesc = predicate cond   where-    stat = typeDesc <+> "is equal to" <+> rhsDesc-    dyn a = typeDesc <+> lhsDesc a <+> "is equal to" <+> rhsDesc+    cond = "is equal to" <+> rhsDesc  -- | Overloaded version of 'equalBy'.  equal   :: (Eq a, Show a)-  => Text-  -- ^ Description of the type of thing that is being matched--  -> a+  => a   -- ^ Right-hand side -  -> C.Pred a-equal typeDesc rhs = equalBy typeDesc (X.pack . show $ rhs)-                             (X.pack . show) (== rhs)+  -> Pred a+equal rhs = equalBy (X.pack . show $ rhs) (== rhs)   -- | Builds a 'Pred' for items that might fail to return a comparison. compareByMaybe-  :: Text-  -- ^ Description of the type of thing that is being matched--  -> Text+  :: Show a+  => Text   -- ^ Description of the right-hand side -  -> (a -> Text)-  -- ^ Describes the left-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@@ -122,170 +114,129 @@   -- order for the Predbox to be True; otherwise it is False. The subject   -- will be on the left hand side. -  -> C.Pred a+  -> Pred a -compareByMaybe typeDesc rhsDesc lhsDesc get ord = predicate stat dyn fn+compareByMaybe rhsDesc get ord = predicate cond pd   where-    stat = typeDesc <+> "is" <+> ordDesc <+> rhsDesc-    dyn a = typeDesc <+> lhsDesc a <+> "is" <+> ordDesc <+> rhsDesc+    cond = "is" <+> ordDesc <+> rhsDesc     ordDesc = case ord of       EQ -> "equal to"       LT -> "less than"       GT -> "greater than"-    fn a = case get a of+    pd a = case get a of       Nothing -> False       Just o -> o == ord  greater   :: (Show a, Ord a) -  => Text-  -- ^ Description of the type of thing being matched--  -> a+  => a   -- ^ Right-hand side -  -> C.Pred a-greater typeDesc rhs = compare typeDesc rhs GT+  -> Pred a+greater rhs = compare rhs GT  less   :: (Show a, Ord a) -  => Text-  -- ^ Description of the type of thing being matched--  -> a+  => a   -- ^ Right-hand side -  -> C.Pred a-less typeDesc rhs = compare typeDesc rhs LT+  -> Pred a+less rhs = compare rhs LT  greaterEq   :: (Show a, Ord a)-  => Text-  -- ^ Description of the type of thing being matched--  -> a+  => a   -- ^ Right-hand side -  -> C.Pred a-greaterEq t r = greater t r ||| equal t r+  -> Pred a+greaterEq r = greater r ||| equal r  lessEq   :: (Show a, Ord a)-  => Text-  -- ^ Description of the type of thing being matched--  -> a+  => a   -- ^ Right-hand side -  -> C.Pred a-lessEq t r = less t r ||| equal t r+  -> Pred a+lessEq r = addLabel "less than or equal to" $ less r ||| equal r  notEq   :: (Show a, Eq a)-  => Text-  -- ^ Description of the type of thing being matched--  -> a+  => a   -- ^ Right-hand side -  -> C.Pred a-notEq t r = not $ equal t r+  -> Pred a+notEq = not . equal  greaterBy-  :: Text-  -- ^ Description of the type of thing being matched--  -> Text+  :: Show a+  => Text   -- ^ Description of right-hand side -  -> (a -> Text)-  -- ^ Describes the left-hand side-   -> (a -> 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. -  -> C.Pred a-greaterBy dT dR dL get = compareBy dT dR dL get GT+  -> Pred a+greaterBy desc get = compareBy desc get GT   lessBy-  :: Text-  -- ^ Description of the type of thing being matched--  -> Text+  :: Show a+  => Text   -- ^ Description of right-hand side -  -> (a -> Text)-  -- ^ Describes the left-hand side-   -> (a -> 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. -  -> C.Pred a-lessBy dT dR dL get = compareBy dT dR dL get LT+  -> Pred a+lessBy desc get = compareBy desc get LT  greaterEqBy-  :: Text-  -- ^ Description of the type of thing being matched--  -> Text+  :: Show a+  => Text   -- ^ Description of right-hand side -  -> (a -> Text)-  -- ^ Describes the left-hand side-   -> (a -> 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. -  -> C.Pred a-greaterEqBy dT dR dL f = greaterBy dT dR dL f ||| equalBy dT dR dL f'+  -> Pred a+greaterEqBy desc get = greaterBy desc get ||| equalBy desc f'   where-    f' = fmap (== EQ) f+    f' = fmap (== EQ) get  lessEqBy-  :: Text-  -- ^ Description of the type of thing being matched--  -> Text+  :: Show a+  => Text   -- ^ Description of right-hand side -  -> (a -> Text)-  -- ^ Describes the left-hand side-   -> (a -> 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. -  -> C.Pred a-lessEqBy dT dR dL f = lessBy dT dR dL f ||| equalBy dT dR dL f'+  -> Pred a+lessEqBy desc get = lessBy desc get ||| equalBy desc f'   where-    f' = fmap (== EQ) f+    f' = fmap (== EQ) get  notEqBy-  :: Text-  -- ^ Description of the type of thing being matched--  -> Text+  :: Show a+  => Text   -- ^ Description of right-hand side -  -> (a -> Text)-  -- ^ Describes the left-hand side-   -> (a -> Bool)   -- ^ How to compare an item against the right hand side.  Return   -- 'True' if equal; 'False' otherwise. -  -> C.Pred a-notEqBy dT dR dL = not . equalBy dT dR dL+  -> Pred a+notEqBy desc = not . equalBy desc   -- | Parses a string that contains text, such as @>=@, which indicates@@ -294,14 +245,14 @@   :: Text   -- ^ The string with the comparer to be parsed -  -> (Ordering -> C.Pred a)-  -- ^ A function that, when given an ordering, returns a 'C.Pred'.+  -> (Ordering -> Pred 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 (C.Pred a)+  -> Maybe (Pred a)   -- ^ If an invalid comparer string is given, Nothing; otherwise, the-  -- 'C.Pred'.+  -- 'Pred'. parseComparer t f   | t == ">" = Just (f GT)   | t == "<" = Just (f LT)@@ -312,4 +263,13 @@   | t == "/=" = Just (not $ f EQ)   | t == "!=" = Just (not $ f EQ)   | otherwise = Nothing++-- | Append two 'X.Text', with an intervening space if both 'X.Text'+-- are not empty.+(<+>) :: Text -> Text -> Text+l <+> r+  | full l && full r = l <> " " <> r+  | otherwise = l <> r+  where+    full = Prelude.not . X.null
lib/Prednote/Core.hs view
@@ -1,325 +1,439 @@-{-# LANGUAGE BangPatterns #-}--- | 'Pred' core functions.  If your needs are simple, "Prednote.Prebuilt"--- is easier to use.  However, the types and functions in this module--- give you more control.------ Each function in this module that returns a 'Pred' returns one with--- the following characteristics:------ * No 'static' name------ Upon evaluation:------ * 'visible' is always 'shown'------ * 'short' is either 'Nothing' or @'Just' ('const' [])@------ * 'dynamic' is always @'const' []@------ Thus, the 'Pred' created by this module are rather bare-bones, but--- you can modify them as you see fit; "Prednote.Prebuilt" already--- does this for you.------ This module exports some names that conflict with Prelude names, so--- you might want to do something like------ > import qualified Prednote.Pred.Core as P+{-# LANGUAGE OverloadedStrings #-}+module Prednote.Core+  ( -- * Predicates and their creation+    Pred(..)+  , predicate -module Prednote.Core where+  -- * Predicate combinators+  -- ** Primitive combinators+  --+  -- | You might consider these combinators to be \"primitive\" in the+  -- sense that you can build a 'Pred' for any user-defined type by+  -- using these combinators alone, along with 'contramap'.  Use+  -- '&&&', '|||', and 'contramap' to analyze product types.  Use 'switch'+  -- and 'contramap' to analyze sum types.  For a simple example, see the+  -- source code for 'maybe', which is a simple sum type.  For more+  -- complicated examples, see the source code for 'any' and 'all', as+  -- a list is a sum type where one of the summands is a (recursive!)+  -- product type.+  , (&&&)+  , (|||)+  , not+  , switch +  -- ** Convenience combinators+  --+  -- | These were written using entirely the \"primitive\" combinators+  -- given above.+  , any+  , all+  , Nothing+  , maybe++  -- * Labeling+  , addLabel++  -- * Constant predicates+  , true+  , false+  , same++  -- * Evaluating predicates+  , test+  , verboseTest+  , verboseTestStdout++  -- * Results and converting them to 'Chunk's+  --+  -- | Usually you will not need these functions and types, as the+  -- functions and types above should meet most use cases; however,+  -- these are here so the test suites can use them, and in case you+  -- need them.+  , Condition(..)+  , Value(..)+  , Label(..)+  , Labeled(..)+  , Passed(..)+  , Failed(..)+  , Result(..)+  , splitResult+  , resultToChunks+  , passedToChunks+  , failedToChunks+  ) where+ import Rainbow-import Prelude hiding (filter, not)+import Data.Monoid+import Data.Functor.Contravariant+import Prelude hiding (all, any, maybe, and, or, not) import qualified Prelude-import Data.Functor.Contravariant (Contravariant(..))-import Data.Tree+import qualified System.IO as IO import qualified Data.Text as X-import Data.Maybe+import Data.Text (Text)+import Data.List (intersperse) --- | Indicates how to display text.  This function is applied to an--- 'Int' that is the level of indentation; each level of descent--- through a tree of 'Pred' increments this 'Int' by one.  Because the--- function returns a list of 'Chunk', you can use multiple colors.--- Typically this function will indent text accordingly, with a--- newline at the end.-type Chunker = Int -> [Chunk]+-- | Describes the condition; for example, for a @'Pred' 'Int'@,+-- this might be @is greater than 5@; for a @'Pred' 'String'@, this+-- might be @begins with \"Hello\"@.+newtype Condition = Condition [Chunk]+  deriving (Eq, Ord, Show) --- | A rose tree of predicates.-data Pred a = Pred-  { static :: Tree Chunker-    -- ^ A tree of static names, allowing you to identify the 'Pred'-    -- without applying it to a subject.+-- | Stores the representation of a value; created using @'X.pack' '.'+-- 'show'@.+newtype Value = Value Text+  deriving (Eq, Ord, Show) -  , evaluate :: a -> Tree Output-    -- ^ Evaluates a 'Pred' by applying it to a subject.-  }+-- | Gives additional information about a particular 'Pred' to aid the+-- user when viewing the output.+newtype Label = Label Text+  deriving (Eq, Ord, Show) -instance Contravariant Pred where-  contramap f (Pred s e) = Pred s (e . f)+-- | Any type that is accompanied by a set of labels.+data Labeled a = Labeled [Label] a+  deriving (Eq, Ord, Show) --- | The result of evaluating a 'Pred'.-data Output = Output-  { result :: Bool-  , visible :: Visible-    -- ^ Results that are not 'Visible' are not shown by the 'report'-    -- function.-  , short :: Maybe Chunker-    -- ^ Indicates whether there was a short circuit when evaluating-    -- this 'Pred'.  A short circuit occurs when the 'Pred' does not-    -- need to evaluate all of its children in order to reach a-    -- result.  If 'Nothing', there was no short circuit; otherwise,-    -- this is a 'Just' with a 'Chunker' providing a way to display-    -- the short circuit.+instance Functor Labeled where+  fmap f (Labeled l a) = Labeled l (f a) -  , dynamic :: Chunker-    -- ^ The dynamic label; this indicates how 'report' will show the-    -- 'Pred' to the user after it has been evaluated.-  }+-- | A 'Pred' that returned 'True'+data Passed+  = PTerminal Value Condition+  -- ^ A 'Pred' created with 'predicate'+  | PAnd (Labeled Passed) (Labeled Passed)+  -- ^ A 'Pred' created with '&&&'+  | POr (Either (Labeled Passed) (Labeled Failed, Labeled Passed))+  -- ^ A 'Pred' created with '|||'+  | PNot (Labeled Failed)+  -- ^ A 'Pred' created with 'not'+  deriving (Eq, Ord, Show) -instance Show Output where-  show (Output r v _ _) = "output - result: " ++ show r-    ++ " visible: " ++ (show . unVisible $ v)+-- | A 'Pred' that returned 'False'+data Failed+  = FTerminal Value Condition+  -- ^ A 'Pred' created with 'predicate'+  | FAnd (Either (Labeled Failed) (Labeled Passed, Labeled Failed))+  -- ^ A 'Pred' created with '&&&'+  | FOr (Labeled Failed) (Labeled Failed)+  -- ^ A 'Pred' created with '|||'+  | FNot (Labeled Passed)+  -- ^ A 'Pred' created with 'not'+  deriving (Eq, Ord, Show) --- | Is this result visible?  If not, 'Prednote.report' will not show it.-newtype Visible = Visible { unVisible :: Bool }++-- | The result of processing a 'Pred'.+newtype Result = Result (Labeled (Either Failed Passed))   deriving (Eq, Ord, Show) --- | Shown by 'Prednote.report'-shown :: Visible-shown = Visible True+-- | Returns whether this 'Result' failed or passed.+splitResult+  :: Result+  -> Either (Labeled Failed) (Labeled Passed)+splitResult (Result (Labeled l ei)) = case ei of+  Left n -> Left (Labeled l n)+  Right g -> Right (Labeled l g) --- | Hidden by 'Prednote.report'-hidden :: Visible-hidden = Visible False+-- | 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) --- | No 'Pred' in the list may be 'False' for 'all' to be 'True'.  An--- empty list of 'Pred' yields a 'Pred' that always returns 'True'.--- May short circuit.-all :: [Pred a] -> Pred a-all ls = Pred st' ev+instance Show (Pred a) where+  show _ = "Pred"++instance Contravariant Pred where+  contramap f (Pred g) = Pred (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"@.+predicate+  :: Show a+  => Text+  -> (a -> Bool)+  -> Pred a+predicate tCond p = Pred f   where-    st' = Node (const []) . map static $ ls-    ev a = go [] ls+    f a = Result (Labeled [] r)       where-        go soFar [] = Node (Output True shown Nothing (const []))-          (reverse soFar)-        go soFar (x:xs) =-          let tree = evaluate x a-              r = result . rootLabel $ tree-              shrt = case xs of-                [] -> Nothing-                _ -> Just (const [])-              out = Output r shown shrt (const [])-              cs = reverse (tree:soFar)-          in case xs of-              [] -> Node out cs-              _ | Prelude.not r -> Node out cs-                | otherwise -> go cs xs+        r | p a = Right (PTerminal val cond)+          | otherwise = Left (FTerminal val cond)+        cond = Condition [fromText tCond]+        val = Value . X.pack . show $ a  --- | At least one 'Pred' in the list must be 'True' for the resulting--- 'Pred' to be 'True'.  An empty list of 'Pred' yields a 'Pred' that--- always returns 'False'.  May short circuit.-any :: [Pred a] -> Pred a-any ls = Pred st' ev+-- | 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-    st' = Node (const []) . map static $ ls-    ev a = go [] ls+    f a = Result (Labeled [] rslt)       where-        go soFar [] = Node (Output False shown Nothing (const []))-          (reverse soFar)-        go soFar (x:xs) =-          let tree = evaluate x a-              r = result . rootLabel $ tree-              shrt = case xs of-                [] -> Nothing-                _ -> Just (const [])-              out = Output r shown shrt (const [])-              cs = reverse (tree:soFar)-          in case xs of-              [] -> Node out cs-              _ | r -> Node out cs-                | otherwise -> go cs xs+        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+infixr 3 &&&  --- | Negates the child 'Pred'.  Never short circuits.-not :: Pred a -> Pred a-not pd = Pred st' ev+-- | 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-    st' = Node (const []) [static pd]-    ev a = Node nd [c]+    Pred fR = r+    f a = Result (Labeled [] rslt)       where-        nd = Output res shown Nothing (const [])-        (res, c) = (Prelude.not r, t)-          where-            t = evaluate pd a-            r = result . rootLabel $ t+        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)+infixr 2 ||| --- | Fanout.  May short circuit.-fan-  :: ([Bool] -> (Bool, Visible, Maybe Int))-  -- ^ This function is applied to a list of the 'result' from-  -- evaluating the child 'Pred' on each fanout item.  The function-  -- must return a triple, with the 'Bool' indicating success or-  -- failure, 'Visible' for visibility, and 'Maybe' 'Int' to indicate-  -- whether a short circuit occurred; this must be 'Nothing' if there-  -- was no short circuit, or 'Just' with an 'Int' to indicate a short-  -- circuit, with the 'Int' indicating that a short circuit occurred-  -- after examining the given number of elements.-  ---  -- The resulting 'Pred' always short circuits if the previous-  -- function returns a 'Just' 'Int' with the 'Int' being less than-  -- zero.  Otherwise, the resulting 'Pred' short circuits if-  -- the 'Int' is less than the number of elements returned by the-  -- fanout function. -  -> (a -> [b])-  -- ^ Fanout function--  -> Pred b-  -> Pred a-fan get fn pd = Pred st' ev+-- | Negation.  Returns 'True' if the argument 'Pred' returns 'False'.+not :: Pred a -> Pred a+not (Pred f) = Pred g   where-    st' = Node (const []) [static pd]-    ev a = Node nd cs+    g a = Result (Labeled [] rslt)       where-        nd = Output r v shrt (const [])-        (r, v, mayInt) = get bools-        shrt = case mayInt of-          Nothing -> Nothing-          Just s | s < 0 -> Just (const [])-                 | cs `shorter` allcs -> Just (const [])-                 | otherwise -> Nothing-        bs = fn a-        allcs = map (evaluate pd) bs-        bools = map (result . rootLabel) allcs-        cs = case mayInt of-          Nothing -> allcs-          Just i -> take i allcs+        rslt = case splitResult $ f a of+          Left b -> Right (PNot b)+          Right y -> Left (FNot y)  --- | Fanout all.  The resulting 'Pred' is 'True' if no child item--- returns 'False'; an empty list of child items returns 'True'.  May--- short circuit.-fanAll-  :: (a -> [b])-  -- ^ Fanout function-+-- | Uses the appropriate 'Pred' depending on the 'Either' value.  In+-- @'test' ('switch' l r) e@, the resulting 'Pred' returns the result+-- 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 a-fanAll = fan get+  -> Pred (Either a b)+switch pa pb = Pred (either fa fb)   where-    get = go 0-      where-        go !c ls = case ls of-          [] -> (True, shown, Just c)-          x:xs-            | Prelude.not x -> (False, shown, Just (c + 1))-            | otherwise -> go (c + 1) xs+    Pred fa = pa+    Pred fb = pb --- | Fanout any.  The resulting 'Pred' is 'True' if at least one child--- item returns 'True'; an empty list of child items returns 'False'.--- May short circuit.-fanAny-  :: (a -> [b])-  -- ^ Fanout function+-- | Did this 'Result' pass or fail?+resultToBool :: Result -> Bool+resultToBool (Result (Labeled _ ei))+  = either (const False) (const True) ei -  -> Pred b-  -> Pred a-fanAny = fan get++-- | Always returns 'True'+true :: Show a => Pred a+true = predicate "always returns True" (const True)++-- | Always returns 'False'+false :: Show a => Pred a+false = predicate "always returns False" (const False)++-- | Always returns its argument+same :: Pred Bool+same = predicate "is returned" 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' or the source code for "Prednote.Comparisons".+addLabel :: Text -> Pred a -> Pred a+addLabel s (Pred f) = Pred f'   where-    get = go 0+    f' a = Result (Labeled (Label s : ss) ei)       where-        go !c ls = case ls of-          [] -> (False, shown, Just c)-          x:xs-            | x -> (True, shown, Just (c + 1))-            | otherwise -> go (c + 1) xs+        Result (Labeled ss ei) = f a --- | Fanout at least.  The resulting 'Pred' is 'True' if at least the--- given number of child items return 'True'.  May short circuit.-fanAtLeast-  :: Int-  -- ^ Find at least this many.  If this number is less than or equal-  -- to zero, 'fanAtLeast' will always return 'True'. -  -> (a -> [b])-  -- ^ Fanout function+-- | Represents the end of a list.+data EndOfList = EndOfList -  -> Pred b-  -> Pred a-fanAtLeast i = fan get+instance Show EndOfList where+  show _ = ""++-- | 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 pa = contramap f (switch (addLabel "cons cell" pConsCell) pEnd)   where-    get = go 0 0-      where-        go !found !c ls-          | found >= i = (True, shown, Just c)-          | otherwise = case ls of-              [] -> (False, shown, Just c)-              x:xs -> go fnd' (c + 1) xs-                where-                  fnd' | x = found + 1-                       | otherwise = found+    pConsCell =+      contramap fst (addLabel "head" pa)+      ||| contramap snd (addLabel "tail" (any pa))+    f ls = case ls of+      [] -> Right EndOfList+      x:xs -> Left (x, xs)+    pEnd = addLabel "end of list" $ contramap (const EndOfList) false --- | Indents and formats output for display.-report-  :: Int-  -- ^ Start at this level of indentation.-  -> Tree Output-  -> [Chunk]-report l (Node n cs)-  | (== hidden) . visible $ n = []-  | otherwise = this ++ concatMap (report (l + 1)) cs ++ shrt+-- | 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 pa = contramap f (switch (addLabel "cons cell" pConsCell) pEnd)   where-    this = dynamic n l-    shrt = maybe [] ($ (l + 1)) . short $ n+    pConsCell =+      contramap fst (addLabel "head" pa)+      &&& contramap snd (addLabel "tail" (all pa))+    f ls = case ls of+      x:xs -> Left (x, xs)+      [] -> Right EndOfList+    pEnd = addLabel "end of list" $ contramap (const EndOfList) true --- | Indents and formats static labels for display.  This is a 'plan'--- for how the 'Pred' would be applied.-plan-  :: Int-  -- ^ Start at this level of indentation.+-- | Represents 'Prelude.Nothing' of 'Maybe'.+data Nothing = CoreNothing++instance Show Nothing where+  show _ = ""++-- | Create a 'Pred' for 'Maybe'.+maybe+  :: Pred Nothing+  -- ^ What to do on 'Nothing'.  Usually you wil use 'true' or 'false'.   -> Pred a-  -> [Chunk]-plan lvl pd = go lvl (static pd)+  -- ^ Analyzes 'Just' values.+  -> Pred (Maybe a)+maybe emp pa = contramap f+  (switch (addLabel "Nothing" emp) (addLabel "Just value" pa))   where-    go l (Node n cs) = this ++ concatMap (go (l + 1)) cs-      where-        this = n l+    f may = case may of+      Nothing -> Left CoreNothing+      Just a -> Right a -instance Show (Pred a) where-  show = X.unpack . X.concat . concat . map text-    . plan 0 --- | Applies a 'Pred' to a single subject and returns the 'result'.+explainAnd :: [Chunk]+explainAnd = ["(and)"]++explainOr :: [Chunk]+explainOr = ["(or)"]++explainNot :: [Chunk]+explainNot = ["(not)"]++-- | Runs a 'Pred' against a value. test :: Pred a -> a -> Bool-test p = result . rootLabel . evaluate p+test (Pred p) = either (const False) (const True)+  . splitResult . p --- | Like 'test' but also returns the accompanying 'report'.-testV :: Pred a -> a -> (Bool, [Chunk])-testV p a = (result . rootLabel $ t, report 0 t)+-- | 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)   where-    t = evaluate p a+    rslt = f a+    cks = resultToChunks rslt --- | Like 'Prelude.filter'.-filter :: Pred a -> [a] -> [a]-filter p = Prelude.filter (test p) --- | Like 'filter' but also returns a list of 'report', with one--- 'report' for each list item.-filterV :: Pred a -> [a] -> ([a], [Chunk])-filterV p as = (mapMaybe fltr (zip as rslts), cks)+-- | 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++-- | A colorful label for 'True' values.+lblTrue :: [Chunk]+lblTrue = ["[", fore green <> "TRUE", "]"]++-- | A colorful label for 'False' values.+lblFalse :: [Chunk]+lblFalse = ["[", fore red <> "FALSE", "]"]++-- | Append two lists of 'Chunk', with an intervening space if both+-- lists are not empty.+(<+>) :: [Chunk] -> [Chunk] -> [Chunk]+l <+> r+  | full l && full r = l <> [" "] <> r+  | otherwise = l <> r   where-    fltr (a, r)-      | result . rootLabel $ r = Just a-      | otherwise = Nothing-    rslts = map (evaluate p) as-    cks = concatMap (report 0) rslts+    full = Prelude.not . chunksNull --- | @shorter x y@ is True if list x is shorter than list y. Lazier--- than taking the length of each list and comparing the results.-shorter :: [a] -> [a] -> Bool-shorter [] [] = False-shorter (_:_) [] = False-shorter [] (_:_) = True-shorter (_:xs) (_:ys) = shorter xs ys+-- | Append two lists of 'Chunk', with an intervening hyphen if both+-- lists have text.+(<->) :: [Chunk] -> [Chunk] -> [Chunk]+l <-> r+  | full l && full r = l <> hyphen <> r+  | otherwise = l <> r+  where+    full = Prelude.not . chunksNull +hyphen :: [Chunk]+hyphen = [" - "]++chunksNull :: [Chunk] -> Bool+chunksNull = Prelude.all $ Prelude.all X.null . text++indentAmt :: Int+indentAmt = 2++spaces :: Int -> [Chunk]+spaces i = (:[]) . fromText . X.replicate (i * indentAmt)+  . X.singleton $ ' '++newline :: [Chunk]+newline = ["\n"]++labelToChunks :: Label -> [Chunk]+labelToChunks (Label txt) = [fromText txt]++explainTerminal :: Value -> Condition -> [Chunk]+explainTerminal (Value v) (Condition c)+  = [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+  -> Labeled Passed+  -> [Chunk]+passedToChunks i (Labeled l p) = this <> rest+  where+    this = spaces i <> (lblTrue <+> (labels `sep` explain)) <> newline+    labels = concat . intersperse hyphen . map labelToChunks $ l+    nextPass = passedToChunks (succ i)+    nextFail = failedToChunks (succ i)+    (explain, rest, sep) = case p of+      PTerminal v c -> (explainTerminal v c, [], (<->))+      PAnd p1 p2 -> (explainAnd, nextPass p1 <> nextPass p2, (<+>))+      POr ei -> (explainOr, more, (<+>))+        where+          more = case ei of+            Left y -> nextPass y+            Right (n, y) -> nextFail n <> nextPass y+      PNot n -> (explainNot, nextFail n, (<+>))++-- | Obtain a list of 'Chunk' describing the evaluation process.+failedToChunks+  :: Int+  -- ^ Number of levels of indentation+  -> Labeled Failed+  -> [Chunk]+failedToChunks i (Labeled l p) = this <> rest+  where+    this = spaces i <> (lblFalse <+> (labels `sep` explain)) <> newline+    labels = concat . intersperse hyphen . map labelToChunks $ l+    nextPass = passedToChunks (succ i)+    nextFail = failedToChunks (succ i)+    (explain, rest, sep) = case p of+      FTerminal v c -> (explainTerminal v c, [], (<->))+      FAnd ei -> (explainAnd, more, (<+>))+        where+          more = case ei of+            Left n -> nextFail n+            Right (y, n) -> nextPass y <> nextFail n+      FOr n1 n2 -> (explainOr, nextFail n1 <> nextFail n2, (<+>))+      FNot y -> (explainNot, nextPass y, (<+>))
lib/Prednote/Expressions.hs view
@@ -15,18 +15,16 @@   ) where  import Data.Either (partitionEithers)-import Data.Functor.Contravariant import qualified Data.Text as X import qualified Prednote.Expressions.Infix as I import qualified Prednote.Expressions.RPN as R-import Prednote.Core (Pred)+import Prednote.Core+import qualified Prelude+import Prelude hiding (maybe)  -- | A single type for both RPN tokens and infix tokens. newtype Token a = Token { unToken :: I.InfixToken a } -instance Contravariant Token where-  contramap f = Token . contramap f . unToken- type Error = X.Text  -- | Creates Operands from Predbox.@@ -78,10 +76,10 @@   -> Either Error (Pred a) parseExpression e toks = do   rpnToks <- case e of-    Infix -> maybe (Left "unbalanced parentheses\n") Right+    Infix -> Prelude.maybe (Left "unbalanced parentheses\n") Right              . I.createRPN              . map unToken              $ toks-    RPN -> maybe (Left "parentheses in an RPN expression\n") Right+    RPN -> Prelude.maybe (Left "parentheses in an RPN expression\n") Right            $ toksToRPN toks   R.parseRPN rpnToks
lib/Prednote/Expressions/Infix.hs view
@@ -4,18 +4,12 @@   , createRPN   ) where -import Data.Functor.Contravariant import qualified Prednote.Expressions.RPN as R import qualified Data.Foldable as Fdbl  data InfixToken a   = TokRPN (R.RPNToken a)   | TokParen Paren--instance Contravariant InfixToken where-  contramap f t = case t of-    TokRPN r -> TokRPN . contramap f $ r-    TokParen p -> TokParen p  data Paren = Open | Close
lib/Prednote/Expressions/RPN.hs view
@@ -6,11 +6,10 @@ -- where @and@ and @or@ are binary and @not@ is unary. module Prednote.Expressions.RPN where -import Data.Functor.Contravariant import qualified Data.Foldable as Fdbl-import qualified Prednote.Prebuilt as P import Prednote.Core (Pred)-import Prednote.Prebuilt ((&&&), (|||))+import qualified Prednote.Core as P+import Prednote.Core ((&&&), (|||)) import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as X@@ -19,11 +18,6 @@   = TokOperand (Pred a)   | TokOperator Operator -instance Contravariant RPNToken where-  contramap f t = case t of-    TokOperand p -> TokOperand . contramap f $ p-    TokOperator o -> TokOperator o- data Operator   = OpAnd   | OpOr@@ -59,8 +53,9 @@   TokOperand p -> return $ pushOperand p ts   TokOperator o -> pushOperator o ts +-- TODO improve "Bad expression" error message? --- | Parses an RPN expression and returns the resulting Predbox. Fails if+-- | Parses an RPN expression and returns the resulting 'Pred'. Fails if -- there are no operands left on the stack or if there are multiple -- operands left on the stack; the stack must contain exactly one -- operand in order to succeed.
− lib/Prednote/Format.hs 
@@ -1,110 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--- | Functions used to format text.  Typically you won't need these--- unless you want tailored control over how your 'Prednote.Core.Pred'--- are formatted.-module Prednote.Format where--import Rainbow-import Data.Text (Text)-import qualified Data.Text as X-import qualified Prednote.Core as C-import qualified Data.Tree as E-import Data.Monoid---- # Labels and indentation---- | A colorful label for 'True' values.-lblTrue :: [Chunk]-lblTrue = ["[", fore green <> "TRUE", "]"]---- | A colorful label for 'False' values.-lblFalse :: [Chunk]-lblFalse = ["[", fore red <> "FALSE", "]"]---- | Indent amount.-indentAmt :: Int-indentAmt = 2---- | Prefixes the given 'Text' with colorful text to indicate 'True'--- or 'False' as appropriate.-lblLine :: Bool -> Text -> [Chunk]-lblLine b t = lbl ++ [" ", fromText t]-  where-    lbl | b = lblTrue-        | otherwise = lblFalse---- | Indents the given list of 'Chunk' by the given 'Int' multipled by--- 'indentAmt'.  Appends a newline.-indent :: [Chunk] -> Int -> [Chunk]-indent cs i = spaces : cs ++ [fromText "\n"]-  where-    spaces = fromText . X.replicate (indentAmt * i)-      . X.singleton $ ' '---- | A label for a short circuit.-shortCir :: Int -> [Chunk]-shortCir = indent ["[", fore yellow <> "short circuit", "]"]---- | Indents a 'Text' by the given 'Int' multiplied by--- 'indentAmt'.-indentTxt :: Text -> Int -> [Chunk]-indentTxt = indent . (:[]) . fromText---- | Append two 'Text', with an intervening space if both 'Text' are--- not empty.-(<+>) :: Text -> Text -> Text-l <+> r-  | full l && full r = l <> " " <> r-  | otherwise = l <> r-  where-    full = Prelude.not . X.null---- | Create a new 'C.Pred' with a different static label.-rename :: Text -> C.Pred a -> C.Pred a-rename x p = p { C.static = (C.static p)-  { E.rootLabel = indentTxt x } }---- | Creates a new 'C.Pred' with a result differing from the original--- 'C.Pred'.-changeOutput-  :: (a -> C.Output -> C.Output)-  -- ^ Function to modify the 'C.Output'--  -> C.Pred a-  -- ^ Modify the 'C.Output' of this 'C.Pred'--  -> C.Pred a-changeOutput f p = p { C.evaluate = e' }-  where-    e' a = t'-      where-        t = C.evaluate p a-        t' = t { E.rootLabel = f a (E.rootLabel t) }---- | Creates a new 'C.Pred' with a different dynamic label.-speak-  :: (a -> Text)-  -- ^ New dynamic label.  Do not indicate whether the result is-  -- 'True' or 'False'; this is done for you.--  -> C.Pred a--  -> C.Pred a-speak f = changeOutput g-  where-    g a o = o { C.dynamic = dyn }-      where-        dyn = indent $ lblLine (C.result o) (f a)----- | Creates a new 'C.Pred' with any short circuits having a colorful--- label.-speakShort :: C.Pred a -> C.Pred a-speakShort p = p { C.evaluate = e' }-  where-    e' a = t { E.rootLabel = (E.rootLabel t)-      { C.short = fmap (const shortCir) shrt } }-      where-        t = C.evaluate p a-        shrt = C.short . E.rootLabel $ t-
− lib/Prednote/Prebuilt.hs 
@@ -1,179 +0,0 @@-{-# LANGUAGE OverloadedStrings, BangPatterns #-}---- | Functions to work with 'Pred'.  This module works with 'Text' and--- produces 'Pred' that make sparing use of color.  For more control--- over the 'Pred' produced, use "Prednote.Pred.Core".------ Exports some names that conflict with Prelude names, so you might--- want to do something like------ > import qualified Prednote.Pred as P-module Prednote.Prebuilt where--import qualified Prednote.Core as C-import Prednote.Format-import qualified Data.Tree as E-import qualified Data.Text as X-import Data.Text (Text)-import Data.Monoid-import Prelude hiding (and, or, not, filter, compare, any, all)-import qualified Prelude---- # Predicate---- | Builds predicates.-predicate-  :: Text-  -- ^ Static label--  -> (a -> Text)-  -- ^ Computes the dynamic label.  Do not indicate whether the result-  -- is 'True' or 'False'; this is automatically done for you.--  -> (a -> Bool)-  -- ^ Predicate function--  -> C.Pred a--predicate r s f = rename r . speak s $ C.Pred (E.Node (const []) []) ev-  where-    ev a = E.Node (C.Output (f a) C.shown Nothing (const [])) []---- | Always returns 'True' and is always visible.-true :: C.Pred a-true = predicate l (const l) (const True)-  where-    l = "always True"---- | Always returns 'False' and is always visible.-false :: C.Pred a-false = predicate l (const l) (const False)-  where-    l = "always False"---- | Returns the subject as is; is always visible.-same :: C.Pred Bool-same = predicate l (const l) id-  where-    l = "same as subject"---- # Wrap---- | Makes an existing 'C.Pred' the child of a new 'C.Pred'.  The new--- 'Pred' has the same 'C.result' as the child 'C.Pred'.  The new--- 'C.Pred' is always visible and never short circuits.--wrap-  :: Text-  -- ^ Static label--  -> (a -> Text)-  -- ^ Computes the dynamic label.  Do not indicate whether the result-  -- is 'True' or 'False'; this is automatically done for you.--  -> (a -> b)-  -> C.Pred b-  -> C.Pred a-wrap st dyn wr p = C.Pred trC ev-  where-    trC = E.Node (indentTxt st) [C.static p]-    ev a = E.Node o [c]-      where-        c = C.evaluate p (wr a)-        r = C.result . E.rootLabel $ c-        o = C.Output r C.shown Nothing dy-        dy = indent $ lblLine r (dyn a)----- # Visibility---- | Creates a 'C.Pred' with its visibility modified.-visibility-  :: (Bool -> C.Visible)-  -- ^ When applied to the 'C.result' of the 'C.Pred', this function-  -- returns the desired visibility.-  -> C.Pred a-  -> C.Pred a-visibility f (C.Pred s e) = C.Pred s e'-  where-    e' a = g (e a)-    g (E.Node n cs) = E.Node n { C.visible = f (C.result n) } cs---- | Creates a 'C.Pred' that is always shown.-reveal :: C.Pred a -> C.Pred a-reveal = visibility (const C.shown)---- | Creates a 'C.Pred' that is always hidden.-hide :: C.Pred a -> C.Pred a-hide = visibility (const C.hidden)---- | Creates a 'C.Pred' that is shown only if its 'C.result' is--- 'True'.-showTrue :: C.Pred a -> C.Pred a-showTrue = visibility (\b -> if b then C.shown else C.hidden)---- | Creates a 'C.Pred' that is shown only if its 'C.result' is--- 'False'.-showFalse :: C.Pred a -> C.Pred a-showFalse = visibility (\b -> if Prelude.not b then C.shown else C.hidden)---- # Conjunction and disjunction, negation---- | No child 'Pred' may be 'False'.  An empty list of child 'Pred'--- returns 'True'.  Always visible.-all :: [C.Pred a] -> C.Pred a-all = speakShort . rename l . speak (const l) . C.all-  where-    l = "all"---- | Creates 'all' 'Pred' that are always visible.-(&&&) :: C.Pred a -> C.Pred a -> C.Pred a-l &&& r = all [l, r]--infixr 3 &&&---- | At least one child 'Pred' must be 'True'.  An empty list of child--- 'Pred' returns 'False'.  Always visible.-any :: [C.Pred a] -> C.Pred a-any = speakShort . rename l . speak (const l) . C.any-  where-    l = "any"----- | Creates 'any' 'Pred' that are always visible.-(|||) :: C.Pred a -> C.Pred a -> C.Pred a-l ||| r = any [l, r]--infixr 2 |||---- | Negation.  Always visible.-not :: C.Pred a -> C.Pred a-not = rename l . speak (const l) . C.not-  where-    l = "not"---- | No fanned-out item may be 'False'.  An empty list of child items--- returns 'True'.-fanAll :: (a -> [b]) -> C.Pred b -> C.Pred a-fanAll f = speakShort . rename l . speak (const l) . C.fanAll f-  where-    l = "fanout all"------ | At least one fanned-out item must be 'True'.  An empty list of--- child items returns 'False'.-fanAny :: (a -> [b]) -> C.Pred b -> C.Pred a-fanAny f = speakShort . rename l . speak (const l) . C.fanAny f-  where-    l = "fanout any"----- | At least the given number of child items must be 'True'.-fanAtLeast :: Int -> (a -> [b]) -> C.Pred b -> C.Pred a-fanAtLeast i f = speakShort . rename l . speak (const l)-  . C.fanAtLeast i f-  where-    l = "fanout - at least " <> X.pack (show i) <>-      " fanned-out subject(s) must be True"-
prednote.cabal view
@@ -3,15 +3,15 @@ -- http://www.github.com/massysett/cartel -- -- Script name used to generate: genCabal.hs--- Generated on: 2015-01-01 23:35:08.896332 EST+-- Generated on: 2015-01-11 23:24:28.641108 EST -- Cartel library version: 0.10.0.2 name: prednote-version: 0.26.0.4+version: 0.28.0.0 cabal-version: >= 1.14 build-type: Simple license: BSD3 license-file: LICENSE-copyright: Copyright 2013-2014 Omari Norman+copyright: Copyright 2013-2015 Omari Norman author: Omari Norman maintainer: omari@smileystation.com stability: Experimental@@ -27,19 +27,23 @@   prednote also provides modules to test several subjects against a   given predicate, and to parse infix or RPN expressions into a tree of   predicates.-  .-  tests are packaged separately in the prednote-tests package. category: Data 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+ Library   exposed-modules:       Prednote@@ -48,17 +52,80 @@     , Prednote.Expressions     , Prednote.Expressions.Infix     , Prednote.Expressions.RPN-    , Prednote.Format-    , Prednote.Prebuilt   build-depends:       base ((> 4.5.0.0 || == 4.5.0.0) && < 5)-    , contravariant ((> 0.2.0.1 || == 0.2.0.1) && < 1.3)     , 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)   hs-source-dirs:       lib   ghc-options:       -Wall   default-language: Haskell2010++Executable prednote-visual-tests+  main-is: prednote-visual-tests.hs+  if flag(visual-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)+    buildable: True+  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
+ tests/Decrees.hs view
@@ -0,0 +1,28 @@+-- | This module generated by the Quickpull package.+-- Quickpull is available at:+-- <http://www.github.com/massysett/quickpull>++module Decrees where++import Quickpull+import qualified Prednote.Core.Properties++decrees :: [Decree]+decrees =++  [ Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 14, qName = "prop_predicateIsLazyInArguments"} ) ( Single Prednote.Core.Properties.prop_predicateIsLazyInArguments )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 17, qName = "prop_predicateIsSameAsOriginal"} ) ( Single Prednote.Core.Properties.prop_predicateIsSameAsOriginal )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 20, qName = "prop_andIsLazyInSecondArgument"} ) ( Single Prednote.Core.Properties.prop_andIsLazyInSecondArgument )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 23, qName = "prop_orIsLazyInSecondArgument"} ) ( Single Prednote.Core.Properties.prop_orIsLazyInSecondArgument )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 26, qName = "prop_andIsLikePreludeAnd"} ) ( Single Prednote.Core.Properties.prop_andIsLikePreludeAnd )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 32, qName = "prop_orIsLikePreludeOr"} ) ( Single Prednote.Core.Properties.prop_orIsLikePreludeOr )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 38, qName = "prop_notIsLikePreludeNot"} ) ( Single Prednote.Core.Properties.prop_notIsLikePreludeNot )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 43, qName = "prop_switchIsLazyInFirstArgument"} ) ( Single Prednote.Core.Properties.prop_switchIsLazyInFirstArgument )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 48, qName = "prop_switchIsLazyInSecondArgument"} ) ( Single Prednote.Core.Properties.prop_switchIsLazyInSecondArgument )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 53, qName = "prop_switch"} ) ( Single Prednote.Core.Properties.prop_switch )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 63, qName = "prop_true"} ) ( Single Prednote.Core.Properties.prop_true )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 65, qName = "prop_false"} ) ( Single Prednote.Core.Properties.prop_false )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 67, qName = "prop_same"} ) ( Single Prednote.Core.Properties.prop_same )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 69, qName = "prop_any"} ) ( Single Prednote.Core.Properties.prop_any )+  , Decree ( Meta {modDesc = ModDesc {modPath = "tests/Prednote/Core/Properties.hs", modName = ["Prednote","Core","Properties"]}, linenum = 75, qName = "prop_all"} ) ( Single Prednote.Core.Properties.prop_all )+  ]
+ tests/Instances.hs view
@@ -0,0 +1,18 @@+module Instances where++import Control.Applicative+import Test.QuickCheck+import Rainbow.Types+import qualified Data.Text as X++newtype ChunkA = ChunkA Chunk+  deriving (Eq, Ord, Show)++newtype TextA = TextA X.Text+  deriving (Eq, Ord, Show)++instance Arbitrary TextA where+  arbitrary = (TextA . X.pack) <$> listOf arbitrary++instance Arbitrary Chunk where+  arbitrary = undefined
+ tests/Prednote/Core/Instances.hs view
@@ -0,0 +1,95 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Prednote.Core.Instances where++import Rainbow.Types.Instances ()+import Test.QuickCheck hiding (Result)+import Control.Monad+import Prednote.Core++instance CoArbitrary a => Arbitrary (Pred a) where+  arbitrary = fmap Pred arbitrary++instance Arbitrary a => CoArbitrary (Pred a) where+  coarbitrary (Pred f) = coarbitrary f++instance Arbitrary Condition where+  arbitrary = fmap Condition arbitrary++instance CoArbitrary Condition where+  coarbitrary (Condition c) = coarbitrary c++instance Arbitrary Value where+  arbitrary = fmap Value arbitrary++instance CoArbitrary Value where+  coarbitrary (Value x) = coarbitrary x++instance Arbitrary Label where+  arbitrary = fmap Label arbitrary++instance CoArbitrary Label where+  coarbitrary (Label x) = coarbitrary x++instance Arbitrary a => Arbitrary (Labeled a) where+  arbitrary = liftM2 Labeled arbitrary arbitrary++instance CoArbitrary a => CoArbitrary (Labeled a) where+  coarbitrary (Labeled a b) = coarbitrary a . coarbitrary b++instance Arbitrary Passed where+  arbitrary = sized f+    where+      f s | s < 10 = liftM2 PTerminal arbitrary arbitrary+          | otherwise = oneof+              [ liftM2 PTerminal arbitrary arbitrary+              , liftM2 PAnd nestPass nestPass+              , fmap POr+                (oneof [ fmap Left nestPass,+                         fmap Right (liftM2 (,) nestFail nestPass)+                       ])+              , fmap PNot nestFail+              ]+        where+          nestPass = resize (s `div` 4) arbitrary+          nestFail = resize (s `div` 4) arbitrary  +      +instance Arbitrary Failed where+  arbitrary = sized f+    where+      f s | s < 10 = liftM2 FTerminal arbitrary arbitrary+          | otherwise = oneof+              [ liftM2 FTerminal arbitrary arbitrary+              , fmap FAnd+                (oneof [ fmap Left nestFail+                       , fmap Right (liftM2 (,) nestPass nestFail)+                       ])+              , liftM2 FOr nestFail nestFail+              , fmap FNot nestPass+              ]+        where+          nestPass = resize (s `div` 4) arbitrary+          nestFail = resize (s `div` 4) arbitrary++varInt :: Int -> Gen a -> Gen a+varInt = variant++instance CoArbitrary Passed where+  coarbitrary pass = case pass of+    PTerminal v c -> varInt 0 . coarbitrary v . coarbitrary c+    PAnd y1 y2 -> varInt 1 . coarbitrary y1 . coarbitrary y2+    POr e -> varInt 2 . coarbitrary e+    PNot n -> varInt 3 . coarbitrary n++instance CoArbitrary Failed where+  coarbitrary fll = case fll of+    FTerminal v c -> varInt 0 . coarbitrary v . coarbitrary c+    FAnd e -> varInt 1 . coarbitrary e+    FOr x y -> varInt 2 . coarbitrary x . coarbitrary y+    FNot x -> varInt 3 . coarbitrary x++instance Arbitrary Result where+  arbitrary = fmap Result arbitrary++instance CoArbitrary Result where+  coarbitrary (Result x) = coarbitrary x+
+ tests/Prednote/Core/Properties.hs view
@@ -0,0 +1,80 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module Prednote.Core.Properties where++import Prednote.Core.Instances ()+import Prednote.Core+import Test.QuickCheck.Function+import Prelude hiding (not, any, all)+import qualified Prelude++testInt :: Pred Int -> Int -> Bool+testInt = test++prop_predicateIsLazyInArguments (Fun _ f) i+  = testInt (predicate undefined f) i || True++prop_predicateIsSameAsOriginal (Fun _ f) i+  = testInt (predicate undefined f) i == f i++prop_andIsLazyInSecondArgument i+  = testInt (false &&& undefined) i || True++prop_orIsLazyInSecondArgument i+  = testInt (true ||| undefined) i || True++prop_andIsLikePreludeAnd (Fun _ f1) (Fun _ f2) i+  = testInt (p1 &&& p2) i == (f1 i && f2 i)+  where+    p1 = predicate undefined f1+    p2 = predicate undefined f2++prop_orIsLikePreludeOr (Fun _ f1) (Fun _ f2) i+  = testInt (p1 ||| p2) i == (f1 i || f2 i)+  where+    p1 = predicate undefined f1+    p2 = predicate undefined f2++prop_notIsLikePreludeNot (Fun _ f1) i+  = testInt (not p1) i == Prelude.not (f1 i)+  where+    p1 = predicate undefined f1++prop_switchIsLazyInFirstArgument pb i+  = test (switch undefined pb) (Right i) || True+  where+    _types = pb :: Pred Int+    +prop_switchIsLazyInSecondArgument pa i+  = test (switch pa undefined) (Left i) || True+  where+    _types = pa :: Pred Int++prop_switch (Fun _ fa) (Fun _ fb) ei+  = test (switch pa pb) ei == expected+  where+    _types = ei :: Either Int Char+    expected = case ei of+      Left i -> fa i+      Right c -> fb c+    pa = predicate undefined fa+    pb = predicate undefined fb+    +prop_true = testInt true++prop_false = Prelude.not . testInt false++prop_same b = test same b == b++prop_any (Fun _ f) ls+  = test (any pa) ls == Prelude.any f ls+  where+    pa = predicate undefined f+    _types = ls :: [Int]+    +prop_all (Fun _ f) ls+  = test (all pa) ls == Prelude.all f ls+  where+    pa = predicate undefined f+    _types = ls :: [Int]+
+ tests/Rainbow/Types/Instances.hs view
@@ -0,0 +1,80 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Rainbow.Types.Instances where++import Control.Monad+import Control.Applicative+import Data.Monoid+import Test.QuickCheck+import Rainbow.Types+import qualified Data.Text as X++instance Arbitrary a => Arbitrary (Last a) where+  arbitrary = Last <$> arbitrary++instance CoArbitrary a => CoArbitrary (Last a) where+  coarbitrary (Last m) = case m of+    Nothing -> varInt 0+    Just x -> varInt 1 . coarbitrary x++instance Arbitrary Enum8 where+  arbitrary = elements [ E0, E1, E2, E3, E4, E5, E6, E7 ]++varInt :: Int -> Gen b -> Gen b+varInt = variant++instance CoArbitrary Enum8 where+  coarbitrary a = case a of+    { E0 -> varInt 0; E1 -> varInt 1; E2 -> varInt 2; E3 -> varInt 3;+      E4 -> varInt 4; E5 -> varInt 5; E6 -> varInt 6; E7 -> varInt 7 }++instance Arbitrary Color8 where+  arbitrary = Color8 <$> arbitrary++instance CoArbitrary Color8 where+  coarbitrary (Color8 a) = coarbitrary a++instance Arbitrary Color256 where+  arbitrary = Color256 <$> arbitrary++instance CoArbitrary Color256 where+  coarbitrary (Color256 a) = coarbitrary a++instance Arbitrary StyleCommon where+  arbitrary = liftM4 StyleCommon arbitrary arbitrary arbitrary+    arbitrary++instance CoArbitrary StyleCommon where+  coarbitrary (StyleCommon a b c d) =+    coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d++instance Arbitrary Style8 where+  arbitrary = liftM3 Style8 arbitrary arbitrary arbitrary++instance CoArbitrary Style8 where+  coarbitrary (Style8 a b c) =+    coarbitrary a . coarbitrary b . coarbitrary c++instance Arbitrary Style256 where+  arbitrary = liftM3 Style256 arbitrary arbitrary arbitrary++instance CoArbitrary Style256 where+  coarbitrary (Style256 a b c) =+    coarbitrary a . coarbitrary b . coarbitrary c++instance Arbitrary TextSpec where+  arbitrary = liftM2 TextSpec arbitrary arbitrary++instance CoArbitrary TextSpec where+  coarbitrary (TextSpec x y) = coarbitrary x . coarbitrary y++instance Arbitrary X.Text where+  arbitrary = X.pack <$> listOf arbitrary++instance CoArbitrary X.Text where+  coarbitrary = coarbitrary . X.unpack++instance Arbitrary Chunk where+  arbitrary = liftM2 Chunk arbitrary arbitrary++instance CoArbitrary Chunk where+  coarbitrary (Chunk x y) = coarbitrary x . coarbitrary y
+ tests/prednote-tests.hs view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Main where++import Quickpull+import Decrees++main :: IO ()+main = defaultMain decrees
+ tests/prednote-visual-tests.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+module Main where++import Prednote+import Prelude hiding (any, all, maybe)++main :: IO ()+main = do+  verboseTestStdout (all $ lessEq (5 :: Int)) [0..10]+  verboseTestStdout (any $ equal (4 :: Int)) [0..3]+  verboseTestStdout (any $ equal (10 :: Int)) []+  verboseTestStdout (all $ maybe true (lessEq (5 :: Int)))+    [Nothing, Just 1, Just 2, Nothing, Just 3, Just 4, Just 5]+  return ()