{-# LANGUAGE
      CPP,
      FlexibleInstances,
      GeneralizedNewtypeDeriving,
      DeriveDataTypeable
  #-}
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 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](https://en.wikipedia.org/wiki/Boolean_algebra_(structure)).
--
-- 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
  -- |False value, defined as the bottom of the bounded lattice.
  false   :: b
  -- |Logical negation.
  not     :: b -> b
  -- |Logical conjunction. (infixr 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

  {-# MINIMAL (false | true), (not | ((<-->), false)), ((||) | (&&)) #-}

  -- Default implementations
  true      = forall b. Boolean b => b -> b
not forall b. Boolean b => b
false
  false     = forall b. Boolean b => b -> b
not forall b. Boolean b => b
true
  not       = (forall b. Boolean b => b -> b -> b
<--> forall b. Boolean b => b
false)
  b
x && b
y    = forall b. Boolean b => b -> b
not (forall b. Boolean b => b -> b
not b
x forall b. Boolean b => b -> b -> b
|| forall b. Boolean b => b -> b
not b
y)
  b
x || b
y    = forall b. Boolean b => b -> b
not (forall b. Boolean b => b -> b
not b
x forall b. Boolean b => b -> b -> b
&& forall b. Boolean b => b -> b
not b
y)
  b
x `xor` b
y = (b
x forall b. Boolean b => b -> b -> b
|| b
y) forall b. Boolean b => b -> b -> b
&& (forall b. Boolean b => b -> b
not (b
x forall b. Boolean b => b -> b -> b
&& b
y))
  b
x --> b
y   = forall b. Boolean b => b -> b
not b
x forall b. Boolean b => b -> b -> b
|| b
y
  b
x <--> b
y  = (b
x forall b. Boolean b => b -> b -> b
&& b
y) forall b. Boolean b => b -> b -> b
|| forall b. Boolean b => b -> b
not (b
x forall b. Boolean b => b -> b -> b
|| b
y)


-- | The logical conjunction of several values.
and :: (Boolean b, F.Foldable t) => t b -> b
and :: forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
and = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall b. Boolean b => b -> b -> b
(&&) forall b. Boolean b => b
true

-- | The logical disjunction of several values.
or :: (Boolean b, F.Foldable t) => t b -> b
or :: forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
or = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall b. Boolean b => b -> b -> b
(||) forall b. Boolean b => b
false

-- | The negated logical conjunction of several values.
--
-- @'nand' = 'not' . 'and'@
nand :: (Boolean b, F.Foldable t) => t b -> b
nand :: forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
nand = forall b. Boolean b => b -> b
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
and

-- | The negated logical disjunction of several values.
--
-- @'nor' = 'not' . 'or'@
nor :: (Boolean b, F.Foldable t) => t b -> b
nor :: forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
nor = forall b. Boolean b => b -> b
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
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 :: forall b (t :: * -> *) a.
(Boolean b, Foldable t) =>
(a -> b) -> t a -> b
all a -> b
p = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' b -> a -> b
f forall b. Boolean b => b
true
  where f :: b -> a -> b
f b
a a
b = b
a forall b. Boolean b => b -> b -> b
&& a -> b
p a
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 :: forall b (t :: * -> *) a.
(Boolean b, Foldable t) =>
(a -> b) -> t a -> b
any a -> b
p     = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' b -> a -> b
f forall b. Boolean b => b
false
  where f :: b -> a -> b
f b
a a
b = b
a forall b. Boolean b => b -> b -> b
|| a -> b
p a
b


-- | A boolean algebra regarded as a monoid under disjunction
newtype AnyB b = AnyB {
  forall b. AnyB b -> b
getAnyB :: b
} deriving (AnyB b -> AnyB b -> Bool
forall b. Eq b => AnyB b -> AnyB b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnyB b -> AnyB b -> Bool
$c/= :: forall b. Eq b => AnyB b -> AnyB b -> Bool
== :: AnyB b -> AnyB b -> Bool
$c== :: forall b. Eq b => AnyB b -> AnyB b -> Bool
Eq, AnyB b -> AnyB b -> Bool
AnyB b -> AnyB b -> Ordering
AnyB b -> AnyB b -> AnyB b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {b}. Ord b => Eq (AnyB b)
forall b. Ord b => AnyB b -> AnyB b -> Bool
forall b. Ord b => AnyB b -> AnyB b -> Ordering
forall b. Ord b => AnyB b -> AnyB b -> AnyB b
min :: AnyB b -> AnyB b -> AnyB b
$cmin :: forall b. Ord b => AnyB b -> AnyB b -> AnyB b
max :: AnyB b -> AnyB b -> AnyB b
$cmax :: forall b. Ord b => AnyB b -> AnyB b -> AnyB b
>= :: AnyB b -> AnyB b -> Bool
$c>= :: forall b. Ord b => AnyB b -> AnyB b -> Bool
> :: AnyB b -> AnyB b -> Bool
$c> :: forall b. Ord b => AnyB b -> AnyB b -> Bool
<= :: AnyB b -> AnyB b -> Bool
$c<= :: forall b. Ord b => AnyB b -> AnyB b -> Bool
< :: AnyB b -> AnyB b -> Bool
$c< :: forall b. Ord b => AnyB b -> AnyB b -> Bool
compare :: AnyB b -> AnyB b -> Ordering
$ccompare :: forall b. Ord b => AnyB b -> AnyB b -> Ordering
Ord, Int -> AnyB b -> ShowS
forall b. Show b => Int -> AnyB b -> ShowS
forall b. Show b => [AnyB b] -> ShowS
forall b. Show b => AnyB b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnyB b] -> ShowS
$cshowList :: forall b. Show b => [AnyB b] -> ShowS
show :: AnyB b -> String
$cshow :: forall b. Show b => AnyB b -> String
showsPrec :: Int -> AnyB b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> AnyB b -> ShowS
Show)

#if MIN_VERSION_base(4,11,0)
instance Boolean b => Semigroup (AnyB b) where
  AnyB b
x <> :: AnyB b -> AnyB b -> AnyB b
<> AnyB b
y = forall b. b -> AnyB b
AnyB (b
x forall b. Boolean b => b -> b -> b
|| b
y)
  stimes :: forall b. Integral b => b -> AnyB b -> AnyB b
stimes = forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid

instance Boolean b => Monoid (AnyB b) where
  mempty :: AnyB b
mempty = forall b. b -> AnyB b
AnyB forall b. Boolean b => b
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 {
  forall b. AllB b -> b
getAllB :: b
} deriving (AllB b -> AllB b -> Bool
forall b. Eq b => AllB b -> AllB b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllB b -> AllB b -> Bool
$c/= :: forall b. Eq b => AllB b -> AllB b -> Bool
== :: AllB b -> AllB b -> Bool
$c== :: forall b. Eq b => AllB b -> AllB b -> Bool
Eq, AllB b -> AllB b -> Bool
AllB b -> AllB b -> Ordering
AllB b -> AllB b -> AllB b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {b}. Ord b => Eq (AllB b)
forall b. Ord b => AllB b -> AllB b -> Bool
forall b. Ord b => AllB b -> AllB b -> Ordering
forall b. Ord b => AllB b -> AllB b -> AllB b
min :: AllB b -> AllB b -> AllB b
$cmin :: forall b. Ord b => AllB b -> AllB b -> AllB b
max :: AllB b -> AllB b -> AllB b
$cmax :: forall b. Ord b => AllB b -> AllB b -> AllB b
>= :: AllB b -> AllB b -> Bool
$c>= :: forall b. Ord b => AllB b -> AllB b -> Bool
> :: AllB b -> AllB b -> Bool
$c> :: forall b. Ord b => AllB b -> AllB b -> Bool
<= :: AllB b -> AllB b -> Bool
$c<= :: forall b. Ord b => AllB b -> AllB b -> Bool
< :: AllB b -> AllB b -> Bool
$c< :: forall b. Ord b => AllB b -> AllB b -> Bool
compare :: AllB b -> AllB b -> Ordering
$ccompare :: forall b. Ord b => AllB b -> AllB b -> Ordering
Ord, Int -> AllB b -> ShowS
forall b. Show b => Int -> AllB b -> ShowS
forall b. Show b => [AllB b] -> ShowS
forall b. Show b => AllB b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllB b] -> ShowS
$cshowList :: forall b. Show b => [AllB b] -> ShowS
show :: AllB b -> String
$cshow :: forall b. Show b => AllB b -> String
showsPrec :: Int -> AllB b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> AllB b -> ShowS
Show)

#if MIN_VERSION_base(4,11,0)
instance Boolean b => Semigroup (AllB b) where
  AllB b
x <> :: AllB b -> AllB b -> AllB b
<> AllB b
y = forall b. b -> AllB b
AllB (b
x forall b. Boolean b => b -> b -> b
&& b
y)
  stimes :: forall b. Integral b => b -> AllB b -> AllB b
stimes = forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid

instance Boolean b => Monoid (AllB b) where
  mempty :: AllB b
mempty = forall b. b -> AllB b
AllB forall b. Boolean b => b
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 :: forall a n. (Monoid a, Integral n) => n -> a -> a
stimesPeriod2 n
n a
x
  | forall a. Integral a => a -> Bool
even n
n    = forall a. Monoid a => a
mempty
  | Bool
otherwise = a
x

-- | A boolean algebra regarded as a monoid under exclusive or
newtype XorB b = XorB {
  forall b. XorB b -> b
getXorB :: b
} deriving (XorB b -> XorB b -> Bool
forall b. Eq b => XorB b -> XorB b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XorB b -> XorB b -> Bool
$c/= :: forall b. Eq b => XorB b -> XorB b -> Bool
== :: XorB b -> XorB b -> Bool
$c== :: forall b. Eq b => XorB b -> XorB b -> Bool
Eq, XorB b -> XorB b -> Bool
XorB b -> XorB b -> Ordering
XorB b -> XorB b -> XorB b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {b}. Ord b => Eq (XorB b)
forall b. Ord b => XorB b -> XorB b -> Bool
forall b. Ord b => XorB b -> XorB b -> Ordering
forall b. Ord b => XorB b -> XorB b -> XorB b
min :: XorB b -> XorB b -> XorB b
$cmin :: forall b. Ord b => XorB b -> XorB b -> XorB b
max :: XorB b -> XorB b -> XorB b
$cmax :: forall b. Ord b => XorB b -> XorB b -> XorB b
>= :: XorB b -> XorB b -> Bool
$c>= :: forall b. Ord b => XorB b -> XorB b -> Bool
> :: XorB b -> XorB b -> Bool
$c> :: forall b. Ord b => XorB b -> XorB b -> Bool
<= :: XorB b -> XorB b -> Bool
$c<= :: forall b. Ord b => XorB b -> XorB b -> Bool
< :: XorB b -> XorB b -> Bool
$c< :: forall b. Ord b => XorB b -> XorB b -> Bool
compare :: XorB b -> XorB b -> Ordering
$ccompare :: forall b. Ord b => XorB b -> XorB b -> Ordering
Ord, Int -> XorB b -> ShowS
forall b. Show b => Int -> XorB b -> ShowS
forall b. Show b => [XorB b] -> ShowS
forall b. Show b => XorB b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XorB b] -> ShowS
$cshowList :: forall b. Show b => [XorB b] -> ShowS
show :: XorB b -> String
$cshow :: forall b. Show b => XorB b -> String
showsPrec :: Int -> XorB b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> XorB b -> ShowS
Show)

#if MIN_VERSION_base(4,11,0)
instance Boolean b => Semigroup (XorB b) where
  XorB b
x <> :: XorB b -> XorB b -> XorB b
<> XorB b
y = forall b. b -> XorB b
XorB (b
x forall b. Boolean b => b -> b -> b
`xor` b
y)
  stimes :: forall b. Integral b => b -> XorB b -> XorB b
stimes = forall a n. (Monoid a, Integral n) => n -> a -> a
stimesPeriod2

instance Boolean b => Monoid (XorB b) where
  mempty :: XorB b
mempty = forall b. b -> XorB b
XorB forall b. Boolean b => b
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 {
  forall b. EquivB b -> b
getEquivB :: b
}  deriving (EquivB b -> EquivB b -> Bool
forall b. Eq b => EquivB b -> EquivB b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EquivB b -> EquivB b -> Bool
$c/= :: forall b. Eq b => EquivB b -> EquivB b -> Bool
== :: EquivB b -> EquivB b -> Bool
$c== :: forall b. Eq b => EquivB b -> EquivB b -> Bool
Eq, EquivB b -> EquivB b -> Bool
EquivB b -> EquivB b -> Ordering
EquivB b -> EquivB b -> EquivB b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {b}. Ord b => Eq (EquivB b)
forall b. Ord b => EquivB b -> EquivB b -> Bool
forall b. Ord b => EquivB b -> EquivB b -> Ordering
forall b. Ord b => EquivB b -> EquivB b -> EquivB b
min :: EquivB b -> EquivB b -> EquivB b
$cmin :: forall b. Ord b => EquivB b -> EquivB b -> EquivB b
max :: EquivB b -> EquivB b -> EquivB b
$cmax :: forall b. Ord b => EquivB b -> EquivB b -> EquivB b
>= :: EquivB b -> EquivB b -> Bool
$c>= :: forall b. Ord b => EquivB b -> EquivB b -> Bool
> :: EquivB b -> EquivB b -> Bool
$c> :: forall b. Ord b => EquivB b -> EquivB b -> Bool
<= :: EquivB b -> EquivB b -> Bool
$c<= :: forall b. Ord b => EquivB b -> EquivB b -> Bool
< :: EquivB b -> EquivB b -> Bool
$c< :: forall b. Ord b => EquivB b -> EquivB b -> Bool
compare :: EquivB b -> EquivB b -> Ordering
$ccompare :: forall b. Ord b => EquivB b -> EquivB b -> Ordering
Ord, Int -> EquivB b -> ShowS
forall b. Show b => Int -> EquivB b -> ShowS
forall b. Show b => [EquivB b] -> ShowS
forall b. Show b => EquivB b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EquivB b] -> ShowS
$cshowList :: forall b. Show b => [EquivB b] -> ShowS
show :: EquivB b -> String
$cshow :: forall b. Show b => EquivB b -> String
showsPrec :: Int -> EquivB b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> EquivB b -> ShowS
Show)

#if MIN_VERSION_base(4,11,0)
instance Boolean b => Semigroup (EquivB b) where
  EquivB b
x <> :: EquivB b -> EquivB b -> EquivB b
<> EquivB b
y = forall b. b -> EquivB b
EquivB (b
x forall b. Boolean b => b -> b -> b
<--> b
y)
  stimes :: forall b. Integral b => b -> EquivB b -> EquivB b
stimes = forall a n. (Monoid a, Integral n) => n -> a -> a
stimesPeriod2

instance Boolean b => Monoid (EquivB b) where
  mempty :: EquivB b
mempty = forall b. b -> EquivB b
EquivB forall b. Boolean b => b
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 :: forall b. Boolean b => Bool -> b
fromBool Bool
b = if Bool
b then forall b. Boolean b => b
true else forall b. Boolean b => b
false

instance Boolean Bool where
  true :: Bool
true = Bool
True
  false :: Bool
false = Bool
False
  && :: Bool -> Bool -> Bool
(&&) = Bool -> Bool -> Bool
(P.&&)
  || :: Bool -> Bool -> Bool
(||) = Bool -> Bool -> Bool
(P.||)
  not :: Bool -> Bool
not = Bool -> Bool
P.not
  xor :: Bool -> Bool -> Bool
xor = forall a. Eq a => a -> a -> Bool
(/=)
  Bool
True  --> :: Bool -> Bool -> Bool
--> Bool
a = Bool
a
  Bool
False --> Bool
_ = Bool
True
  <--> :: Bool -> Bool -> Bool
(<-->) = forall a. Eq a => a -> a -> Bool
(==)

-- | Could be done via `deriving via` from GHC8.6.1 onwards
instance Boolean Any where
  true :: Any
true                  = Bool -> Any
Any Bool
True
  false :: Any
false                 = Bool -> Any
Any Bool
False
  not :: Any -> Any
not (Any Bool
p)           = Bool -> Any
Any (forall b. Boolean b => b -> b
not Bool
p)
  (Any Bool
p) && :: Any -> Any -> Any
&&    (Any Bool
q) = Bool -> Any
Any (Bool
p forall b. Boolean b => b -> b -> b
&& Bool
q)
  (Any Bool
p) || :: Any -> Any -> Any
||    (Any Bool
q) = Bool -> Any
Any (Bool
p forall b. Boolean b => b -> b -> b
|| Bool
q)
  (Any Bool
p) xor :: Any -> Any -> Any
`xor` (Any Bool
q) = Bool -> Any
Any (Bool
p forall b. Boolean b => b -> b -> b
`xor` Bool
q)
  (Any Bool
p) --> :: Any -> Any -> Any
--> (Any Bool
q)   = Bool -> Any
Any (Bool
p forall b. Boolean b => b -> b -> b
--> Bool
q)
  (Any Bool
p) <--> :: Any -> Any -> Any
<--> (Any Bool
q)  = Bool -> Any
Any (Bool
p forall b. Boolean b => b -> b -> b
<--> Bool
q)

-- | Could be done via `deriving via` from GHC8.6.1 onwards
instance Boolean All where
  true :: All
true                  = Bool -> All
All Bool
True
  false :: All
false                 = Bool -> All
All Bool
False
  not :: All -> All
not (All Bool
p)           = Bool -> All
All (forall b. Boolean b => b -> b
not Bool
p)
  (All Bool
p) && :: All -> All -> All
&& (All Bool
q)    = Bool -> All
All (Bool
p forall b. Boolean b => b -> b -> b
&& Bool
q)
  (All Bool
p) || :: All -> All -> All
|| (All Bool
q)    = Bool -> All
All (Bool
p forall b. Boolean b => b -> b -> b
|| Bool
q)
  (All Bool
p) xor :: All -> All -> All
`xor` (All Bool
q) = Bool -> All
All (Bool
p forall b. Boolean b => b -> b -> b
`xor` Bool
q)
  (All Bool
p) --> :: All -> All -> All
--> (All Bool
q)   = Bool -> All
All (Bool
p forall b. Boolean b => b -> b -> b
--> Bool
q)
  (All Bool
p) <--> :: All -> All -> All
<--> (All Bool
q)  = Bool -> All
All (Bool
p forall b. Boolean b => b -> b -> b
<--> Bool
q)

-- | Could be done via `deriving via` from GHC8.6.1 onwards
instance Boolean (Dual Bool) where
  true :: Dual Bool
true                    = forall a. a -> Dual a
Dual Bool
True
  false :: Dual Bool
false                   = forall a. a -> Dual a
Dual Bool
False
  not :: Dual Bool -> Dual Bool
not (Dual Bool
p)            = forall a. a -> Dual a
Dual (forall b. Boolean b => b -> b
not Bool
p)
  (Dual Bool
p) && :: Dual Bool -> Dual Bool -> Dual Bool
&& (Dual Bool
q)    = forall a. a -> Dual a
Dual (Bool
p forall b. Boolean b => b -> b -> b
&& Bool
q)
  (Dual Bool
p) || :: Dual Bool -> Dual Bool -> Dual Bool
|| (Dual Bool
q)    = forall a. a -> Dual a
Dual (Bool
p forall b. Boolean b => b -> b -> b
|| Bool
q)
  (Dual Bool
p) xor :: Dual Bool -> Dual Bool -> Dual Bool
`xor` (Dual Bool
q) = forall a. a -> Dual a
Dual (Bool
p forall b. Boolean b => b -> b -> b
`xor` Bool
q)
  (Dual Bool
p) --> :: Dual Bool -> Dual Bool -> Dual Bool
--> (Dual Bool
q)   = forall a. a -> Dual a
Dual (Bool
p forall b. Boolean b => b -> b -> b
--> Bool
q)
  (Dual Bool
p) <--> :: Dual Bool -> Dual Bool -> Dual Bool
<--> (Dual Bool
q)  = forall a. a -> Dual a
Dual (Bool
p forall b. Boolean b => b -> b -> b
<--> Bool
q)

newtype Opp a = Opp { forall a. Opp a -> a
getOpp :: a }
  deriving (Opp a -> Opp a -> Bool
forall a. Eq a => Opp a -> Opp a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Opp a -> Opp a -> Bool
$c/= :: forall a. Eq a => Opp a -> Opp a -> Bool
== :: Opp a -> Opp a -> Bool
$c== :: forall a. Eq a => Opp a -> Opp a -> Bool
Eq, Opp a -> Opp a -> Bool
Opp a -> Opp a -> Ordering
Opp a -> Opp a -> Opp a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Opp a)
forall a. Ord a => Opp a -> Opp a -> Bool
forall a. Ord a => Opp a -> Opp a -> Ordering
forall a. Ord a => Opp a -> Opp a -> Opp a
min :: Opp a -> Opp a -> Opp a
$cmin :: forall a. Ord a => Opp a -> Opp a -> Opp a
max :: Opp a -> Opp a -> Opp a
$cmax :: forall a. Ord a => Opp a -> Opp a -> Opp a
>= :: Opp a -> Opp a -> Bool
$c>= :: forall a. Ord a => Opp a -> Opp a -> Bool
> :: Opp a -> Opp a -> Bool
$c> :: forall a. Ord a => Opp a -> Opp a -> Bool
<= :: Opp a -> Opp a -> Bool
$c<= :: forall a. Ord a => Opp a -> Opp a -> Bool
< :: Opp a -> Opp a -> Bool
$c< :: forall a. Ord a => Opp a -> Opp a -> Bool
compare :: Opp a -> Opp a -> Ordering
$ccompare :: forall a. Ord a => Opp a -> Opp a -> Ordering
Ord, Int -> Opp a -> ShowS
forall a. Show a => Int -> Opp a -> ShowS
forall a. Show a => [Opp a] -> ShowS
forall a. Show a => Opp a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Opp a] -> ShowS
$cshowList :: forall a. Show a => [Opp a] -> ShowS
show :: Opp a -> String
$cshow :: forall a. Show a => Opp a -> String
showsPrec :: Int -> Opp a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Opp a -> ShowS
Show)

-- | Opposite boolean algebra: exchanges true and false, and `and` and
-- `or`, etc
instance Boolean a => Boolean (Opp a) where
  true :: Opp a
true = forall a. a -> Opp a
Opp forall b. Boolean b => b
false
  false :: Opp a
false = forall a. a -> Opp a
Opp forall b. Boolean b => b
true
  not :: Opp a -> Opp a
not = forall a. a -> Opp a
Opp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Boolean b => b -> b
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Opp a -> a
getOpp
  && :: Opp a -> Opp a -> Opp a
(&&) = (forall a. a -> Opp a
Opp forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Boolean b => b -> b -> b
(||) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Opp a -> a
getOpp
  || :: Opp a -> Opp a -> Opp a
(||) = (forall a. a -> Opp a
Opp forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Boolean b => b -> b -> b
(&&) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Opp a -> a
getOpp
  xor :: Opp a -> Opp a -> Opp a
xor = (forall a. a -> Opp a
Opp forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Boolean b => b -> b -> b
(<-->) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Opp a -> a
getOpp
  <--> :: Opp a -> Opp a -> Opp a
(<-->) = (forall a. a -> Opp a
Opp forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Boolean b => b -> b -> b
xor forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Opp a -> a
getOpp

-- | Pointwise boolean algebra.
--
instance Boolean b => Boolean (a -> b) where
  true :: a -> b
true      = forall a b. a -> b -> a
const forall b. Boolean b => b
true
  false :: a -> b
false     = forall a b. a -> b -> a
const forall b. Boolean b => b
false
  not :: (a -> b) -> a -> b
not a -> b
p     = forall b. Boolean b => b -> b
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
p
  a -> b
p && :: (a -> b) -> (a -> b) -> a -> b
&& a -> b
q    = \a
a -> a -> b
p a
a forall b. Boolean b => b -> b -> b
&& a -> b
q a
a
  a -> b
p || :: (a -> b) -> (a -> b) -> a -> b
|| a -> b
q    = \a
a -> a -> b
p a
a forall b. Boolean b => b -> b -> b
|| a -> b
q a
a
  a -> b
p xor :: (a -> b) -> (a -> b) -> a -> b
`xor` a -> b
q = \a
a -> a -> b
p a
a forall b. Boolean b => b -> b -> b
`xor` a -> b
q a
a
  a -> b
p --> :: (a -> b) -> (a -> b) -> a -> b
--> a -> b
q   = \a
a -> a -> b
p a
a forall b. Boolean b => b -> b -> b
--> a -> b
q a
a
  a -> b
p <--> :: (a -> b) -> (a -> b) -> a -> b
<--> a -> b
q  = \a
a -> a -> b
p a
a forall b. Boolean b => b -> b -> b
<--> a -> b
q a
a

-- | Could be done via `deriving via` from GHC8.6.1 onwards
instance Boolean a => Boolean (Endo a) where
  true :: Endo a
true                    = forall a. (a -> a) -> Endo a
Endo (forall a b. a -> b -> a
const forall b. Boolean b => b
true)
  false :: Endo a
false                   = forall a. (a -> a) -> Endo a
Endo (forall a b. a -> b -> a
const forall b. Boolean b => b
false)
  not :: Endo a -> Endo a
not (Endo a -> a
p)            = forall a. (a -> a) -> Endo a
Endo (forall b. Boolean b => b -> b
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p)
  (Endo a -> a
p) && :: Endo a -> Endo a -> Endo a
&& (Endo a -> a
q)    = forall a. (a -> a) -> Endo a
Endo (\a
a -> a -> a
p a
a forall b. Boolean b => b -> b -> b
&& a -> a
q a
a)
  (Endo a -> a
p) || :: Endo a -> Endo a -> Endo a
|| (Endo a -> a
q)    = forall a. (a -> a) -> Endo a
Endo (\a
a -> a -> a
p a
a forall b. Boolean b => b -> b -> b
|| a -> a
q a
a)
  (Endo a -> a
p) xor :: Endo a -> Endo a -> Endo a
`xor` (Endo a -> a
q) = forall a. (a -> a) -> Endo a
Endo (\a
a -> a -> a
p a
a forall b. Boolean b => b -> b -> b
`xor` a -> a
q a
a)
  (Endo a -> a
p) --> :: Endo a -> Endo a -> Endo a
--> (Endo a -> a
q)   = forall a. (a -> a) -> Endo a
Endo (\a
a -> a -> a
p a
a forall b. Boolean b => b -> b -> b
--> a -> a
q a
a)
  (Endo a -> a
p) <--> :: Endo a -> Endo a -> Endo a
<--> (Endo a -> a
q)  = forall a. (a -> a) -> Endo a
Endo (\a
a -> a -> a
p a
a forall b. Boolean b => b -> b -> b
<--> a -> a
q a
a)

-- |The trivial boolean algebra
instance Boolean () where
  true :: ()
true = ()
  false :: ()
false = ()
  not :: () -> ()
not ()
_ = ()
  ()
_ && :: () -> () -> ()
&& ()
_ = ()
  ()
_ || :: () -> () -> ()
|| ()
_ = ()
  ()
_ --> :: () -> () -> ()
--> ()
_ = ()
  ()
_ <--> :: () -> () -> ()
<--> ()
_ = ()

instance (Boolean x, Boolean y) => Boolean (x, y) where
  true :: (x, y)
true                = (forall b. Boolean b => b
true, forall b. Boolean b => b
true)
  false :: (x, y)
false               = (forall b. Boolean b => b
false, forall b. Boolean b => b
false)
  not :: (x, y) -> (x, y)
not (x
a, y
b)          = (forall b. Boolean b => b -> b
not x
a, forall b. Boolean b => b -> b
not y
b)
  (x
a, y
b) && :: (x, y) -> (x, y) -> (x, y)
&& (x
c, y
d)    = (x
a forall b. Boolean b => b -> b -> b
&& x
c, y
b forall b. Boolean b => b -> b -> b
&& y
d)
  (x
a, y
b) || :: (x, y) -> (x, y) -> (x, y)
|| (x
c, y
d)    = (x
a forall b. Boolean b => b -> b -> b
|| x
c, y
b forall b. Boolean b => b -> b -> b
|| y
d)
  (x
a, y
b) xor :: (x, y) -> (x, y) -> (x, y)
`xor` (x
c, y
d) = (x
a forall b. Boolean b => b -> b -> b
`xor` x
c, y
b forall b. Boolean b => b -> b -> b
`xor` y
d)
  (x
a, y
b) --> :: (x, y) -> (x, y) -> (x, y)
--> (x
c, y
d)   = (x
a forall b. Boolean b => b -> b -> b
--> x
c, y
b forall b. Boolean b => b -> b -> b
--> y
d)
  (x
a, y
b) <--> :: (x, y) -> (x, y) -> (x, y)
<--> (x
c, y
d)  = (x
a forall b. Boolean b => b -> b -> b
<--> x
c, y
b forall b. Boolean b => b -> b -> b
<--> y
d)

instance (Boolean x, Boolean y, Boolean z) => Boolean (x, y, z) where
  true :: (x, y, z)
true                      = (forall b. Boolean b => b
true, forall b. Boolean b => b
true, forall b. Boolean b => b
true)
  false :: (x, y, z)
false                     = (forall b. Boolean b => b
false, forall b. Boolean b => b
false, forall b. Boolean b => b
false)
  not :: (x, y, z) -> (x, y, z)
not (x
a, y
b, z
c)             = (forall b. Boolean b => b -> b
not x
a, forall b. Boolean b => b -> b
not y
b, forall b. Boolean b => b -> b
not z
c)
  (x
a, y
b, z
c) && :: (x, y, z) -> (x, y, z) -> (x, y, z)
&& (x
d, y
e, z
f)    = (x
a forall b. Boolean b => b -> b -> b
&& x
d, y
b forall b. Boolean b => b -> b -> b
&& y
e, z
c forall b. Boolean b => b -> b -> b
&& z
f)
  (x
a, y
b, z
c) || :: (x, y, z) -> (x, y, z) -> (x, y, z)
|| (x
d, y
e, z
f)    = (x
a forall b. Boolean b => b -> b -> b
|| x
d, y
b forall b. Boolean b => b -> b -> b
|| y
e, z
c forall b. Boolean b => b -> b -> b
|| z
f)
  (x
a, y
b, z
c) xor :: (x, y, z) -> (x, y, z) -> (x, y, z)
`xor` (x
d, y
e, z
f) = (x
a forall b. Boolean b => b -> b -> b
`xor` x
d, y
b forall b. Boolean b => b -> b -> b
`xor` y
e, z
c forall b. Boolean b => b -> b -> b
`xor` z
f)
  (x
a, y
b, z
c) --> :: (x, y, z) -> (x, y, z) -> (x, y, z)
--> (x
d, y
e, z
f)   = (x
a forall b. Boolean b => b -> b -> b
--> x
d, y
b forall b. Boolean b => b -> b -> b
--> y
e, z
c forall b. Boolean b => b -> b -> b
--> z
f)
  (x
a, y
b, z
c) <--> :: (x, y, z) -> (x, y, z) -> (x, y, z)
<--> (x
d, y
e, z
f)  = (x
a forall b. Boolean b => b -> b -> b
<--> x
d, y
b forall b. Boolean b => b -> b -> b
<--> y
e, z
c forall b. Boolean b => b -> b -> b
<--> z
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
-- 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 {forall a. Bitwise a -> a
getBits :: a}
                  deriving (Integer -> Bitwise a
Bitwise a -> Bitwise a
Bitwise a -> Bitwise a -> Bitwise a
forall a. Num a => Integer -> Bitwise a
forall a. Num a => Bitwise a -> Bitwise a
forall a. Num a => Bitwise a -> Bitwise a -> Bitwise a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Bitwise a
$cfromInteger :: forall a. Num a => Integer -> Bitwise a
signum :: Bitwise a -> Bitwise a
$csignum :: forall a. Num a => Bitwise a -> Bitwise a
abs :: Bitwise a -> Bitwise a
$cabs :: forall a. Num a => Bitwise a -> Bitwise a
negate :: Bitwise a -> Bitwise a
$cnegate :: forall a. Num a => Bitwise a -> Bitwise a
* :: Bitwise a -> Bitwise a -> Bitwise a
$c* :: forall a. Num a => Bitwise a -> Bitwise a -> Bitwise a
- :: Bitwise a -> Bitwise a -> Bitwise a
$c- :: forall a. Num a => Bitwise a -> Bitwise a -> Bitwise a
+ :: Bitwise a -> Bitwise a -> Bitwise a
$c+ :: forall a. Num a => Bitwise a -> Bitwise a -> Bitwise a
Num, Bitwise a
Int -> Bitwise a
Bitwise a -> Bool
Bitwise a -> Int
Bitwise a -> Maybe Int
Bitwise a -> Bitwise a
Bitwise a -> Int -> Bool
Bitwise a -> Int -> Bitwise a
Bitwise a -> Bitwise a -> Bitwise a
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
forall {a}. Bits a => Eq (Bitwise a)
forall a. Bits a => Bitwise a
forall a. Bits a => Int -> Bitwise a
forall a. Bits a => Bitwise a -> Bool
forall a. Bits a => Bitwise a -> Int
forall a. Bits a => Bitwise a -> Maybe Int
forall a. Bits a => Bitwise a -> Bitwise a
forall a. Bits a => Bitwise a -> Int -> Bool
forall a. Bits a => Bitwise a -> Int -> Bitwise a
forall a. Bits a => Bitwise a -> Bitwise a -> Bitwise a
popCount :: Bitwise a -> Int
$cpopCount :: forall a. Bits a => Bitwise a -> Int
rotateR :: Bitwise a -> Int -> Bitwise a
$crotateR :: forall a. Bits a => Bitwise a -> Int -> Bitwise a
rotateL :: Bitwise a -> Int -> Bitwise a
$crotateL :: forall a. Bits a => Bitwise a -> Int -> Bitwise a
unsafeShiftR :: Bitwise a -> Int -> Bitwise a
$cunsafeShiftR :: forall a. Bits a => Bitwise a -> Int -> Bitwise a
shiftR :: Bitwise a -> Int -> Bitwise a
$cshiftR :: forall a. Bits a => Bitwise a -> Int -> Bitwise a
unsafeShiftL :: Bitwise a -> Int -> Bitwise a
$cunsafeShiftL :: forall a. Bits a => Bitwise a -> Int -> Bitwise a
shiftL :: Bitwise a -> Int -> Bitwise a
$cshiftL :: forall a. Bits a => Bitwise a -> Int -> Bitwise a
isSigned :: Bitwise a -> Bool
$cisSigned :: forall a. Bits a => Bitwise a -> Bool
bitSize :: Bitwise a -> Int
$cbitSize :: forall a. Bits a => Bitwise a -> Int
bitSizeMaybe :: Bitwise a -> Maybe Int
$cbitSizeMaybe :: forall a. Bits a => Bitwise a -> Maybe Int
testBit :: Bitwise a -> Int -> Bool
$ctestBit :: forall a. Bits a => Bitwise a -> Int -> Bool
complementBit :: Bitwise a -> Int -> Bitwise a
$ccomplementBit :: forall a. Bits a => Bitwise a -> Int -> Bitwise a
clearBit :: Bitwise a -> Int -> Bitwise a
$cclearBit :: forall a. Bits a => Bitwise a -> Int -> Bitwise a
setBit :: Bitwise a -> Int -> Bitwise a
$csetBit :: forall a. Bits a => Bitwise a -> Int -> Bitwise a
bit :: Int -> Bitwise a
$cbit :: forall a. Bits a => Int -> Bitwise a
zeroBits :: Bitwise a
$czeroBits :: forall a. Bits a => Bitwise a
rotate :: Bitwise a -> Int -> Bitwise a
$crotate :: forall a. Bits a => Bitwise a -> Int -> Bitwise a
shift :: Bitwise a -> Int -> Bitwise a
$cshift :: forall a. Bits a => Bitwise a -> Int -> Bitwise a
complement :: Bitwise a -> Bitwise a
$ccomplement :: forall a. Bits a => Bitwise a -> Bitwise a
xor :: Bitwise a -> Bitwise a -> Bitwise a
$cxor :: forall a. Bits a => Bitwise a -> Bitwise a -> Bitwise a
.|. :: Bitwise a -> Bitwise a -> Bitwise a
$c.|. :: forall a. Bits a => Bitwise a -> Bitwise a -> Bitwise a
.&. :: Bitwise a -> Bitwise a -> Bitwise a
$c.&. :: forall a. Bits a => Bitwise a -> Bitwise a -> Bitwise a
Bits, Bitwise a -> Bitwise a -> Bool
forall a. Eq a => Bitwise a -> Bitwise a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bitwise a -> Bitwise a -> Bool
$c/= :: forall a. Eq a => Bitwise a -> Bitwise a -> Bool
== :: Bitwise a -> Bitwise a -> Bool
$c== :: forall a. Eq a => Bitwise a -> Bitwise a -> Bool
Eq, Bitwise a -> Bitwise a -> Bool
Bitwise a -> Bitwise a -> Ordering
Bitwise a -> Bitwise a -> Bitwise a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Bitwise a)
forall a. Ord a => Bitwise a -> Bitwise a -> Bool
forall a. Ord a => Bitwise a -> Bitwise a -> Ordering
forall a. Ord a => Bitwise a -> Bitwise a -> Bitwise a
min :: Bitwise a -> Bitwise a -> Bitwise a
$cmin :: forall a. Ord a => Bitwise a -> Bitwise a -> Bitwise a
max :: Bitwise a -> Bitwise a -> Bitwise a
$cmax :: forall a. Ord a => Bitwise a -> Bitwise a -> Bitwise a
>= :: Bitwise a -> Bitwise a -> Bool
$c>= :: forall a. Ord a => Bitwise a -> Bitwise a -> Bool
> :: Bitwise a -> Bitwise a -> Bool
$c> :: forall a. Ord a => Bitwise a -> Bitwise a -> Bool
<= :: Bitwise a -> Bitwise a -> Bool
$c<= :: forall a. Ord a => Bitwise a -> Bitwise a -> Bool
< :: Bitwise a -> Bitwise a -> Bool
$c< :: forall a. Ord a => Bitwise a -> Bitwise a -> Bool
compare :: Bitwise a -> Bitwise a -> Ordering
$ccompare :: forall a. Ord a => Bitwise a -> Bitwise a -> Ordering
Ord, Bitwise a
forall a. a -> a -> Bounded a
forall a. Bounded a => Bitwise a
maxBound :: Bitwise a
$cmaxBound :: forall a. Bounded a => Bitwise a
minBound :: Bitwise a
$cminBound :: forall a. Bounded a => Bitwise a
Bounded, Int -> Bitwise a
Bitwise a -> Int
Bitwise a -> [Bitwise a]
Bitwise a -> Bitwise a
Bitwise a -> Bitwise a -> [Bitwise a]
Bitwise a -> Bitwise a -> Bitwise a -> [Bitwise a]
forall a. Enum a => Int -> Bitwise a
forall a. Enum a => Bitwise a -> Int
forall a. Enum a => Bitwise a -> [Bitwise a]
forall a. Enum a => Bitwise a -> Bitwise a
forall a. Enum a => Bitwise a -> Bitwise a -> [Bitwise a]
forall a.
Enum a =>
Bitwise a -> Bitwise a -> Bitwise a -> [Bitwise a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Bitwise a -> Bitwise a -> Bitwise a -> [Bitwise a]
$cenumFromThenTo :: forall a.
Enum a =>
Bitwise a -> Bitwise a -> Bitwise a -> [Bitwise a]
enumFromTo :: Bitwise a -> Bitwise a -> [Bitwise a]
$cenumFromTo :: forall a. Enum a => Bitwise a -> Bitwise a -> [Bitwise a]
enumFromThen :: Bitwise a -> Bitwise a -> [Bitwise a]
$cenumFromThen :: forall a. Enum a => Bitwise a -> Bitwise a -> [Bitwise a]
enumFrom :: Bitwise a -> [Bitwise a]
$cenumFrom :: forall a. Enum a => Bitwise a -> [Bitwise a]
fromEnum :: Bitwise a -> Int
$cfromEnum :: forall a. Enum a => Bitwise a -> Int
toEnum :: Int -> Bitwise a
$ctoEnum :: forall a. Enum a => Int -> Bitwise a
pred :: Bitwise a -> Bitwise a
$cpred :: forall a. Enum a => Bitwise a -> Bitwise a
succ :: Bitwise a -> Bitwise a
$csucc :: forall a. Enum a => Bitwise a -> Bitwise a
Enum, Int -> Bitwise a -> ShowS
forall a. Show a => Int -> Bitwise a -> ShowS
forall a. Show a => [Bitwise a] -> ShowS
forall a. Show a => Bitwise a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bitwise a] -> ShowS
$cshowList :: forall a. Show a => [Bitwise a] -> ShowS
show :: Bitwise a -> String
$cshow :: forall a. Show a => Bitwise a -> String
showsPrec :: Int -> Bitwise a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Bitwise a -> ShowS
Show, ReadPrec [Bitwise a]
ReadPrec (Bitwise a)
ReadS [Bitwise a]
forall a. Read a => ReadPrec [Bitwise a]
forall a. Read a => ReadPrec (Bitwise a)
forall a. Read a => Int -> ReadS (Bitwise a)
forall a. Read a => ReadS [Bitwise a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Bitwise a]
$creadListPrec :: forall a. Read a => ReadPrec [Bitwise a]
readPrec :: ReadPrec (Bitwise a)
$creadPrec :: forall a. Read a => ReadPrec (Bitwise a)
readList :: ReadS [Bitwise a]
$creadList :: forall a. Read a => ReadS [Bitwise a]
readsPrec :: Int -> ReadS (Bitwise a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Bitwise a)
Read, Bitwise a -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall {a}. Real a => Num (Bitwise a)
forall {a}. Real a => Ord (Bitwise a)
forall a. Real a => Bitwise a -> Rational
toRational :: Bitwise a -> Rational
$ctoRational :: forall a. Real a => Bitwise a -> Rational
Real,
                            Bitwise a -> Integer
Bitwise a -> Bitwise a -> (Bitwise a, Bitwise a)
Bitwise a -> Bitwise a -> Bitwise a
forall {a}. Integral a => Enum (Bitwise a)
forall {a}. Integral a => Real (Bitwise a)
forall a. Integral a => Bitwise a -> Integer
forall a.
Integral a =>
Bitwise a -> Bitwise a -> (Bitwise a, Bitwise a)
forall a. Integral a => Bitwise a -> Bitwise a -> Bitwise a
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Bitwise a -> Integer
$ctoInteger :: forall a. Integral a => Bitwise a -> Integer
divMod :: Bitwise a -> Bitwise a -> (Bitwise a, Bitwise a)
$cdivMod :: forall a.
Integral a =>
Bitwise a -> Bitwise a -> (Bitwise a, Bitwise a)
quotRem :: Bitwise a -> Bitwise a -> (Bitwise a, Bitwise a)
$cquotRem :: forall a.
Integral a =>
Bitwise a -> Bitwise a -> (Bitwise a, Bitwise a)
mod :: Bitwise a -> Bitwise a -> Bitwise a
$cmod :: forall a. Integral a => Bitwise a -> Bitwise a -> Bitwise a
div :: Bitwise a -> Bitwise a -> Bitwise a
$cdiv :: forall a. Integral a => Bitwise a -> Bitwise a -> Bitwise a
rem :: Bitwise a -> Bitwise a -> Bitwise a
$crem :: forall a. Integral a => Bitwise a -> Bitwise a -> Bitwise a
quot :: Bitwise a -> Bitwise a -> Bitwise a
$cquot :: forall a. Integral a => Bitwise a -> Bitwise a -> Bitwise a
Integral, Typeable, Bitwise a -> DataType
Bitwise a -> Constr
forall {a}. Data a => Typeable (Bitwise a)
forall a. Data a => Bitwise a -> DataType
forall a. Data a => Bitwise a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Bitwise a -> Bitwise a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Bitwise a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Bitwise a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bitwise a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bitwise a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Bitwise a -> m (Bitwise a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Bitwise a -> m (Bitwise a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bitwise a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bitwise a -> c (Bitwise a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Bitwise a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Bitwise a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bitwise a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bitwise a -> c (Bitwise a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Bitwise a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bitwise a -> m (Bitwise a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Bitwise a -> m (Bitwise a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bitwise a -> m (Bitwise a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Bitwise a -> m (Bitwise a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bitwise a -> m (Bitwise a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Bitwise a -> m (Bitwise a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bitwise a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Bitwise a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Bitwise a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Bitwise a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bitwise a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bitwise a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bitwise a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bitwise a -> r
gmapT :: (forall b. Data b => b -> b) -> Bitwise a -> Bitwise a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Bitwise a -> Bitwise a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Bitwise a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Bitwise a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Bitwise a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Bitwise a))
dataTypeOf :: Bitwise a -> DataType
$cdataTypeOf :: forall a. Data a => Bitwise a -> DataType
toConstr :: Bitwise a -> Constr
$ctoConstr :: forall a. Data a => Bitwise a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bitwise a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bitwise a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bitwise a -> c (Bitwise a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bitwise a -> c (Bitwise a)
Data, (Bitwise a, Bitwise a) -> Int
(Bitwise a, Bitwise a) -> [Bitwise a]
(Bitwise a, Bitwise a) -> Bitwise a -> Bool
(Bitwise a, Bitwise a) -> Bitwise a -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
forall {a}. Ix a => Ord (Bitwise a)
forall a. Ix a => (Bitwise a, Bitwise a) -> Int
forall a. Ix a => (Bitwise a, Bitwise a) -> [Bitwise a]
forall a. Ix a => (Bitwise a, Bitwise a) -> Bitwise a -> Bool
forall a. Ix a => (Bitwise a, Bitwise a) -> Bitwise a -> Int
unsafeRangeSize :: (Bitwise a, Bitwise a) -> Int
$cunsafeRangeSize :: forall a. Ix a => (Bitwise a, Bitwise a) -> Int
rangeSize :: (Bitwise a, Bitwise a) -> Int
$crangeSize :: forall a. Ix a => (Bitwise a, Bitwise a) -> Int
inRange :: (Bitwise a, Bitwise a) -> Bitwise a -> Bool
$cinRange :: forall a. Ix a => (Bitwise a, Bitwise a) -> Bitwise a -> Bool
unsafeIndex :: (Bitwise a, Bitwise a) -> Bitwise a -> Int
$cunsafeIndex :: forall a. Ix a => (Bitwise a, Bitwise a) -> Bitwise a -> Int
index :: (Bitwise a, Bitwise a) -> Bitwise a -> Int
$cindex :: forall a. Ix a => (Bitwise a, Bitwise a) -> Bitwise a -> Int
range :: (Bitwise a, Bitwise a) -> [Bitwise a]
$crange :: forall a. Ix a => (Bitwise a, Bitwise a) -> [Bitwise a]
Ix, Ptr (Bitwise a) -> IO (Bitwise a)
Ptr (Bitwise a) -> Int -> IO (Bitwise a)
Ptr (Bitwise a) -> Int -> Bitwise a -> IO ()
Ptr (Bitwise a) -> Bitwise a -> IO ()
Bitwise a -> Int
forall b. Ptr b -> Int -> IO (Bitwise a)
forall b. Ptr b -> Int -> Bitwise a -> IO ()
forall a. Storable a => Ptr (Bitwise a) -> IO (Bitwise a)
forall a. Storable a => Ptr (Bitwise a) -> Int -> IO (Bitwise a)
forall a.
Storable a =>
Ptr (Bitwise a) -> Int -> Bitwise a -> IO ()
forall a. Storable a => Ptr (Bitwise a) -> Bitwise a -> IO ()
forall a. Storable a => Bitwise a -> Int
forall a b. Storable a => Ptr b -> Int -> IO (Bitwise a)
forall a b. Storable a => Ptr b -> Int -> Bitwise a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (Bitwise a) -> Bitwise a -> IO ()
$cpoke :: forall a. Storable a => Ptr (Bitwise a) -> Bitwise a -> IO ()
peek :: Ptr (Bitwise a) -> IO (Bitwise a)
$cpeek :: forall a. Storable a => Ptr (Bitwise a) -> IO (Bitwise a)
pokeByteOff :: forall b. Ptr b -> Int -> Bitwise a -> IO ()
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> Bitwise a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (Bitwise a)
$cpeekByteOff :: forall a b. Storable a => Ptr b -> Int -> IO (Bitwise a)
pokeElemOff :: Ptr (Bitwise a) -> Int -> Bitwise a -> IO ()
$cpokeElemOff :: forall a.
Storable a =>
Ptr (Bitwise a) -> Int -> Bitwise a -> IO ()
peekElemOff :: Ptr (Bitwise a) -> Int -> IO (Bitwise a)
$cpeekElemOff :: forall a. Storable a => Ptr (Bitwise a) -> Int -> IO (Bitwise a)
alignment :: Bitwise a -> Int
$calignment :: forall a. Storable a => Bitwise a -> Int
sizeOf :: Bitwise a -> Int
$csizeOf :: forall a. Storable a => Bitwise a -> Int
Storable, Bitwise a -> ModifierParser
Bitwise a -> FieldFormatter
forall a. PrintfArg a => Bitwise a -> ModifierParser
forall a. PrintfArg a => Bitwise a -> FieldFormatter
forall a.
(a -> FieldFormatter) -> (a -> ModifierParser) -> PrintfArg a
parseFormat :: Bitwise a -> ModifierParser
$cparseFormat :: forall a. PrintfArg a => Bitwise a -> ModifierParser
formatArg :: Bitwise a -> FieldFormatter
$cformatArg :: forall a. PrintfArg a => Bitwise a -> FieldFormatter
PrintfArg)

instance (Num a, Bits a) => Boolean (Bitwise a) where
  true :: Bitwise a
true   = forall b. Boolean b => b -> b
not forall b. Boolean b => b
false
  false :: Bitwise a
false  = forall a. a -> Bitwise a
Bitwise a
0
  not :: Bitwise a -> Bitwise a
not    = forall a. a -> Bitwise a
Bitwise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bits a => a -> a
complement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bitwise a -> a
getBits
  && :: Bitwise a -> Bitwise a -> Bitwise a
(&&)   = (forall a. a -> Bitwise a
Bitwise forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bits a => a -> a -> a
(.&.) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Bitwise a -> a
getBits
  || :: Bitwise a -> Bitwise a -> Bitwise a
(||)   = (forall a. a -> Bitwise a
Bitwise forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bits a => a -> a -> a
(.|.) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Bitwise a -> a
getBits
  xor :: Bitwise a -> Bitwise a -> Bitwise a
xor    = (forall a. a -> Bitwise a
Bitwise forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Bits a => a -> a -> a
Bits.xor forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Bitwise a -> a
getBits)
  <--> :: Bitwise a -> Bitwise a -> Bitwise a
(<-->) = (forall b. Boolean b => b -> b
not forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Boolean b => b -> b -> b
xor