cond-0.4.1.1/0000755000000000000000000000000012434405346010771 5ustar0000000000000000cond-0.4.1.1/Setup.hs0000644000000000000000000000005512434405346012425 0ustar0000000000000000import Distribution.Simple main = defaultMaincond-0.4.1.1/README.md0000644000000000000000000000046312434405346012253 0ustar0000000000000000# Description A library of boolean operations, lifted in a typeclass for boolean values. Also includes: * Lifted monadic variants of those operations. * Hoare's conditional choice operator. * A typeclass for boolean algebras. See annotated documentation in code for information about individual entities.cond-0.4.1.1/LICENSE0000644000000000000000000000274412434405346012005 0ustar0000000000000000Copyright (c) 2012, Adam Curtis All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Adam Curtis nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.cond-0.4.1.1/cond.cabal0000644000000000000000000000206312434405346012701 0ustar0000000000000000Name: cond Version: 0.4.1.1 Synopsis: Basic conditional and boolean operators with monadic variants. Category: Control, Logic, Monad License: BSD3 License-File: LICENSE Author: Adam Curtis Maintainer: acurtis@spsu.edu Homepage: https://github.com/kallisti-dev/cond Cabal-Version: >= 1.6 Build-Type: Simple Description: 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. Extra-source-files: README.md source-repository head type: git location: git://github.com/kallisti-dev/cond.git library hs-source-dirs: src ghc-options: -Wall exposed-modules: Control.Conditional Data.Algebra.Boolean build-depends: base >= 3 && < 5cond-0.4.1.1/src/0000755000000000000000000000000012434405346011560 5ustar0000000000000000cond-0.4.1.1/src/Data/0000755000000000000000000000000012434405346012431 5ustar0000000000000000cond-0.4.1.1/src/Data/Algebra/0000755000000000000000000000000012434405346013766 5ustar0000000000000000cond-0.4.1.1/src/Data/Algebra/Boolean.hs0000644000000000000000000001334512434405346015707 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-} module Data.Algebra.Boolean ( Boolean(..), fromBool, Bitwise(..) ) where import Data.Monoid (Any(..), All(..), Dual(..), Endo(..)) import Data.Bits (Bits, complement, (.|.), (.&.)) import qualified Data.Bits as Bits import Data.Function (on) import Data.Typeable import Data.Data import Data.Ix import Data.Foldable (Foldable) import qualified Data.Foldable as F import Foreign.Storable import Text.Printf import Prelude hiding ((&&), (||), not, and, or, any, all) import qualified Prelude as P infixr 1 <-->, `xor`, --> infixr 2 || infixr 3 && -- |A class for boolean algebras. Instances of this class are expected to obey -- all the laws of boolean algebra. -- -- Minimal complete definition: 'true' or 'false', 'not' or '<-->', '||' or '&&'. class Boolean b where -- |Truth value, defined as the top of the bounded lattice true :: b -- |False value, defined as the bottom of the bounded lattice. false :: b -- |Logical negation. not :: b -> b -- |Logical conjunction. (infxr 3) (&&) :: b -> b -> b -- |Logical inclusive disjunction. (infixr 2) (||) :: b -> b -> b -- |Logical exclusive disjunction. (infixr 1) xor :: b -> b -> b -- |Logical implication. (infixr 1) (-->) :: b -> b -> b -- |Logical biconditional. (infixr 1) (<-->) :: b -> b -> b -- | The logical conjunction of several values. and :: Foldable t => t b -> b -- | The logical disjunction of several values. or :: Foldable t => t b -> b -- | The negated logical conjunction of several values. -- -- @'nand' = 'not' . 'and'@ nand :: Foldable t => t b -> b nand = not . and -- | The logical conjunction of the mapping of a function over several values. all :: Foldable t => (a -> b) -> t a -> b -- | The logical disjunction of the mapping of a function over several values. any :: Foldable t => (a -> b) -> t a -> b -- | The negated logical disjunction of several values. -- -- @'nor' = 'not' . 'or'@ nor :: Foldable t => t b -> b nor = not . or -- Default implementations true = not false false = not true not = (<--> false) x && y = not (not x || not y) x || y = not (not x && not y) x `xor` y = (x || y) && (not (x && y)) x --> y = not x || y x <--> y = (x && y) || not (x || y) and = F.foldl' (&&) true or = F.foldl' (||) false all p = F.foldl' f true where f a b = a && p b any p = F.foldl' f false where f a b = a || p b -- |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) instance (Boolean x, Boolean y) => Boolean (x, y) where true = (true, true) false = (false, false) not (a, b) = (not a, not b) (a, b) && (c, d) = (a && c, b && d) (a, b) || (c, d) = (a || c, b || d) (a, b) `xor` (c, d) = (a `xor` c, b `xor` d) (a, b) --> (c, d) = (a --> c, b --> d) (a, b) <--> (c, d) = (a <--> c, b <--> d) -- |A newtype wrapper that derives a 'Boolean' instance from any type that is both -- a 'Bits' instance and a 'Num' instance, -- such that boolean logic operations on the 'Bitwise' wrapper correspond to -- bitwise logic operations on the inner type. It should be noted that 'false' is -- defined as 'Bitwise' 0 and 'true' is defined as 'not' 'false'. -- -- In addition, a number of other classes are automatically derived from the inner -- type. These classes were chosen on the basis that many other 'Bits' -- instances defined in base are also instances of these classes. newtype Bitwise a = Bitwise {getBits :: a} deriving (Num, Bits, Eq, Ord, Bounded, Enum, Show, Read, Real, Integral, Typeable, Data, Ix, Storable, PrintfArg) instance (Num a, Bits a) => Boolean (Bitwise a) where true = not false false = Bitwise 0 not = Bitwise . complement . getBits (&&) = (Bitwise .) . (.&.) `on` getBits (||) = (Bitwise .) . (.|.) `on` getBits xor = (Bitwise .) . (Bits.xor `on` getBits) (<-->) = xor `on` not cond-0.4.1.1/src/Control/0000755000000000000000000000000012434405346013200 5ustar0000000000000000cond-0.4.1.1/src/Control/Conditional.hs0000644000000000000000000002247512434405346016011 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} -- |A convenient set of useful conditional operators. module Control.Conditional ( -- *Conversion typeclass ToBool(..) -- * Basic conditional operators , if', (??), bool , ifM, (<||>), (<&&>), notM, xorM -- * Lisp-style conditional operators , cond, condDefault, condPlus, condM, condPlusM, otherwiseM -- * Conditional operator on categories , (?.) -- * Conditional operator on monoids , (?<>) -- * Conditional operator on functions , select, selectM -- * C-style ternary conditional , (?) -- *Hoare's conditional choice operator -- |The following operators form a ternary conditional of the form -- -- > t <| p |> f -- -- These operators chain with right associative fixity. This allows -- chaining of conditions, where the result of the expression is -- the value to the left of the first predicate that succeeds. -- -- For more information see -- , (|>), (<|) -- **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. , (⊳), (⊲) -- *Generalized monadic conditionals , guard, guardM, when, whenM, unless, unlessM, ) where import Data.Algebra.Boolean import Control.Monad hiding (guard, when, unless) import Control.Category import Data.Monoid import Data.Maybe import Prelude hiding ((.), id, (&&), (||), not) infixr 0 <|, |>, ⊳, ⊲, ?, <<|, |>> infixr 1 ?? infixr 2 <||> infixr 3 <&&> infixr 7 ?<> infixr 9 ?. -- |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 bool where toBool :: bool -> 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 bool => bool -> a -> a -> a if' p t f = if toBool p then t else f {-# INLINE if' #-} -- |'if'' with the 'Bool' argument at the end (infixr 1). (??) :: ToBool bool => a -> a -> bool -> a (??) t f p = if' p t f {-# INLINE (??) #-} -- |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 :: (ToBool bool) => a -> a -> bool -> a bool f t p = if' p t f {-# INLINE bool #-} -- |Lisp-style conditionals. If no conditions match, then a runtime exception -- is thrown. Here's a trivial example: -- -- @ -- signum x = cond [(x > 0 , 1 ) -- ,(x < 0 , -1) -- ,(otherwise , 0 )] -- @ cond :: ToBool bool => [(bool, a)] -> a cond [] = error "cond: no matching conditions" cond ((p,v):ls) = if' p v (cond ls) -- | Analogous to the 'cond' function with a default value supplied, -- which will be used when no condition in the list is matched. condDefault :: ToBool bool => a -> [(bool, a)] -> a condDefault = (. condPlus) . (<|) {-# INLINE condDefault #-} -- |Lisp-style conditionals generalized over 'MonadPlus'. If no conditions -- match, then the result is 'mzero'. This is a safer variant of 'cond'. -- -- Here's a highly contrived example using 'Data.Maybe.fromMaybe': -- -- @ -- signum x = fromMaybe 0 . condPlus $ [(x > 0, 1 ) -- ,(x < 0, -1)] -- @ -- -- Alternatively, you could use the '<|' operator from Hoare's ternary -- conditional choice operator, like so: -- -- @ -- signum x = 0 \<| condPlus [(x > 0, 1 ) -- ,(x < 0, -1)] -- @ condPlus :: (ToBool bool, MonadPlus m) => [(bool, 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. (?.) :: (ToBool bool, Category cat) => bool -> cat a a -> cat a a p ?. c = if' p c id {-# INLINE (?.) #-} -- |Composes a predicate function and 2 functions into a single -- function. The first function is called when the predicate yields True, the -- second when the predicate yields False. -- -- Note that after importing "Control.Monad.Instances", 'select' becomes a -- special case of 'ifM'. select :: ToBool bool => (a -> bool) -> (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 :: (ToBool bool, Monad m) => m bool -> m a -> m a -> m a ifM p t f = p >>= bool f t {-# INLINE ifM #-} -- |Lifted inclusive disjunction. Unlike 'liftM2' ('||'), This function is -- short-circuiting in the monad. Fixity is the same as '||' (infixr 2). (<||>) :: (ToBool bool, Boolean bool, Monad m) => m bool -> m bool -> m bool (<||>) t f = ifM t (return true) f {-# INLINE (<||>) #-} -- |Lifted conjunction. Unlike 'liftM2' ('&&'), this function is -- short-circuiting in the monad. Fixity is the same as '&&' (infxr 3). (<&&>) :: (ToBool bool, Boolean bool, Monad m) => m bool -> m bool -> m bool (<&&>) t f = ifM t f (return false) {-# INLINE (<&&>) #-} -- |Lifted boolean negation. notM :: (Boolean bool, Monad m) => m bool -> m bool notM = liftM not {-# INLINE notM #-} -- |Lifted boolean exclusive disjunction. xorM :: (Boolean bool, Monad m) => m bool -> m bool -> m bool xorM = liftM2 xor -- |'cond' lifted to 'Monad'. If no conditions match, a runtime exception -- is thrown. condM :: (ToBool bool, Monad m) => [(m bool, 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 :: (ToBool bool, MonadPlus m) => [(m bool, m a)] -> m a condPlusM [] = mzero condPlusM ((p, v):ls) = ifM p v (condPlusM ls) -- |A synonym for 'return' 'true'. otherwiseM :: (Boolean bool, Monad m) => m bool otherwiseM = return true -- |Generalization of 'Control.Monad.guard' guard :: (ToBool bool, MonadPlus m) => bool -> m () guard p = if' p (return ()) mzero {-# INLINE guard #-} -- |Generalization of 'Control.Monad.when' when :: (ToBool bool, Monad m) => bool -> m () -> m () when p m = if' p m (return ()) {-# INLINE when #-} -- |Generalization of 'Control.Monad.unless' unless :: (Boolean bool, ToBool bool, Monad m) => bool -> m() -> m() unless p m = if' (not p) m (return ()) {-# INLINE unless #-} -- |A variant of 'when' with a monadic predicate. whenM :: (ToBool bool, Monad m) => m bool -> m () -> m () whenM p m = ifM p m (return ()) {-# INLINE whenM #-} -- |A variant of 'unless' with a monadic predicate. unlessM :: (ToBool bool, Boolean bool, Monad m) => m bool -> m () -> m () unlessM p m = ifM (notM p) m (return ()) {-# INLINE unlessM #-} -- |A variant of 'guard' with a monadic predicate. guardM :: (ToBool bool, MonadPlus m) => m bool -> m () guardM = (guard =<<) {-# INLINE guardM #-} -- |'select' lifted to 'Monad'. selectM :: (ToBool bool, Monad m) => (a -> m bool) -> (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 -- level higher than 'Data.Monoid.<>'. -- -- It can also be used to chain multiple predicates together, like this: -- -- > even (length ls) ?<> not (null ls) ?<> ls (?<>) :: (ToBool bool, Monoid a) => bool -> a -> a p ?<> m = if' p m mempty {-# INLINE (?<>) #-} -- |An operator that allows you to write C-style ternary conditionals of -- the form: -- -- > p ? t ?? f -- -- Note that parentheses are required in order to chain sequences of -- conditionals together. This is probably a good thing. (?) :: b -> (b -> a) -> a p ? f = f p {-# INLINE (?) #-} -- |Right bracket of the conditional choice operator. If the predicate -- is 'True', returns 'Nothing', otherwise it returns 'Just' the right-hand -- argument. (|>) :: ToBool bool => bool -> 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 (<|) #-} -- |A monadic variant of '|>'. (|>>) :: (ToBool bool, Monad m) => m bool -> 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 '|>'. (⊳) :: ToBool bool => bool -> a -> Maybe a (⊳) = (|>)