prednote 0.20.0.0 → 0.22.0.0
raw patch · 10 files changed
+741/−714 lines, 10 files
Files
- current-versions.txt +3/−3
- lib/Data/Prednote.hs +9/−0
- lib/Data/Prednote/Expressions.hs +5/−5
- lib/Data/Prednote/Expressions/RPN.hs +11/−11
- lib/Data/Prednote/Pdct.hs +0/−644
- lib/Data/Prednote/Predbox.hs +661/−0
- lib/Data/Prednote/Test.hs +17/−17
- minimum-versions.txt +3/−3
- prednote-test.hs +29/−29
- prednote.cabal +3/−2
current-versions.txt view
@@ -1,7 +1,7 @@ This package was tested to work with these dependency versions and compiler version. These are the default versions fetched by cabal install.-Tested as of: 2014-03-01 19:44:29.719081 UTC+Tested as of: 2014-03-02 01:48:34.516774 UTC Path to compiler: ghc-7.6.3 Compiler description: 7.6.3 @@ -32,10 +32,10 @@ time-1.4.0.1 unix-2.6.0.1 -/home/massysett/prednote/sunlight-17262/db:+/home/massysett/prednote/sunlight-20181/db: QuickCheck-2.6 contravariant-0.4.4- prednote-0.20.0.0+ prednote-0.22.0.0 rainbow-0.6.0.4 random-1.0.1.1 split-0.2.2
+ lib/Data/Prednote.hs view
@@ -0,0 +1,9 @@+module Data.Prednote+ ( module Data.Prednote.Predbox+ , module Data.Prednote.Expressions+ , module Data.Prednote.Test+ ) where++import Data.Prednote.Predbox+import Data.Prednote.Expressions+import Data.Prednote.Test
lib/Data/Prednote/Expressions.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} --- | Handles parsing of both infix and RPN Pdct expressions.+-- | Handles parsing of both infix and RPN Predbox expressions. module Data.Prednote.Expressions ( ExprDesc(..) , Error@@ -19,7 +19,7 @@ import qualified Data.Text as X import qualified Data.Prednote.Expressions.Infix as I import qualified Data.Prednote.Expressions.RPN as R-import qualified Data.Prednote.Pdct as P+import qualified Data.Prednote.Predbox as P -- | A single type for both RPN tokens and infix tokens. newtype Token a = Token { unToken :: I.InfixToken a }@@ -29,8 +29,8 @@ type Error = X.Text --- | Creates Operands from Pdct.-operand :: P.Pdct a -> Token a+-- | Creates Operands from Predbox.+operand :: P.Predbox a -> Token a operand p = Token (I.TokRPN (R.TokOperand p)) -- | The And operator@@ -75,7 +75,7 @@ parseExpression :: ExprDesc -> [Token a]- -> Either Error (P.Pdct a)+ -> Either Error (P.Predbox a) parseExpression e toks = do rpnToks <- case e of Infix -> maybe (Left "unbalanced parentheses\n") Right
lib/Data/Prednote/Expressions/RPN.hs view
@@ -8,8 +8,8 @@ import Data.Functor.Contravariant import qualified Data.Foldable as Fdbl-import qualified Data.Prednote.Pdct as P-import Data.Prednote.Pdct ((&&&), (|||))+import qualified Data.Prednote.Predbox as P+import Data.Prednote.Predbox ((&&&), (|||)) import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as X@@ -18,7 +18,7 @@ type Error = Text data RPNToken a- = TokOperand (P.Pdct a)+ = TokOperand (P.Predbox a) | TokOperator Operator instance Contravariant RPNToken where@@ -32,13 +32,13 @@ | OpNot deriving Show -pushOperand :: P.Pdct a -> [P.Pdct a] -> [P.Pdct a]+pushOperand :: P.Predbox a -> [P.Predbox a] -> [P.Predbox a] pushOperand p ts = p : ts pushOperator :: Operator- -> [P.Pdct a]- -> Either Error [P.Pdct a]+ -> [P.Predbox a]+ -> Either Error [P.Predbox a] pushOperator o ts = case o of OpAnd -> case ts of x:y:zs -> return $ (y &&& x) : zs@@ -54,22 +54,22 @@ <> "\" operator\n" pushToken- :: [P.Pdct a]+ :: [P.Predbox a] -> RPNToken a- -> Either Error [P.Pdct a]+ -> Either Error [P.Predbox a] pushToken ts t = case t of TokOperand p -> return $ pushOperand p ts TokOperator o -> pushOperator o ts --- | Parses an RPN expression and returns the resulting Pdct. Fails if+-- | Parses an RPN expression and returns the resulting Predbox. 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. parseRPN :: Fdbl.Foldable f => f (RPNToken a)- -> Either Error (P.Pdct a)+ -> Either Error (P.Predbox a) parseRPN ts = do trees <- Fdbl.foldlM pushToken [] ts case trees of@@ -79,6 +79,6 @@ $ "bad expression: multiple operands left on the stack:\n" <> ( X.concat . map C.text- . concatMap (P.showPdct 4 0)+ . concatMap (P.showPredbox 4 0) $ xs )
− lib/Data/Prednote/Pdct.hs
@@ -1,644 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | Trees of predicates.------ Exports names which conflict with Prelude names, so you probably--- want to import this module qualified.--module Data.Prednote.Pdct-- ( -- * The Pdct tree- Label- , Hide- , Pdct(..)- , Node(..)-- -- * Creating Pdct.- -- | All functions create Pdct that are shown by default.- , operand- , and- , or- , not- , (&&&)- , (|||)- , always- , never-- -- * Controlling whether Pdct are shown in the results- , hide- , show- , hideTrue- , hideFalse-- -- * Renaming Pdct- , rename-- -- * Result- , Result(..)- , RNode(..)-- -- * Showing and evaluating Pdct- , evaluate- , evaluateNode- , IndentAmt- , Level- , ShowAll- , showResult- , showTopResult- , showPdct- , filter- , verboseFilter-- -- * Helpers for building common Pdct- -- ** Non-overloaded- , compareBy- , compareByMaybe- , greaterBy- , lessBy- , equalBy- , greaterEqBy- , lessEqBy- , notEqBy-- -- ** Overloaded- , compare- , greater- , less- , equal- , greaterEq- , lessEq- , notEq- , parseComparer-- ) where----- # Imports--import Data.Functor.Contravariant-import Data.Text (Text)-import qualified Data.Text as X-import Data.Monoid ((<>), mconcat, mempty)-import Data.String (fromString)-import qualified System.Console.Rainbow as R-import Prelude hiding (not, and, or, compare, filter, show)-import qualified Prelude---- # Pdct type--type Label = Text---- | Determines whether a result is shown by default.-type Hide = Bool---- | A predicate. Each Pdct contains a tree of Node.-data Pdct a = Pdct- { pLabel :: Label- -- ^ Label used when showing the results-- , pHide :: (Bool -> Hide)- -- ^ As results are computed, this function is applied to the- -- result. If this function returns False, then this Pdct will not- -- be shown by default in the results.-- , pNode :: Node a-- }--data Node a- = And [Pdct a]- -- ^ Conjunction. If any Pdct in the list is False, the result is- -- False. If the list is empty, the result is True.-- | Or [Pdct a]- -- ^ Disjunction. If at least one Pdct in the list is True, the- -- result it True. If the list is empty, the result is False.-- | Not (Pdct a)- -- ^ Negation-- | Operand (a -> Bool)- -- ^ Most basic building block.---- | Renames the top level of the Pdct. The function you pass will be--- applied to the old name.-rename :: (Text -> Text) -> Pdct a -> Pdct a-rename f p = p { pLabel = f (pLabel p) }---- | Always True-always :: Pdct a-always = Pdct "always True" (const False) (Operand (const True))---- | Always False-never :: Pdct a-never = Pdct "always False" (const False) (Operand (const False))---- | Creates and labels operands.-operand :: Label -> (a -> Bool) -> Pdct a-operand l = Pdct l (const False) . Operand---- | Creates And Pdct using a generic name-and :: [Pdct a] -> Pdct a-and = Pdct "and" (const False) . And---- | Creates Or Pdct using a generic name-or :: [Pdct a] -> Pdct a-or = Pdct "or" (const False) . Or---- | Creates Not Pdct using a generic name-not :: Pdct a -> Pdct a-not = Pdct "not" (const False) . Not---- | Changes a Pdct so it is always hidden by default.-hide :: Pdct a -> Pdct a-hide p = p { pHide = const True }---- | Changes a Pdct so it is always shown by default.-show :: Pdct a -> Pdct a-show p = p { pHide = const False }---- | Changes a Pdct so that it is hidden if its result is True.-hideTrue :: Pdct a -> Pdct a-hideTrue p = p { pHide = id }---- | Changes a Pdct so that it is hidden if its result is False.-hideFalse :: Pdct a -> Pdct a-hideFalse p = p { pHide = Prelude.not }---- | Forms a Pdct using 'and'; assigns a generic label.-(&&&) :: Pdct a -> Pdct a -> Pdct a-(&&&) x y = Pdct "and" (const False) (And [x, y])-infixr 3 &&&---- | Forms a Pdct using 'or'; assigns a generic label.-(|||) :: Pdct a -> Pdct a -> Pdct a-(|||) x y = Pdct "or" (const False) (Or [x, y])-infixr 2 |||--instance Contravariant Pdct where- contramap f (Pdct l d n) = Pdct l d $ contramap f n--instance Contravariant Node where- contramap f n = case n of- And ls -> And $ map (contramap f) ls- Or ls -> Or $ map (contramap f) ls- Not o -> Not $ contramap f o- Operand g -> Operand $ \b -> g (f b)---- # Result---- | The result from evaluating a Pdct.-data Result = Result- { rLabel :: Label- -- ^ The label from the original Pdct-- , rBool :: Bool- -- ^ The boolean result from evaluating the node. If the node is an- -- operand, this is the result of applying the operand function to- -- the subject. Otherwise, this is the result of application of the- -- appropriate boolean operation to the child nodes.-- , rHide :: Hide- -- ^ Is this result hidden in the result by default? Hiding only- -- affects presentation; it does not affect how this Pdct affects- -- any parent Pdct.- , rNode :: RNode- } deriving (Eq, Show)--data RNode- = RAnd [Result]- | ROr [Result]- | RNot Result- | ROperand Bool- deriving (Eq, Show)---- | Applies a Pdct to a particular value, known as the subject.-evaluate :: a -> Pdct a -> Result-evaluate a (Pdct l d n) = Result l r d' rn- where- rn = evaluateNode a n- r = case rn of- RAnd ls -> all rBool ls- ROr ls -> any rBool ls- RNot x -> Prelude.not . rBool $ x- ROperand b -> b- d' = d r--evaluateNode :: a -> Node a -> RNode-evaluateNode a n = case n of- And ls -> RAnd (map (evaluate a) ls)- Or ls -> ROr (map (evaluate a) ls)- Not l -> RNot (evaluate a l)- Operand f -> ROperand (f a)---- # Types and functions for showing---- | The number of spaces to use for each level of indentation.-type IndentAmt = Int---- | How many levels of indentation to use. Typically you will start--- this at zero. It is incremented by one for each level as functions--- descend through the tree.-type Level = Int---- | Indents text, and adds a newline to the end.-indent :: IndentAmt -> Level -> [R.Chunk] -> [R.Chunk]-indent amt lvl cs = idt : (cs ++ [nl])- where- idt = fromString (replicate (lvl * amt) ' ')- nl = fromString "\n"---- # Showing Pdct---- | Creates a plain Chunk from a Text.-plain :: Text -> R.Chunk-plain = R.Chunk mempty---- | Shows a Pdct tree without evaluating it.-showPdct :: IndentAmt -> Level -> Pdct a -> [R.Chunk]-showPdct amt lvl (Pdct l _ pd) = case pd of- And ls -> indent amt lvl [plain ("and - " <> l)]- <> mconcat (map (showPdct amt (lvl + 1)) ls)- Or ls -> indent amt lvl [plain ("or - " <> l)]- <> mconcat (map (showPdct amt (lvl + 1)) ls)- Not t -> indent amt lvl [plain ("not - " <> l)]- <> showPdct amt (lvl + 1) t- Operand _ -> indent amt lvl [plain ("operand - " <> l)]--instance Show (Pdct a) where- show = X.unpack- . X.concat- . map R.text- . showPdct 2 0---filter :: Pdct a -> [a] -> [a]-filter pd as- = map fst- . Prelude.filter (rBool . snd)- . zip as- . map (flip evaluate pd)- $ as----- # Showing Result--labelBool :: Text -> Bool -> [R.Chunk]-labelBool t b = [open, trueFalse, close, blank, txt]- where- trueFalse = - if b then "TRUE" <> R.f_green else "FALSE" <> R.f_red- open = "["- close = "]"- blank = plain (X.replicate blankLen " ")- blankLen = X.length "discard"- - X.length (R.text trueFalse) + 1- txt = plain t--type ShowAll = Bool---- | Shows a Result in a pretty way with colors and indentation.-showResult- :: IndentAmt- -- ^ Indent each level by this many spaces-- -> ShowAll- -- ^ If True, shows all Pdct, even ones where 'rHide' is- -- True. Otherwise, respects 'rHide' and does not show hidden Pdct.-- -> Level- -- ^ How deep in the tree we are; this increments by one for each- -- level of descent.-- -> Result- -- ^ The result to show-- -> [R.Chunk]-showResult amt sa lvl (Result lbl rslt hd nd)- | hd && Prelude.not sa = []- | otherwise = firstLine ++ restLines- where- firstLine = indent amt lvl $ labelBool lbl rslt- restLines = case nd of- RAnd ls -> f False ls- ROr ls -> f True ls- RNot r -> showResult amt sa (lvl + 1) r- ROperand _ -> []- f stopOn ls = concatMap sr ls' ++ end- where- ls' = takeThrough ((== stopOn) . rBool) ls- sr = showResult amt sa (lvl + 1)- end = if ls' `shorter` ls- then indent amt (lvl + 1) ["(short circuit)"]- else []---- | @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---- | For instance,--- > takeThrough odd [2,4,6,7,8] == [2,4,6,7]-takeThrough :: (a -> Bool) -> [a] -> [a]-takeThrough _ [] = []-takeThrough f (x:xs) = x : if f x then [] else takeThrough f xs---- | Shows the top of a Result tree and all the child Results. Adds a--- short label at the top of the tree.-showTopResult- :: X.Text- -- ^ Label to add to the top of the tree.- -> IndentAmt- -- ^ Indent each level by this many spaces- -> Level- -- ^ Indent the top by this many levels- -> ShowAll- -- ^ If True, shows all Pdct, even ones where 'rHide' is- -- True. Otherwise, respects 'rHide' and does not show hidden Pdct.-- -> Result- -- ^ The result to show- -> [R.Chunk]-showTopResult txt i lvl sd r = showResult i sd lvl r'- where- r' = r { rLabel = rLabel r <> " - " <> txt }----- | Filters a list. Also returns chunks describing the process.-verboseFilter- :: (a -> X.Text)- -- ^ How to describe each subject-- -> IndentAmt- -- ^ Indent each level by this many spaces-- -> ShowAll- -- ^ If True, shows all Pdct, even ones where 'rHide' is- -- True. Otherwise, respects 'rHide' and does not show hidden Pdct.-- -> Pdct a- -- ^ Used to perform the filtering-- -> [a]- -> ([R.Chunk], [a])--verboseFilter desc amt sa pd as = (chks, as')- where- rs = map (flip evaluate pd) as- subjAndRslts = zip as rs- mkChks (subj, rslt) = showTopResult (desc subj) amt 0 sa rslt- chks = concatMap mkChks subjAndRslts- as' = map fst . Prelude.filter (rBool . snd) $ subjAndRslts---- # Comparisons---- | Build a Pdct that compares items.-compareBy- :: Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> Text- -- ^ Description of the type of thing that is being matched-- -> (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.-- -> Ordering- -- ^ When subjects are compared, this ordering must be the result in- -- order for the Pdct to be True; otherwise it is False. The subject- -- will be on the left hand side.-- -> Pdct a--compareBy itemDesc typeDesc cmp ord = Pdct l (const False) (Operand f)- where- l = typeDesc <> " is " <> cmpDesc <> " " <> itemDesc- cmpDesc = case ord of- LT -> "less than"- GT -> "greater than"- EQ -> "equal to"- f subj = cmp subj == ord---- | Overloaded version of 'compareBy'.-compare- :: (Show a, Ord a)- => Text- -- ^ Description of the type of thing being matched-- -> a- -- ^ The right hand side of the comparison.-- -> Ordering- -- ^ When subjects are compared, this ordering must be the result in- -- order for the Pdct to be True; otherwise it is False. The subject- -- will be on the left hand side.-- -> Pdct a-compare typeDesc a ord = compareBy itemDesc typeDesc cmp ord- where- itemDesc = X.pack . Prelude.show $ a- cmp item = Prelude.compare item a---- | Builds a Pdct for items that might fail to return a comparison.-compareByMaybe- :: Text- -- ^ How to show the item being compared-- -> Text- -- ^ Description of type of thing being matched-- -> (a -> Maybe Ordering)- -- ^ How to compare against right hand side. If Nothing, a Pdct that- -- always returns False is returned.-- -> Ordering- -- ^ Ordering that must result for the Pdct to be True-- -> Pdct a--compareByMaybe itemDesc typeDesc cmp ord =- Pdct l (const False) (Operand f)- where- l = typeDesc <> " is " <> cmpDesc <> " " <> itemDesc- cmpDesc = case ord of- LT -> "less than"- GT -> "greater than"- EQ -> "equal to"- f subj = case cmp subj of- Nothing -> False- Just ord' -> ord == ord'--greater- :: (Show a, Ord a)- => Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> a- -- ^ The right hand side of the comparison.-- -> Pdct a-greater d a = compare d a GT--less- :: (Show a, Ord a)- => Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> a- -- ^ The right hand side of the comparison.-- -> Pdct a-less d a = compare d a LT--equal- :: (Show a, Ord a)- => Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> a- -- ^ The right hand side of the comparison.-- -> Pdct a-equal d a = compare d a EQ--greaterEq- :: (Show a, Ord a)- => Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> a- -- ^ The right hand side of the comparison.-- -> Pdct a-greaterEq d a = greater d a ||| equal d a--lessEq- :: (Show a, Ord a)- => Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> a- -- ^ The right hand side of the comparison.-- -> Pdct a-lessEq d a = less d a ||| equal d a--notEq- :: (Show a, Ord a)- => Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> a- -- ^ The right hand side of the comparison.-- -> Pdct a-notEq d a = not $ equal d a--greaterBy- :: Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> Text- -- ^ Description of the type of thing that is being matched-- -> (a -> Ordering)- -- ^ How to compare two items-- -> Pdct a-greaterBy iD tD cmp = compareBy iD tD cmp GT--lessBy- :: Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> Text- -- ^ Description of the type of thing that is being matched-- -> (a -> Ordering)- -- ^ How to compare two items-- -> Pdct a-lessBy iD tD cmp = compareBy iD tD cmp LT--equalBy- :: Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> Text- -- ^ Description of the type of thing that is being matched-- -> (a -> Ordering)- -- ^ How to compare two items-- -> Pdct a-equalBy iD tD cmp = compareBy iD tD cmp EQ--greaterEqBy- :: Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> Text- -- ^ Description of the type of thing that is being matched-- -> (a -> Ordering)- -- ^ How to compare two items-- -> Pdct a-greaterEqBy iD tD cmp =- greaterBy iD tD cmp ||| equalBy iD tD cmp--lessEqBy- :: Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> Text- -- ^ Description of the type of thing that is being matched-- -> (a -> Ordering)- -- ^ How to compare two items-- -> Pdct a-lessEqBy iD tD cmp =- lessBy iD tD cmp ||| equalBy iD tD cmp--notEqBy- :: Text- -- ^ How to show the item being compared; used to describe the Pdct-- -> Text- -- ^ Description of the type of thing that is being matched-- -> (a -> Ordering)- -- ^ How to compare two items-- -> Pdct a-notEqBy iD tD cmp =- not $ equalBy iD tD cmp---- | Parses a string to find the correct comparer; returns the correct--- function to build a Pdct.--parseComparer- :: Text- -- ^ The string with the comparer to be parsed- -> (Ordering -> Pdct a)- -- ^ A function that, when given an ordering, returns a Pdct- -> Maybe (Pdct a)- -- ^ If an invalid comparer string is given, Nothing; otherwise, the- -- Pdct.-parseComparer t f- | t == ">" = Just (f GT)- | t == "<" = Just (f LT)- | t == "=" = Just (f EQ)- | t == "==" = Just (f EQ)- | t == ">=" = Just (f GT ||| f EQ)- | t == "<=" = Just (f LT ||| f EQ)- | t == "/=" = Just (not $ f EQ)- | t == "!=" = Just (not $ f EQ)- | otherwise = Nothing-
+ lib/Data/Prednote/Predbox.hs view
@@ -0,0 +1,661 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Trees of predicates.+--+-- Exports names which conflict with Prelude names, so you probably+-- want to import this module qualified.++module Data.Prednote.Predbox++ ( -- * The Predbox tree+ Label+ , Hide+ , Predbox(..)+ , Node(..)++ -- * Creating Predbox.+ -- | All functions create Predbox that are shown by default.+ , predicate+ , and+ , or+ , not+ , (&&&)+ , (|||)+ , always+ , never++ -- * Controlling whether Predbox are shown in the results+ , hide+ , show+ , hideTrue+ , hideFalse++ -- * Renaming Predbox+ , rename++ -- * Result+ , Result(..)+ , RNode(..)++ -- * Showing and evaluating Predbox+ , evaluate+ , evaluateNode+ , IndentAmt+ , Level+ , ShowAll+ , showResult+ , showTopResult+ , showPredbox+ , filter+ , verboseFilter++ -- * Helpers for building common Predbox+ -- ** Non-overloaded++ -- | Each of these functions builds a Predbox that compares two+ -- items. The predicate in the Predbox is applied to an item that+ -- is considered to be the left hand side of the comparison. The+ -- left hand side side can change; the right hand side is baked+ -- into the Predbox.+ --+ -- For example, to build a Predbox that returns True if an item is+ -- greater than 5:+ --+ -- >>> :set -XOverloadedStrings+ -- >>> let p = compareBy "5" "integer" (`Prelude.compare` (5 :: Integer)) GT+ -- >>> rBool . evaluate p $ 6+ -- True+ -- >>> rBool . evaluate p $ 4+ -- False+ , compareBy+ , compareByMaybe+ , greaterBy+ , lessBy+ , equalBy+ , greaterEqBy+ , lessEqBy+ , notEqBy++ -- ** Overloaded+ , compare+ , greater+ , less+ , equal+ , greaterEq+ , lessEq+ , notEq+ , parseComparer++ ) where+++-- # Imports++import Data.Functor.Contravariant hiding (Predicate)+import Data.Text (Text)+import qualified Data.Text as X+import Data.Monoid ((<>), mconcat, mempty)+import Data.String (fromString)+import qualified System.Console.Rainbow as R+import Prelude hiding (not, and, or, compare, filter, show)+import qualified Prelude++-- # Predbox type++type Label = Text++-- | Determines whether a result is shown by default.+type Hide = Bool++-- | A predicate. Each Predbox contains a tree of Node.+data Predbox a = Predbox+ { pLabel :: Label+ -- ^ Label used when showing the results++ , pHide :: (Bool -> Hide)+ -- ^ As results are computed, this function is applied to the+ -- result. If this function returns False, then this Predbox will not+ -- be shown by default in the results.++ , pNode :: Node a++ }++data Node a+ = And [Predbox a]+ -- ^ Conjunction. If any Predbox in the list is False, the result is+ -- False. If the list is empty, the result is True.++ | Or [Predbox a]+ -- ^ Disjunction. If at least one Predbox in the list is True, the+ -- result it True. If the list is empty, the result is False.++ | Not (Predbox a)+ -- ^ Negation++ | Predicate (a -> Bool)+ -- ^ Most basic building block.++-- | Renames the top level of the Predbox. The function you pass will be+-- applied to the old name.+rename :: (Text -> Text) -> Predbox a -> Predbox a+rename f p = p { pLabel = f (pLabel p) }++-- | Always True+always :: Predbox a+always = Predbox "always True" (const False) (Predicate (const True))++-- | Always False+never :: Predbox a+never = Predbox "always False" (const False) (Predicate (const False))++-- | Creates and labels predicates.+predicate :: Label -> (a -> Bool) -> Predbox a+predicate l = Predbox l (const False) . Predicate++-- | Creates And Predbox using a generic name+and :: [Predbox a] -> Predbox a+and = Predbox "and" (const False) . And++-- | Creates Or Predbox using a generic name+or :: [Predbox a] -> Predbox a+or = Predbox "or" (const False) . Or++-- | Creates Not Predbox using a generic name+not :: Predbox a -> Predbox a+not = Predbox "not" (const False) . Not++-- | Changes a Predbox so it is always hidden by default.+hide :: Predbox a -> Predbox a+hide p = p { pHide = const True }++-- | Changes a Predbox so it is always shown by default.+show :: Predbox a -> Predbox a+show p = p { pHide = const False }++-- | Changes a Predbox so that it is hidden if its result is True.+hideTrue :: Predbox a -> Predbox a+hideTrue p = p { pHide = id }++-- | Changes a Predbox so that it is hidden if its result is False.+hideFalse :: Predbox a -> Predbox a+hideFalse p = p { pHide = Prelude.not }++-- | Forms a Predbox using 'and'; assigns a generic label.+(&&&) :: Predbox a -> Predbox a -> Predbox a+(&&&) x y = Predbox "and" (const False) (And [x, y])+infixr 3 &&&++-- | Forms a Predbox using 'or'; assigns a generic label.+(|||) :: Predbox a -> Predbox a -> Predbox a+(|||) x y = Predbox "or" (const False) (Or [x, y])+infixr 2 |||++instance Contravariant Predbox where+ contramap f (Predbox l d n) = Predbox l d $ contramap f n++instance Contravariant Node where+ contramap f n = case n of+ And ls -> And $ map (contramap f) ls+ Or ls -> Or $ map (contramap f) ls+ Not o -> Not $ contramap f o+ Predicate g -> Predicate $ \b -> g (f b)++-- # Result++-- | The result from evaluating a Predbox.+data Result = Result+ { rLabel :: Label+ -- ^ The label from the original Predbox++ , rBool :: Bool+ -- ^ The boolean result from evaluating the node. If the node is an+ -- predicate, this is the result of applying the predicate function to+ -- the subject. Otherwise, this is the result of application of the+ -- appropriate boolean operation to the child nodes.++ , rHide :: Hide+ -- ^ Is this result hidden in the result by default? Hiding only+ -- affects presentation; it does not affect how this Predbox affects+ -- any parent Predbox.+ , rNode :: RNode+ } deriving (Eq, Show)++data RNode+ = RAnd [Result]+ | ROr [Result]+ | RNot Result+ | RPredicate Bool+ deriving (Eq, Show)++-- | Applies a Predbox to a particular value, known as the subject.+evaluate :: Predbox a -> a -> Result+evaluate (Predbox l d n) a = Result l r d' rn+ where+ rn = evaluateNode n a+ r = case rn of+ RAnd ls -> all rBool ls+ ROr ls -> any rBool ls+ RNot x -> Prelude.not . rBool $ x+ RPredicate b -> b+ d' = d r++evaluateNode :: Node a -> a -> RNode+evaluateNode n a = case n of+ And ls -> RAnd (map (flip evaluate a) ls)+ Or ls -> ROr (map (flip evaluate a) ls)+ Not l -> RNot (flip evaluate a l)+ Predicate f -> RPredicate (f a)++-- # Types and functions for showing++-- | The number of spaces to use for each level of indentation.+type IndentAmt = Int++-- | How many levels of indentation to use. Typically you will start+-- this at zero. It is incremented by one for each level as functions+-- descend through the tree.+type Level = Int++-- | Indents text, and adds a newline to the end.+indent :: IndentAmt -> Level -> [R.Chunk] -> [R.Chunk]+indent amt lvl cs = idt : (cs ++ [nl])+ where+ idt = fromString (replicate (lvl * amt) ' ')+ nl = fromString "\n"++-- # Showing Predbox++-- | Creates a plain Chunk from a Text.+plain :: Text -> R.Chunk+plain = R.Chunk mempty++-- | Shows a Predbox tree without evaluating it.+showPredbox :: IndentAmt -> Level -> Predbox a -> [R.Chunk]+showPredbox amt lvl (Predbox l _ pd) = case pd of+ And ls -> indent amt lvl [plain ("and - " <> l)]+ <> mconcat (map (showPredbox amt (lvl + 1)) ls)+ Or ls -> indent amt lvl [plain ("or - " <> l)]+ <> mconcat (map (showPredbox amt (lvl + 1)) ls)+ Not t -> indent amt lvl [plain ("not - " <> l)]+ <> showPredbox amt (lvl + 1) t+ Predicate _ -> indent amt lvl [plain ("predicate - " <> l)]++instance Show (Predbox a) where+ show = X.unpack+ . X.concat+ . map R.text+ . showPredbox 2 0+++filter :: Predbox a -> [a] -> [a]+filter pd as+ = map fst+ . Prelude.filter (rBool . snd)+ . zip as+ . map (evaluate pd)+ $ as+++-- # Showing Result++labelBool :: Text -> Bool -> [R.Chunk]+labelBool t b = [open, trueFalse, close, blank, txt]+ where+ trueFalse = + if b then "TRUE" <> R.f_green else "FALSE" <> R.f_red+ open = "["+ close = "]"+ blank = plain (X.replicate blankLen " ")+ blankLen = X.length "discard"+ - X.length (R.text trueFalse) + 1+ txt = plain t++type ShowAll = Bool++-- | Shows a Result in a pretty way with colors and indentation.+showResult+ :: IndentAmt+ -- ^ Indent each level by this many spaces++ -> ShowAll+ -- ^ If True, shows all Predbox, even ones where 'rHide' is+ -- True. Otherwise, respects 'rHide' and does not show hidden Predbox.++ -> Level+ -- ^ How deep in the tree we are; this increments by one for each+ -- level of descent.++ -> Result+ -- ^ The result to show++ -> [R.Chunk]+showResult amt sa lvl (Result lbl rslt hd nd)+ | hd && Prelude.not sa = []+ | otherwise = firstLine ++ restLines+ where+ firstLine = indent amt lvl $ labelBool lbl rslt+ restLines = case nd of+ RAnd ls -> f False ls+ ROr ls -> f True ls+ RNot r -> showResult amt sa (lvl + 1) r+ RPredicate _ -> []+ f stopOn ls = concatMap sr ls' ++ end+ where+ ls' = takeThrough ((== stopOn) . rBool) ls+ sr = showResult amt sa (lvl + 1)+ end = if ls' `shorter` ls+ then indent amt (lvl + 1) ["(short circuit)"]+ else []++-- | @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++-- | For instance,+--+-- > takeThrough odd [2,4,6,7,8] == [2,4,6,7]+takeThrough :: (a -> Bool) -> [a] -> [a]+takeThrough _ [] = []+takeThrough f (x:xs) = x : if f x then [] else takeThrough f xs++-- | Shows the top of a Result tree and all the child Results. Adds a+-- short label at the top of the tree.+showTopResult+ :: X.Text+ -- ^ Label to add to the top of the tree.+ -> IndentAmt+ -- ^ Indent each level by this many spaces+ -> Level+ -- ^ Indent the top by this many levels+ -> ShowAll+ -- ^ If True, shows all Predbox, even ones where 'rHide' is+ -- True. Otherwise, respects 'rHide' and does not show hidden Predbox.++ -> Result+ -- ^ The result to show+ -> [R.Chunk]+showTopResult txt i lvl sd r = showResult i sd lvl r'+ where+ r' = r { rLabel = rLabel r <> " - " <> txt }+++-- | Filters a list. Also returns chunks describing the process.+verboseFilter+ :: (a -> X.Text)+ -- ^ How to describe each subject++ -> IndentAmt+ -- ^ Indent each level by this many spaces++ -> ShowAll+ -- ^ If True, shows all Predbox, even ones where 'rHide' is+ -- True. Otherwise, respects 'rHide' and does not show hidden Predbox.++ -> Predbox a+ -- ^ Used to perform the filtering++ -> [a]+ -> ([R.Chunk], [a])++verboseFilter desc amt sa pd as = (chks, as')+ where+ rs = map (evaluate pd) as+ subjAndRslts = zip as rs+ mkChks (subj, rslt) = showTopResult (desc subj) amt 0 sa rslt+ chks = concatMap mkChks subjAndRslts+ as' = map fst . Prelude.filter (rBool . snd) $ subjAndRslts++-- # Comparisons++-- | Build a Predbox that compares items.+compareBy+ :: Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> Text+ -- ^ Description of the type of thing that is being matched++ -> (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.++ -> 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.++ -> Predbox a++compareBy itemDesc typeDesc cmp ord = Predbox l (const False) (Predicate f)+ where+ l = typeDesc <> " is " <> cmpDesc <> " " <> itemDesc+ cmpDesc = case ord of+ LT -> "less than"+ GT -> "greater than"+ EQ -> "equal to"+ f subj = cmp subj == ord++-- | Overloaded version of 'compareBy'.+compare+ :: (Show a, Ord a)+ => Text+ -- ^ Description of the type of thing being matched++ -> a+ -- ^ The right hand side of the comparison.++ -> 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.++ -> Predbox a+compare typeDesc a ord = compareBy itemDesc typeDesc cmp ord+ where+ itemDesc = X.pack . Prelude.show $ a+ cmp item = Prelude.compare item a++-- | Builds a Predbox for items that might fail to return a comparison.+compareByMaybe+ :: Text+ -- ^ How to show the item being compared++ -> Text+ -- ^ Description of type of thing being matched++ -> (a -> Maybe Ordering)+ -- ^ How to compare against right hand side. If Nothing, a Predbox that+ -- always returns False is returned.++ -> Ordering+ -- ^ Ordering that must result for the Predbox to be True++ -> Predbox a++compareByMaybe itemDesc typeDesc cmp ord =+ Predbox l (const False) (Predicate f)+ where+ l = typeDesc <> " is " <> cmpDesc <> " " <> itemDesc+ cmpDesc = case ord of+ LT -> "less than"+ GT -> "greater than"+ EQ -> "equal to"+ f subj = case cmp subj of+ Nothing -> False+ Just ord' -> ord == ord'++greater+ :: (Show a, Ord a)+ => Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> a+ -- ^ The right hand side of the comparison.++ -> Predbox a+greater d a = compare d a GT++less+ :: (Show a, Ord a)+ => Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> a+ -- ^ The right hand side of the comparison.++ -> Predbox a+less d a = compare d a LT++equal+ :: (Show a, Ord a)+ => Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> a+ -- ^ The right hand side of the comparison.++ -> Predbox a+equal d a = compare d a EQ++greaterEq+ :: (Show a, Ord a)+ => Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> a+ -- ^ The right hand side of the comparison.++ -> Predbox a+greaterEq d a = greater d a ||| equal d a++lessEq+ :: (Show a, Ord a)+ => Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> a+ -- ^ The right hand side of the comparison.++ -> Predbox a+lessEq d a = less d a ||| equal d a++notEq+ :: (Show a, Ord a)+ => Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> a+ -- ^ The right hand side of the comparison.++ -> Predbox a+notEq d a = not $ equal d a++greaterBy+ :: Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> Text+ -- ^ Description of the type of thing that is being matched++ -> (a -> Ordering)+ -- ^ How to compare two items++ -> Predbox a+greaterBy iD tD cmp = compareBy iD tD cmp GT++lessBy+ :: Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> Text+ -- ^ Description of the type of thing that is being matched++ -> (a -> Ordering)+ -- ^ How to compare two items++ -> Predbox a+lessBy iD tD cmp = compareBy iD tD cmp LT++equalBy+ :: Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> Text+ -- ^ Description of the type of thing that is being matched++ -> (a -> Ordering)+ -- ^ How to compare two items++ -> Predbox a+equalBy iD tD cmp = compareBy iD tD cmp EQ++greaterEqBy+ :: Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> Text+ -- ^ Description of the type of thing that is being matched++ -> (a -> Ordering)+ -- ^ How to compare two items++ -> Predbox a+greaterEqBy iD tD cmp =+ greaterBy iD tD cmp ||| equalBy iD tD cmp++lessEqBy+ :: Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> Text+ -- ^ Description of the type of thing that is being matched++ -> (a -> Ordering)+ -- ^ How to compare two items++ -> Predbox a+lessEqBy iD tD cmp =+ lessBy iD tD cmp ||| equalBy iD tD cmp++notEqBy+ :: Text+ -- ^ How to show the item being compared; used to describe the Predbox++ -> Text+ -- ^ Description of the type of thing that is being matched++ -> (a -> Ordering)+ -- ^ How to compare two items++ -> Predbox a+notEqBy iD tD cmp =+ not $ equalBy iD tD cmp++-- | Parses a string to find the correct comparer; returns the correct+-- function to build a Predbox.++parseComparer+ :: Text+ -- ^ The string with the comparer to be parsed+ -> (Ordering -> Predbox a)+ -- ^ A function that, when given an ordering, returns a Predbox+ -> Maybe (Predbox a)+ -- ^ If an invalid comparer string is given, Nothing; otherwise, the+ -- Predbox.+parseComparer t f+ | t == ">" = Just (f GT)+ | t == "<" = Just (f LT)+ | t == "=" = Just (f EQ)+ | t == "==" = Just (f EQ)+ | t == ">=" = Just (f GT ||| f EQ)+ | t == "<=" = Just (f LT ||| f EQ)+ | t == "/=" = Just (not $ f EQ)+ | t == "!=" = Just (not $ f EQ)+ | otherwise = Nothing+
lib/Data/Prednote/Test.hs view
@@ -8,7 +8,7 @@ , Verbosity(..) , TrueVerbosity , FalseVerbosity- , ShowTest(..)+ , TestVisibility(..) , TestVerbosity(..) , Pass , Test(..)@@ -20,7 +20,7 @@ -- * Running and showing tests , evalTest- , showResult+ , showTestResult ) where @@ -32,15 +32,15 @@ import Data.Text (Text) import qualified System.Console.Rainbow as R-import qualified Data.Prednote.Pdct as Pt+import qualified Data.Prednote.Predbox as Pt -- # Types --- | How verbose to be when showing the results of running a Pdct on a+-- | How verbose to be when showing the results of running a Predbox on a -- single subject. data Verbosity = HideAll- -- ^ Do not show any results from the Pdct+ -- ^ Do not show any results from the Predbox | ShowDefaults -- ^ Show results according to the default settings provided in the@@ -57,7 +57,7 @@ type FalseVerbosity = Verbosity -- | Determines whether to show any of the results from a single test.-data ShowTest+data TestVisibility = HideTest -- ^ Do not show any results from this test @@ -69,12 +69,12 @@ deriving (Eq, Show) --- | Determines which ShowTest to use for a particular test.+-- | Determines which TestVisibility to use for a particular test. data TestVerbosity = TestVerbosity- { onPass :: ShowTest- -- ^ Use this ShowTest when the test passes- , onFail :: ShowTest- -- ^ Use this ShowTest when the test fails+ { onPass :: TestVisibility+ -- ^ Use this TestVisibility when the test passes+ , onFail :: TestVisibility+ -- ^ Use this TestVisibility when the test fails } deriving (Eq, Show) type Pass = Bool@@ -137,7 +137,7 @@ ss = zip ls results -- | Shows a result with indenting.-showResult+showTestResult :: Pt.IndentAmt -- ^ Indent each level by this many spaces @@ -153,7 +153,7 @@ -- ^ The result to show -> [R.Chunk]-showResult amt swr mayVb (TestResult n p ss dfltVb) =+showTestResult amt swr mayVb (TestResult n p ss dfltVb) = let vb = fromMaybe dfltVb mayVb tv = if p then onPass vb else onFail vb firstLine = showTestTitle n p@@ -181,19 +181,19 @@ -- # Pre-built tests -- | The test passes if each subject returns True.-eachSubjectMustBeTrue :: Pt.Pdct a -> Name -> Test a+eachSubjectMustBeTrue :: Pt.Predbox a -> Name -> Test a eachSubjectMustBeTrue pd nm = Test nm pass f vy where vy = TestVerbosity { onPass = ShowFirstLine HideAll HideAll , onFail = ShowFirstLine HideAll ShowDefaults } pass = all Pt.rBool- f = flip Pt.evaluate pd+ f = Pt.evaluate pd -- | The test passes if at least a given number of subjects are True. nSubjectsMustBeTrue- :: Pt.Pdct a+ :: Pt.Predbox a -> Name -> Int -- ^ The number of subjects that must be True. This should be a@@ -202,7 +202,7 @@ nSubjectsMustBeTrue pd nm i = Test nm pass f vy where pass = atLeast i . filter Pt.rBool- f = flip Pt.evaluate pd+ f = Pt.evaluate pd vy = TestVerbosity { onPass = ShowFirstLine HideAll HideAll , onFail = ShowFirstLine HideAll HideAll }
minimum-versions.txt view
@@ -1,7 +1,7 @@ This package was tested to work with these dependency versions and compiler version. These are the minimum versions given in the .cabal file.-Tested as of: 2014-03-01 19:44:29.719081 UTC+Tested as of: 2014-03-02 01:48:34.516774 UTC Path to compiler: ghc-7.4.1 Compiler description: 7.4.1 @@ -33,10 +33,10 @@ time-1.4 unix-2.5.1.0 -/home/massysett/prednote/sunlight-17262/db:+/home/massysett/prednote/sunlight-20181/db: QuickCheck-2.6 contravariant-0.2.0.1- prednote-0.20.0.0+ prednote-0.22.0.0 rainbow-0.6.0.4 random-1.0.1.1 split-0.2.2
prednote-test.hs view
@@ -6,81 +6,81 @@ import Test.QuickCheck.All (quickCheckAll) import Test.QuickCheck.Function import Test.QuickCheck (Arbitrary, Gen, arbitrary)-import qualified Data.Prednote.Pdct as P-import Data.Prednote.Pdct ((&&&), (|||))+import qualified Data.Prednote.Predbox as P+import Data.Prednote.Predbox ((&&&), (|||)) import qualified Data.Text as X import qualified System.Exit as Exit instance Arbitrary X.Text where arbitrary = fmap X.pack (Q.listOf (Q.choose ('!', '~'))) -instance Q.CoArbitrary a => Arbitrary (P.Pdct a) where- arbitrary = P.Pdct <$> arbitrary <*> arbitrary <*> arbitrary+instance Q.CoArbitrary a => Arbitrary (P.Predbox a) where+ arbitrary = P.Predbox <$> arbitrary <*> arbitrary <*> arbitrary instance Q.CoArbitrary a => Arbitrary (P.Node a) where arbitrary = Q.sized tree where- tree 0 = fmap P.Operand arbitrary+ tree 0 = fmap P.Predicate arbitrary tree n = Q.oneof [ fmap P.And (Q.listOf subtree) , fmap P.Or (Q.listOf subtree) , fmap P.Not subtree ] where- subtree = P.Pdct <$> arbitrary <*> arbitrary+ subtree = P.Predbox <$> arbitrary <*> arbitrary <*> tree (n `div` 2) -- | And is commutative-prop_andCommutative :: a -> P.Pdct a -> P.Pdct a -> Bool+prop_andCommutative :: a -> P.Predbox a -> P.Predbox a -> Bool prop_andCommutative a p1 p2 = P.rBool r1 == P.rBool r2 where- r1 = P.evaluate a (p1 &&& p2)- r2 = P.evaluate a (p2 &&& p1)+ r1 = P.evaluate (p1 &&& p2) a+ r2 = P.evaluate (p2 &&& p1) a -- | And is associative-prop_andAssociative :: a -> P.Pdct a -> P.Pdct a -> P.Pdct a -> Bool+prop_andAssociative :: a -> P.Predbox a -> P.Predbox a -> P.Predbox a -> Bool prop_andAssociative a p1 p2 p3 = P.rBool r1 == P.rBool r2 where- r1 = P.evaluate a (p1 &&& (p2 &&& p3))- r2 = P.evaluate a ((p1 &&& p2) &&& p3)+ r1 = P.evaluate (p1 &&& (p2 &&& p3)) a+ r2 = P.evaluate ((p1 &&& p2) &&& p3) a -- | Or is commutative-prop_orCommutative :: a -> P.Pdct a -> P.Pdct a -> Bool+prop_orCommutative :: a -> P.Predbox a -> P.Predbox a -> Bool prop_orCommutative a p1 p2 = P.rBool r1 == P.rBool r2 where- r1 = P.evaluate a (p1 ||| p2)- r2 = P.evaluate a (p2 ||| p1)+ r1 = P.evaluate (p1 ||| p2) a+ r2 = P.evaluate (p2 ||| p1) a -- | Or is associative-prop_orAssociative :: a -> P.Pdct a -> P.Pdct a -> P.Pdct a -> Bool+prop_orAssociative :: a -> P.Predbox a -> P.Predbox a -> P.Predbox a -> Bool prop_orAssociative a p1 p2 p3 = P.rBool r1 == P.rBool r2 where- r1 = P.evaluate a (p1 ||| (p2 ||| p3))- r2 = P.evaluate a ((p1 ||| p2) ||| p3)+ r1 = P.evaluate (p1 ||| (p2 ||| p3)) a+ r2 = P.evaluate ((p1 ||| p2) ||| p3) a -- | Anything or'd with True is True-prop_orWithTrue :: a -> P.Pdct a -> Bool+prop_orWithTrue :: a -> P.Predbox a -> Bool prop_orWithTrue a p1 = P.rBool r1 where- r1 = P.evaluate a (p1 ||| P.always)+ r1 = P.evaluate (p1 ||| P.always) a -- | Anything and'ed with False is False-prop_andWithFalse :: a -> P.Pdct a -> Bool+prop_andWithFalse :: a -> P.Predbox a -> Bool prop_andWithFalse a p1 = not $ P.rBool r1 where- r1 = P.evaluate a (p1 &&& P.never)+ r1 = P.evaluate (p1 &&& P.never) a --- | And Distributitivy-prop_andDistributivity :: a -> P.Pdct a -> P.Pdct a -> P.Pdct a -> Bool+-- | And Distributivity+prop_andDistributivity :: a -> P.Predbox a -> P.Predbox a -> P.Predbox a -> Bool prop_andDistributivity x a b c = P.rBool r1 == P.rBool r2 where- r1 = P.evaluate x $ a &&& (b ||| c)- r2 = P.evaluate x $ (a &&& b) ||| (a &&& c)+ r1 = P.evaluate (a &&& (b ||| c)) x+ r2 = P.evaluate ((a &&& b) ||| (a &&& c)) x -prop_orDistributivity :: a -> P.Pdct a -> P.Pdct a -> P.Pdct a -> Bool+prop_orDistributivity :: a -> P.Predbox a -> P.Predbox a -> P.Predbox a -> Bool prop_orDistributivity x a b c = P.rBool r1 == P.rBool r2 where- r1 = P.evaluate x $ a ||| (b &&& c)- r2 = P.evaluate x $ (a ||| b) &&& (a ||| c)+ r1 = P.evaluate (a ||| (b &&& c)) x+ r2 = P.evaluate ((a ||| b) &&& (a ||| c)) x runTests = $quickCheckAll
prednote.cabal view
@@ -1,5 +1,5 @@ name: prednote-version: 0.20.0.0+version: 0.22.0.0 synopsis: Build and evaluate trees of predicates description: Build and evaluate trees of predicates. For example, you might build@@ -33,7 +33,8 @@ library exposed-modules:- Data.Prednote.Pdct+ Data.Prednote+ , Data.Prednote.Predbox , Data.Prednote.Expressions , Data.Prednote.Expressions.Infix , Data.Prednote.Expressions.RPN