cond 0.2 → 0.3

raw patch · 3 files changed

+215/−54 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• cond.cabal +11/−4
• src/Control/Conditional.hs +107/−50
• src/Data/Algebra/Boolean.hs +97/−0

@@ -1,5 +1,5 @@ Name: cond-Version: 0.2+Version: 0.3 Synopsis: Basic conditional and boolean operators with monadic variants. Category: Control, Logic, Monad License: BSD3@@ -10,11 +10,17 @@ Cabal-Version: >= 1.6 Build-Type: Simple Description:-  A very simple library implementing various conditional operations, as well-  as some functions for dealing with conditions in monadic code.+  This library provides:+  .+  * Implementations of various overloaded conditional operations+  .+  * Lifted monadic variants of those operations and common boolean operators+  .+  * A typeclass for boolean algebras.+  .   Feel free to send ideas and suggestions for new conditional operators to the   maintainer.-+  .   Monadic looping constructs are not included as part of this package, since the   monad-loops package has a fairly complete collection of them already.  @@ -26,4 +32,5 @@   hs-source-dirs: src   ghc-options: -Wall   exposed-modules: Control.Conditional+                   Data.Algebra.Boolean   build-depends: base >= 3 && < 5

@@ -1,15 +1,19 @@+{-# LANGUAGE FlexibleInstances #-} -- |A convenient set of useful conditional operators. module Control.Conditional-       ( -- * Simple conditional operators-         if', (??), bool+       ( -- *Conversion typeclass+         ToBool(..)+         -- * Basic conditional operators+       , if', (??), bool+       , ifM, (<||>), (<&&>), notM, xorM          -- * Lisp-style conditional operators -       , cond, condPlus+       , cond, condPlus, condM, condPlusM, otherwiseM          -- * Conditional operator on categories        , (?.)          -- * Conditional operator on monoids        , (?<>)          -- * Conditional operator on functions-       , select+       , select, selectM           -- * C-style ternary conditional        , (?)          -- *Hoare's conditional choice operator@@ -24,42 +28,62 @@          -- For more information see           -- <http://zenzike.com/posts/2011-08-01-the-conditional-choice-operator>        , (|>), (<|)+         -- **Lifted conditional choice+         -- |In addition, you can write lifted conditionals of the form:+         -- +         -- > t <<| p |>> f+       , (|>>), (<<|)          -- **Unicode variants          -- |Intended to resemble the notation used in Tony Hoare's           -- Unified Theories of Programming.        , (⊳), (⊲)-         -- * Lifted conditional and boolean operators-       , ifM, (<||>), (<&&>), notM, condM, condPlusM, otherwiseM-       , guardM, whenM, unlessM, selectM +         -- *Generalized monadic conditionals+       , guard, guardM, when, whenM, unless, unlessM,         ) where -import Control.Monad+import Data.Algebra.Boolean+import Control.Monad hiding (guard, when, unless) import Control.Category  import Data.Monoid-import Prelude hiding ((.), id)+import Data.Maybe+import Prelude hiding ((.), id, (&&), (||), not) -infixr  0 <|, |>, ⊳, ⊲, ?+infixr  0 <|, |>, ⊳, ⊲, ?, <<|, |>> infixr  1 ?? infixr  2 <||> infixr  3 <&&> infixr  7 ?<> infixr  9 ?.  --- |A simple conditional function.-if' :: Bool -> a -> a -> a-if' p t f = if p then t else f-{-# INLINE if' #-}+-- |Conversion of values to 'Bool'.+--+-- Instances of 'ToBool' that are also 'Boolean' should obey the following laws:+--+-- > p || q = if toBool p then true else q+--+-- > p && q = if toBool p then q else false+class ToBool b where+  toBool :: b -> Bool +instance ToBool Bool where toBool = id+instance ToBool Any  where toBool = getAny+instance ToBool All  where toBool = getAll+instance ToBool (Dual Bool) where toBool = getDual++-- |A simple conditional operator+if' :: ToBool b => b -> a -> a -> a+if' p t f = if toBool p then t else f+ -- |'if'' with the 'Bool' argument at the end (infixr 1).-(??) :: a -> a -> Bool -> a+(??) :: ToBool b => a -> a -> b -> a (??) t f p = if' p t f  {-# INLINE (??) #-} --- |A catamorphism (aka fold) for the Bool type. This is analogous to +-- |A catamorphism (aka fold) for booleans. This is analogous to  -- 'foldr', 'Data.Maybe.maybe', and 'Data.Either.either'. The first argument is  -- the false case, the second argument is the true case, and the last argument  -- is the predicate value.-bool :: a -> a -> Bool -> a+bool :: (ToBool b) => a -> a -> b -> a bool f t p = if' p t f {-# INLINE bool #-} @@ -71,7 +95,7 @@ --                   ,(x < 0     , -1) --                   ,(otherwise , 0 )] -- @-cond :: [(Bool, a)] -> a+cond :: ToBool b => [(b, a)] -> a cond [] = error "cond: no matching conditions" cond ((p,v):ls) = if' p v (cond ls) @@ -92,14 +116,14 @@ --   signum x = 0 \<| condPlus [(x > 0, 1 )  --                            ,(x < 0, -1)] -- @-condPlus :: MonadPlus m => [(Bool, a)] -> m a+condPlus :: (ToBool b, MonadPlus m) => [(b, a)] -> m a condPlus [] = mzero condPlus ((p,v):ls) = if' p (return v) (condPlus ls)  -- |Conditional composition. If the predicate is False, 'id' is returned -- instead of the second argument. This function, for example, can be used to  -- conditionally add functions to a composition chain.-(?.) :: Category cat => Bool -> cat a a -> cat a a+(?.) :: (ToBool b, Category cat) => b -> cat a a -> cat a a p ?. c = if' p c id {-# INLINE (?.) #-} @@ -109,68 +133,89 @@ -- -- Note that after importing "Control.Monad.Instances", 'select' becomes a   -- special case of 'ifM'.-select :: (a -> Bool) -> (a -> b) -> (a -> b) -> (a -> b)+select :: ToBool p => (a -> p) -> (a -> b) -> (a -> b) -> (a -> b) select p t f x = if' (p x) (t x) (f x) {-# INLINE select #-}  -- |'if'' lifted to 'Monad'. Unlike 'liftM3' 'if'', this is   -- short-circuiting in the monad, such that only the predicate action and one of -- the remaining argument actions are executed.-ifM :: Monad m => m Bool -> m a -> m a -> m a +ifM :: (ToBool b, Monad m) => m b -> m a -> m a -> m a  ifM p t f = p >>= bool f t {-# INLINE ifM #-} --- |Lifted boolean or. Unlike 'liftM2' ('||'), This function is short-circuiting--- in the monad. Fixity is the same as '||' (infixr 2).-(<||>) :: Monad m => m Bool -> m Bool -> m Bool-(<||>) t f = ifM t (return True) f+-- |Lifted inclusive disjunction. Unlike 'liftM2' ('||'), This function is +-- short-circuiting in the monad. Fixity is the same as '||' (infixr 2).+(<||>) :: (ToBool b, Boolean b, Monad m) => m b -> m b -> m b+(<||>) t f = ifM t (return true) f {-# INLINE (<||>) #-} --- |Lifted boolean and. Unlike 'liftM2' ('&&'), this function is +-- |Lifted conjunction. Unlike 'liftM2' ('&&'), this function is  -- short-circuiting in the monad. Fixity is the same as '&&' (infxr 3).-(<&&>) :: Monad m => m Bool -> m Bool -> m Bool-(<&&>) t f = ifM t f (return False)+(<&&>) :: (ToBool b, Boolean b, Monad m) => m b -> m b -> m b+(<&&>) t f = ifM t f (return false) {-# INLINE (<&&>) #-}  -- |Lifted boolean negation.-notM :: Monad m => m Bool -> m Bool+notM :: (Boolean b, Monad m) => m b -> m b notM = liftM not {-# INLINE notM #-} +-- |Lifted boolean exclusive disjunction.+xorM :: (Boolean b, Monad m) => m b -> m b -> m b+xorM = liftM2 xor+ -- |'cond' lifted to 'Monad'. If no conditions match, a runtime exception -- is thrown.-condM :: Monad m => [(m Bool, m a)] -> m a +condM :: (ToBool b, Monad m) => [(m b, m a)] -> m a  condM [] = error "condM: no matching conditions" condM ((p, v):ls) = ifM p v (condM ls)  -- |'condPlus' lifted to 'Monad'. If no conditions match, then 'mzero' -- is returned.-condPlusM :: MonadPlus m => [(m Bool, m a)] -> m a+condPlusM :: (ToBool b, MonadPlus m) => [(m b, m a)] -> m a condPlusM [] = mzero condPlusM ((p, v):ls) = ifM p v (condPlusM ls) --- |A synonym for 'return' 'True'.-otherwiseM :: Monad m => m Bool-otherwiseM = return True+-- |A synonym for 'return' 'true'.+otherwiseM :: (Boolean b, Monad m) => m b+otherwiseM = return true --- |A variant of 'Control.Monad.when' with a monadic predicate.-whenM :: Monad m => m Bool -> m () -> m ()+-- |Generalization of 'Control.Monad.guard'+guard :: (ToBool b, MonadPlus m) => b -> m ()+guard p = if' p (return ()) mzero+{-# INLINE guard #-}++-- |Generalization of 'Control.Monad.when'+when :: (ToBool b, MonadPlus m) => b -> m () -> m ()+when p m = if' p m (return ())+{-# INLINE when #-}++-- |Generalization of 'Control.Monad.unless'+unless :: (Boolean b, ToBool b, MonadPlus m) => b -> m() -> m()+unless p m = if' (not p) m (return ())+{-# INLINE unless #-}++-- |A variant of 'when' with a monadic predicate.+whenM :: (ToBool b, Monad m) => m b -> m () -> m () whenM p m = ifM p m (return ()) {-# INLINE whenM #-} --- |A variant of 'Control.Monad.unless' with a monadic predicate.-unlessM :: Monad m => m Bool -> m () -> m ()+-- |A variant of 'unless' with a monadic predicate.+unlessM :: (ToBool b, Boolean b, Monad m) => m b -> m () -> m () unlessM p m = ifM (notM p) m (return ()) {-# INLINE unlessM #-} --- |A variant of 'Control.Monad.guard' with a monadic predicate.-guardM :: MonadPlus m => m Bool -> m ()+-- |A variant of 'guard' with a monadic predicate.+guardM :: (ToBool b, MonadPlus m) => m b -> m () guardM = (guard =<<) {-# INLINE guardM #-}  -- |'select' lifted to 'Monad'.-selectM :: Monad m => (a -> m Bool) -> (a -> m b) -> (a -> m b) -> (a -> m b)+selectM :: (ToBool p, Monad m) => +           (a -> m p) -> (a -> m b) -> (a -> m b) -> (a -> m b) selectM p t f x = ifM (p x) (t x) (f x) +{-# INLINE selectM #-}  -- |Conditional monoid operator. If the predicate is 'False', the second -- argument is replaced with 'mempty'. The fixity of this operator is one@@ -179,7 +224,7 @@ -- It can also be used to chain multiple predicates together, like this:  -- -- > even (length ls) ?<> not (null ls) ?<> ls-(?<>) :: Monoid a => Bool -> a -> a+(?<>) :: (ToBool b, Monoid a) => b -> a -> a p ?<> m = if' p m mempty {-# INLINE (?<>) #-}  @@ -191,26 +236,38 @@ -- -- Note that parentheses are required in order to chain sequences of -- conditionals together. This is probably a good thing.-(?) :: Bool -> (Bool -> a) -> a+(?) :: b -> (b -> a) -> a p ? f = f p+{-# INLINE (?) #-}  -- |Right bracket of the conditional choice operator. If the predicate -- is 'False', returns 'Nothing', otherwise it returns 'Just' the right-hand -- argument.-(|>) :: Bool -> a -> Maybe a-True  |> _ = Nothing-False |> f = Just f+(|>) :: ToBool b => b -> a -> Maybe a+p |> v = if' p Nothing (Just v)+{-# INLINE (|>) #-}  -- |Left bracket of the conditional choice operator. This is equivalent to -- 'Data.Maybe.fromMaybe' (<|) :: a -> Maybe a -> a t <| Nothing = t _ <| Just f  = f+{-# INLINE (<|) #-} --- |Unicode rebinding of '|>'. +-- |A monadic variant of '|>'.+(|>>) :: (ToBool b, Monad m) => m b -> m a -> m (Maybe a)+p |>> v = ifM p (return Nothing) (liftM Just v)+{-# INLINE (|>>) #-}++-- |A monadic variant of '<|'.+(<<|) :: Monad m => m a -> m (Maybe a) -> m a+v <<| mv = liftM2 fromMaybe v mv+{-# INLINE (<<|) #-}++-- |Unicode rebinding of '<|'.  (⊲) :: a -> Maybe a -> a (⊲) = (<|) --- |Unicode rebinding of '<|'.-(⊳) :: Bool -> a -> Maybe a+-- |Unicode rebinding of '|>'.+(⊳) :: ToBool b => b -> a -> Maybe a (⊳) = (|>)

@@ -0,0 +1,97 @@+{-# LANGUAGE FlexibleInstances #-}+module Data.Algebra.Boolean +       ( Boolean(..), fromBool+       ) where+import Data.Monoid (Any(..), All(..), Dual(..), Endo(..))+import Prelude hiding ((&&), (||), not)+import qualified Prelude as P+infixr  0 -->+infixr  2 ||+infixr  3 &&++-- |A class for boolean algebras. Instances of this class should obey+-- all the axioms of boolean algebra.+--+-- Minimal complete definition: 'true', 'false', 'not' or '<-->', '||' or '&&'. +class Boolean b where+  -- |Truth value.+  true    :: b+  -- |False value.+  false   :: b+  -- |Logical negation.+  not     :: b -> b+  -- |Logical conjunction.+  (&&)    :: b -> b -> b+  -- |Logical inclusive disjunction.+  (||)    :: b -> b -> b+  -- |Logical exclusive disjunction.+  xor   :: b -> b -> b+  -- |Logical implication+  (-->) :: b -> b -> b+  -- |Logical biconditional+  (<-->) :: b -> b -> b+  +  -- Default implementations+  not       = (<--> false)+  x && y    = not (x || y) +  x || y    = not (x && y)+  x `xor` y = (x || y) && (not (x && y))+  x --> y   = not x || y+  x <--> y  = (x && y) || not (x || y)++-- |Injection from 'Bool' into a boolean algebra.+fromBool :: Boolean b => Bool -> b+fromBool b = if b then true else false++instance Boolean Bool where+  true = True+  false = False+  (&&) = (P.&&)+  (||) = (P.||)+  not = P.not+  xor = (/=)+  True  --> True  = True+  True  --> False = False+  False --> _     = True+  (<-->) = (==)+  ++instance Boolean Any where+  true                  = Any True+  false                 = Any False+  not (Any p)           = Any (not p)+  (Any p) &&    (Any q) = Any (p && q)+  (Any p) ||    (Any q) = Any (p || q)+  (Any p) `xor` (Any q) = Any (p `xor` q)+  (Any p) --> (Any q)   = Any (p --> q)+  (Any p) <--> (Any q)  = Any (p <--> q)+  +instance Boolean All where+  true                  = All True+  false                 = All False+  not (All p)           = All (not p)+  (All p) && (All q)    = All (p && q)+  (All p) || (All q)    = All (p || q)+  (All p) `xor` (All q) = All (p `xor` q)+  (All p) --> (All q)   = All (p --> q)+  (All p) <--> (All q)  = All (p <--> q)+  +instance Boolean (Dual Bool) where+  true                    = Dual True+  false                   = Dual False+  not (Dual p)            = Dual (not p)+  (Dual p) && (Dual q)    = Dual (p && q)+  (Dual p) || (Dual q)    = Dual (p || q)+  (Dual p) `xor` (Dual q) = Dual (p `xor` q)+  (Dual p) --> (Dual q)   = Dual (p --> q)+  (Dual p) <--> (Dual q)  = Dual (p <--> q)+  +instance Boolean (Endo Bool) where+  true                    = Endo (const True)+  false                   = Endo (const False)+  not (Endo p)            = Endo (not . p)+  (Endo p) && (Endo q)    = Endo (\a -> p a && q a)+  (Endo p) || (Endo q)    = Endo (\a -> p a || q a)+  (Endo p) `xor` (Endo q) = Endo (\a -> p a `xor` q a)+  (Endo p) --> (Endo q)   = Endo (\a -> p a --> q a)+  (Endo p) <--> (Endo q)  = Endo (\a -> p a <--> q a)