{- |
Module      : Antelude.Bool
Description : Contains some functions for Bools.
Maintainer  : dneavesdev@pm.me
-}
module Antelude.Bool
    ( Bool (..)
    , all
    , and
    , any
    , not
    , or
    , otherwise
    , xor
    , (&&)
    , (||)
    ) where

import safe           Antelude.Internal.TypesClasses ( Bool (..), List )

import safe           Prelude
    ( not
    , otherwise
    , (&&)
    , (||)
    )
import safe qualified Prelude                        ( and, or )

infixr 3 `and`

-- | Logical `and`, but in word form. Can be used normally or infixed.
and :: Bool -> Bool -> Bool
and :: Bool -> Bool -> Bool
and Bool
a Bool
b = Bool
a Bool -> Bool -> Bool
&& Bool
b

infixr 2 `or`

-- | Logical `or`, but in word form. Can be used normally or infixed.
or :: Bool -> Bool -> Bool
or :: Bool -> Bool -> Bool
or Bool
a Bool
b = Bool
a Bool -> Bool -> Bool
|| Bool
b

infixr 1 `xor`

-- | Logical `xor`, but in word form. Can be used normally or infixed.
xor :: Bool -> Bool -> Bool
xor :: Bool -> Bool -> Bool
xor Bool
a Bool
b = (Bool
a Bool -> Bool -> Bool
`and` Bool -> Bool
Prelude.not Bool
b) Bool -> Bool -> Bool
`or` (Bool -> Bool
Prelude.not Bool
a Bool -> Bool -> Bool
`and` Bool
b)


-- | Return 'True' if 'all' of the contents of the list evaluate to 'True'.
all :: List Bool -> Bool
all :: List Bool -> Bool
all = List Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
Prelude.and


-- | Return 'True' if 'any' of the contents of the list evaluate to 'True'.
any :: List Bool -> Bool
any :: List Bool -> Bool
any = List Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
Prelude.or