module Data.Bool.HT.Private where

import Data.List  as List  (find, )
import Data.Maybe as Maybe (fromMaybe, )

{- |
@if-then-else@ as function.

Example:

> if' (even n) "even" $
> if' (isPrime n) "prime" $
> "boring"
-}
{-# INLINE if' #-}
if' :: Bool -> a -> a -> a
if' :: Bool -> a -> a -> a
if' Bool
True  a
x a
_ = a
x
if' Bool
False a
_ a
y = a
y

{-|
The same as 'if'', but the name is chosen
such that it can be used for GHC-7.0's rebindable if-then-else syntax.
-}
{-# INLINE ifThenElse #-}
ifThenElse :: Bool -> a -> a -> a
ifThenElse :: Bool -> a -> a -> a
ifThenElse = Bool -> a -> a -> a
forall a. Bool -> a -> a -> a
if'


{-|
From a list of expressions choose the one,
whose condition is true.

Example:

> select "boring" $
>   (even n, "even") :
>   (isPrime n, "prime") :
>   []
-}
{-# INLINE select #-}
select, select0, select1 :: a -> [(Bool, a)] -> a
select :: a -> [(Bool, a)] -> a
select  a
def = a -> ((Bool, a) -> a) -> Maybe (Bool, a) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
def (Bool, a) -> a
forall a b. (a, b) -> b
snd (Maybe (Bool, a) -> a)
-> ([(Bool, a)] -> Maybe (Bool, a)) -> [(Bool, a)] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, a) -> Bool) -> [(Bool, a)] -> Maybe (Bool, a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool, a) -> Bool
forall a b. (a, b) -> a
fst
select0 :: a -> [(Bool, a)] -> a
select0 a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> ([(Bool, a)] -> Maybe a) -> [(Bool, a)] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [(Bool, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Bool
True
select1 :: a -> [(Bool, a)] -> a
select1     = ((Bool, a) -> a -> a) -> a -> [(Bool, a)] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Bool -> a -> a -> a) -> (Bool, a) -> a -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> a -> a -> a
forall a. Bool -> a -> a -> a
if')


zipIf :: [Bool] -> [a] -> [a] -> [a]
zipIf :: [Bool] -> [a] -> [a] -> [a]
zipIf = (Bool -> a -> a -> a) -> [Bool] -> [a] -> [a] -> [a]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Bool -> a -> a -> a
forall a. Bool -> a -> a -> a
if'

infixr 1 ?:

{- |
Like the @?@ operator of the C progamming language.

>>> True ?: ("yes", "no")
"yes"
>>> False ?: ("yes", "no")
"no"
-}
{-# INLINE (?:) #-}
(?:) :: Bool -> (a,a) -> a
?: :: Bool -> (a, a) -> a
(?:) = (a -> a -> a) -> (a, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> a -> a) -> (a, a) -> a)
-> (Bool -> a -> a -> a) -> Bool -> (a, a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a -> a
forall a. Bool -> a -> a -> a
if'


-- precedence below (||) and (&&)
infixr 1 `implies`

{- |
Logical operator for implication.

Funnily because of the ordering of 'Bool' it holds:

prop> \a b -> implies a b == (a<=b)
-}
{-# INLINE implies #-}
implies :: Bool -> Bool -> Bool
implies :: Bool -> Bool -> Bool
implies Bool
prerequisite Bool
conclusion =
   Bool -> Bool
not Bool
prerequisite Bool -> Bool -> Bool
|| Bool
conclusion