cond 0.4.1.1 → 0.5.1
raw patch · 3 files changed
Files
- CHANGELOG.md +20/−0
- cond.cabal +27/−6
- src/Data/Algebra/Boolean.hs +203/−47
+ CHANGELOG.md view
@@ -0,0 +1,20 @@+## 0.5.1 [2023-11-19]++- Corrected bug in `XorB` and `EquivB`+++## 0.5.0 [2023-11-19]++- Four monoid structures for a boolean algebra (`AnyB`, `AllB`, `XorB`, `EquivB`)+- Typeclass altered so that {or, and, nor, nand, any, all} are no longer members+- Add instances for `()` and `(a,b,c)`+- `minimal` pragma (and corresponding documentation)+- The opposite Boolean algebra (exchanging `true` and `false`, `&&` and `||`, etc)+- A more general instance for `Endo`+- Tested with GHC 7.0 - 9.6+++## 0.4.2++- Add `instance Boolean b => Boolean (a -> b)`+- Tested with GHC 7.0 - 9.6
cond.cabal view
@@ -1,13 +1,13 @@+Cabal-Version: >= 1.10 Name: cond-Version: 0.4.1.1+Version: 0.5.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+Maintainer: acurtis@spsu.edu, James Cranch <j.d.cranch@sheffield.ac.uk>+Homepage: https://github.com/jcranch/cond Build-Type: Simple Description: This library provides:@@ -23,12 +23,32 @@ . Monadic looping constructs are not included as part of this package, since the monad-loops package has a fairly complete collection of them already.++tested-with:+ GHC == 9.6.3+ GHC == 9.4.6+ GHC == 9.2.8+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2+ GHC == 8.0.2+ GHC == 7.10.3+ GHC == 7.8.4+ GHC == 7.6.3+ GHC == 7.4.2+ GHC == 7.2.2+ GHC == 7.0.4+ Extra-source-files: README.md- + CHANGELOG.md+ source-repository head type: git- location: git://github.com/kallisti-dev/cond.git + location: https://github.com/jcranch/cond.git library hs-source-dirs: src@@ -36,3 +56,4 @@ exposed-modules: Control.Conditional Data.Algebra.Boolean build-depends: base >= 3 && < 5+ default-language: Haskell2010
src/Data/Algebra/Boolean.hs view
@@ -1,17 +1,38 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving,- DeriveDataTypeable+{-# LANGUAGE+ CPP,+ FlexibleInstances,+ GeneralizedNewtypeDeriving,+ DeriveDataTypeable #-}-module Data.Algebra.Boolean- ( Boolean(..), fromBool, Bitwise(..)- ) where+module Data.Algebra.Boolean(+ Boolean(..),+ fromBool,+ Bitwise(..),+ and,+ or,+ nand,+ nor,+ any,+ all,+ Opp(..),+ AnyB(..),+ AllB(..),+ XorB(..),+ EquivB(..),+ ) where import Data.Monoid (Any(..), All(..), Dual(..), Endo(..)) import Data.Bits (Bits, complement, (.|.), (.&.)) import qualified Data.Bits as Bits import Data.Function (on)+#if MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup(..), stimesIdempotentMonoid)+#elif MIN_VERSION_base(4,9,0)+#else+import Data.Monoid (Monoid(..))+#endif 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@@ -23,9 +44,9 @@ infixr 3 && -- |A class for boolean algebras. Instances of this class are expected to obey--- all the laws of boolean algebra.+-- all the laws of [boolean algebra](https://en.wikipedia.org/wiki/Boolean_algebra_(structure)). ----- Minimal complete definition: 'true' or 'false', 'not' or '<-->', '||' or '&&'.+-- Minimal complete definition: 'true' or 'false', 'not' or ('<-->', 'false'), '||' or '&&'. class Boolean b where -- |Truth value, defined as the top of the bounded lattice true :: b@@ -33,7 +54,7 @@ false :: b -- |Logical negation. not :: b -> b- -- |Logical conjunction. (infxr 3)+ -- |Logical conjunction. (infixr 3) (&&) :: b -> b -> b -- |Logical inclusive disjunction. (infixr 2) (||) :: b -> b -> b@@ -44,47 +65,132 @@ -- |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+ {-# MINIMAL (false | true), (not | ((<-->), false)), ((||) | (&&)) #-} -- 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 && 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 +-- | The logical conjunction of several values.+and :: (Boolean b, F.Foldable t) => t b -> b+and = F.foldl' (&&) true++-- | The logical disjunction of several values.+or :: (Boolean b, F.Foldable t) => t b -> b+or = F.foldl' (||) false++-- | The negated logical conjunction of several values.+--+-- @'nand' = 'not' . 'and'@+nand :: (Boolean b, F.Foldable t) => t b -> b+nand = not . and++-- | The negated logical disjunction of several values.+--+-- @'nor' = 'not' . 'or'@+nor :: (Boolean b, F.Foldable t) => t b -> b+nor = not . or++-- | The logical conjunction of the mapping of a function over several values.+all :: (Boolean b, F.Foldable t) => (a -> b) -> t a -> b+all p = F.foldl' f true+ where f a b = a && p b++-- | The logical disjunction of the mapping of a function over several values.+any :: (Boolean b, F.Foldable t) => (a -> b) -> t a -> b+any p = F.foldl' f false+ where f a b = a || p b+++-- | A boolean algebra regarded as a monoid under disjunction+newtype AnyB b = AnyB {+ getAnyB :: b+} deriving (Eq, Ord, Show)++#if MIN_VERSION_base(4,11,0)+instance Boolean b => Semigroup (AnyB b) where+ AnyB x <> AnyB y = AnyB (x || y)+ stimes = stimesIdempotentMonoid++instance Boolean b => Monoid (AnyB b) where+ mempty = AnyB false+#else+instance Boolean b => Monoid (AnyB b) where+ mappend (AnyB x) (AnyB y) = AnyB (x || y)+ mempty = AnyB false+#endif+++-- | A boolean algebra regarded as a monoid under conjunction+newtype AllB b = AllB {+ getAllB :: b+} deriving (Eq, Ord, Show)++#if MIN_VERSION_base(4,11,0)+instance Boolean b => Semigroup (AllB b) where+ AllB x <> AllB y = AllB (x && y)+ stimes = stimesIdempotentMonoid++instance Boolean b => Monoid (AllB b) where+ mempty = AllB true+#else+instance Boolean b => Monoid (AllB b) where+ mappend (AllB x) (AllB y) = AllB (x && y)+ mempty = AllB true+#endif+++-- | `stimes` for a group of exponent 2+stimesPeriod2 :: (Monoid a, Integral n) => n -> a -> a+stimesPeriod2 n x+ | even n = mempty+ | otherwise = x++-- | A boolean algebra regarded as a monoid under exclusive or+newtype XorB b = XorB {+ getXorB :: b+} deriving (Eq, Ord, Show)++#if MIN_VERSION_base(4,11,0)+instance Boolean b => Semigroup (XorB b) where+ XorB x <> XorB y = XorB (x `xor` y)+ stimes = stimesPeriod2++instance Boolean b => Monoid (XorB b) where+ mempty = XorB false+#else+instance Boolean b => Monoid (XorB b) where+ mappend (XorB x) (XorB y) = XorB (x `xor` y)+ mempty = XorB false+#endif+++-- | A boolean algebra regarded as a monoid under equivalence+newtype EquivB b = EquivB {+ getEquivB :: b+} deriving (Eq, Ord, Show)++#if MIN_VERSION_base(4,11,0)+instance Boolean b => Semigroup (EquivB b) where+ EquivB x <> EquivB y = EquivB (x <--> y)+ stimes = stimesPeriod2++instance Boolean b => Monoid (EquivB b) where+ mempty = EquivB true+#else+instance Boolean b => Monoid (EquivB b) where+ mappend (EquivB x) (EquivB y) = EquivB (x <--> y)+ mempty = EquivB true+#endif++ -- |Injection from 'Bool' into a boolean algebra. fromBool :: Boolean b => Bool -> b fromBool b = if b then true else false@@ -96,11 +202,11 @@ (||) = (P.||) not = P.not xor = (/=)- True --> True = True- True --> False = False- False --> _ = True+ True --> a = a+ False --> _ = True (<-->) = (==) +-- | Could be done via `deriving via` from GHC8.6.1 onwards instance Boolean Any where true = Any True false = Any False@@ -111,6 +217,7 @@ (Any p) --> (Any q) = Any (p --> q) (Any p) <--> (Any q) = Any (p <--> q) +-- | Could be done via `deriving via` from GHC8.6.1 onwards instance Boolean All where true = All True false = All False@@ -121,6 +228,7 @@ (All p) --> (All q) = All (p --> q) (All p) <--> (All q) = All (p <--> q) +-- | Could be done via `deriving via` from GHC8.6.1 onwards instance Boolean (Dual Bool) where true = Dual True false = Dual False@@ -131,9 +239,36 @@ (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)+newtype Opp a = Opp { getOpp :: a }+ deriving (Eq, Ord, Show)++-- | Opposite boolean algebra: exchanges true and false, and `and` and+-- `or`, etc+instance Boolean a => Boolean (Opp a) where+ true = Opp false+ false = Opp true+ not = Opp . not . getOpp+ (&&) = (Opp .) . (||) `on` getOpp+ (||) = (Opp .) . (&&) `on` getOpp+ xor = (Opp .) . (<-->) `on` getOpp+ (<-->) = (Opp .) . xor `on` getOpp++-- | Pointwise boolean algebra.+--+instance Boolean b => Boolean (a -> b) where+ true = const true+ false = const false+ not p = not . p+ p && q = \a -> p a && q a+ p || q = \a -> p a || q a+ p `xor` q = \a -> p a `xor` q a+ p --> q = \a -> p a --> q a+ p <--> q = \a -> p a <--> q a++-- | Could be done via `deriving via` from GHC8.6.1 onwards+instance Boolean a => Boolean (Endo a) 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)@@ -141,6 +276,16 @@ (Endo p) --> (Endo q) = Endo (\a -> p a --> q a) (Endo p) <--> (Endo q) = Endo (\a -> p a <--> q a) +-- |The trivial boolean algebra+instance Boolean () where+ true = ()+ false = ()+ not _ = ()+ _ && _ = ()+ _ || _ = ()+ _ --> _ = ()+ _ <--> _ = ()+ instance (Boolean x, Boolean y) => Boolean (x, y) where true = (true, true) false = (false, false)@@ -151,6 +296,17 @@ (a, b) --> (c, d) = (a --> c, b --> d) (a, b) <--> (c, d) = (a <--> c, b <--> d) +instance (Boolean x, Boolean y, Boolean z) => Boolean (x, y, z) where+ true = (true, true, true)+ false = (false, false, false)+ not (a, b, c) = (not a, not b, not c)+ (a, b, c) && (d, e, f) = (a && d, b && e, c && f)+ (a, b, c) || (d, e, f) = (a || d, b || e, c || f)+ (a, b, c) `xor` (d, e, f) = (a `xor` d, b `xor` e, c `xor` f)+ (a, b, c) --> (d, e, f) = (a --> d, b --> e, c --> f)+ (a, b, c) <--> (d, e, f) = (a <--> d, b <--> e, c <--> f)++ -- |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@@ -171,4 +327,4 @@ (&&) = (Bitwise .) . (.&.) `on` getBits (||) = (Bitwise .) . (.|.) `on` getBits xor = (Bitwise .) . (Bits.xor `on` getBits)- (<-->) = xor `on` not+ (<-->) = (not .) . xor