{-# 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 
         -- <http://zenzike.com/posts/2011-08-01-the-conditional-choice-operator>
       , (|>), (<|)
         -- **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 :: Bool -> Bool
toBool = forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
instance ToBool Any  where toBool :: Any -> Bool
toBool = Any -> Bool
getAny
instance ToBool All  where toBool :: All -> Bool
toBool = All -> Bool
getAll
instance ToBool (Dual Bool) where toBool :: Dual Bool -> Bool
toBool = forall a. Dual a -> a
getDual

-- |A simple conditional operator
if' :: ToBool bool => bool -> a -> a -> a
if' :: forall bool a. ToBool bool => bool -> a -> a -> a
if' bool
p a
t a
f = if forall bool. ToBool bool => bool -> Bool
toBool bool
p then a
t else a
f
{-# INLINE if' #-}

-- |'if'' with the 'Bool' argument at the end (infixr 1).
(??) :: ToBool bool => a -> a -> bool -> a
?? :: forall bool a. ToBool bool => a -> a -> bool -> a
(??) a
t a
f bool
p = forall bool a. ToBool bool => bool -> a -> a -> a
if' bool
p a
t a
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 :: forall bool a. ToBool bool => a -> a -> bool -> a
bool a
f a
t bool
p = forall bool a. ToBool bool => bool -> a -> a -> a
if' bool
p a
t a
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 :: forall bool a. ToBool bool => [(bool, a)] -> a
cond [] = forall a. HasCallStack => [Char] -> a
error [Char]
"cond: no matching conditions"
cond ((bool
p,a
v):[(bool, a)]
ls) = forall bool a. ToBool bool => bool -> a -> a -> a
if' bool
p a
v (forall bool a. ToBool bool => [(bool, a)] -> a
cond [(bool, a)]
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 :: forall bool a. ToBool bool => a -> [(bool, a)] -> a
condDefault = (forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall bool (m :: * -> *) a.
(ToBool bool, MonadPlus m) =>
[(bool, a)] -> m a
condPlus) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a -> a
(<|)
{-# 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 :: forall bool (m :: * -> *) a.
(ToBool bool, MonadPlus m) =>
[(bool, a)] -> m a
condPlus [] = forall (m :: * -> *) a. MonadPlus m => m a
mzero
condPlus ((bool
p,a
v):[(bool, a)]
ls) = forall bool a. ToBool bool => bool -> a -> a -> a
if' bool
p (forall (m :: * -> *) a. Monad m => a -> m a
return a
v) (forall bool (m :: * -> *) a.
(ToBool bool, MonadPlus m) =>
[(bool, a)] -> m a
condPlus [(bool, a)]
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
bool
p ?. :: forall bool (cat :: * -> * -> *) a.
(ToBool bool, Category cat) =>
bool -> cat a a -> cat a a
?. cat a a
c = forall bool a. ToBool bool => bool -> a -> a -> a
if' bool
p cat a a
c forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
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 :: forall bool a b.
ToBool bool =>
(a -> bool) -> (a -> b) -> (a -> b) -> a -> b
select a -> bool
p a -> b
t a -> b
f a
x = forall bool a. ToBool bool => bool -> a -> a -> a
if' (a -> bool
p a
x) (a -> b
t a
x) (a -> b
f a
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 :: forall bool (m :: * -> *) a.
(ToBool bool, Monad m) =>
m bool -> m a -> m a -> m a
ifM m bool
p m a
t m a
f = m bool
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall bool a. ToBool bool => a -> a -> bool -> a
bool m a
f m a
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
<||> :: forall bool (m :: * -> *).
(ToBool bool, Boolean bool, Monad m) =>
m bool -> m bool -> m bool
(<||>) m bool
t m bool
f = forall bool (m :: * -> *) a.
(ToBool bool, Monad m) =>
m bool -> m a -> m a -> m a
ifM m bool
t (forall (m :: * -> *) a. Monad m => a -> m a
return forall b. Boolean b => b
true) m bool
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
<&&> :: forall bool (m :: * -> *).
(ToBool bool, Boolean bool, Monad m) =>
m bool -> m bool -> m bool
(<&&>) m bool
t m bool
f = forall bool (m :: * -> *) a.
(ToBool bool, Monad m) =>
m bool -> m a -> m a -> m a
ifM m bool
t m bool
f (forall (m :: * -> *) a. Monad m => a -> m a
return forall b. Boolean b => b
false)
{-# INLINE (<&&>) #-}

-- |Lifted boolean negation.
notM :: (Boolean bool, Monad m) => m bool -> m bool
notM :: forall bool (m :: * -> *).
(Boolean bool, Monad m) =>
m bool -> m bool
notM = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall b. Boolean b => b -> b
not
{-# INLINE notM #-}

-- |Lifted boolean exclusive disjunction.
xorM :: (Boolean bool, Monad m) => m bool -> m bool -> m bool
xorM :: forall bool (m :: * -> *).
(Boolean bool, Monad m) =>
m bool -> m bool -> m bool
xorM = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall b. Boolean b => b -> b -> b
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 :: forall bool (m :: * -> *) a.
(ToBool bool, Monad m) =>
[(m bool, m a)] -> m a
condM [] = forall a. HasCallStack => [Char] -> a
error [Char]
"condM: no matching conditions"
condM ((m bool
p, m a
v):[(m bool, m a)]
ls) = forall bool (m :: * -> *) a.
(ToBool bool, Monad m) =>
m bool -> m a -> m a -> m a
ifM m bool
p m a
v (forall bool (m :: * -> *) a.
(ToBool bool, Monad m) =>
[(m bool, m a)] -> m a
condM [(m bool, m a)]
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 :: forall bool (m :: * -> *) a.
(ToBool bool, MonadPlus m) =>
[(m bool, m a)] -> m a
condPlusM [] = forall (m :: * -> *) a. MonadPlus m => m a
mzero
condPlusM ((m bool
p, m a
v):[(m bool, m a)]
ls) = forall bool (m :: * -> *) a.
(ToBool bool, Monad m) =>
m bool -> m a -> m a -> m a
ifM m bool
p m a
v (forall bool (m :: * -> *) a.
(ToBool bool, MonadPlus m) =>
[(m bool, m a)] -> m a
condPlusM [(m bool, m a)]
ls)

-- |A synonym for 'return' 'true'.
otherwiseM :: (Boolean bool, Monad m) => m bool
otherwiseM :: forall bool (m :: * -> *). (Boolean bool, Monad m) => m bool
otherwiseM = forall (m :: * -> *) a. Monad m => a -> m a
return forall b. Boolean b => b
true

-- |Generalization of 'Control.Monad.guard'
guard :: (ToBool bool, MonadPlus m) => bool -> m ()
guard :: forall bool (m :: * -> *).
(ToBool bool, MonadPlus m) =>
bool -> m ()
guard bool
p = forall bool a. ToBool bool => bool -> a -> a -> a
if' bool
p (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (m :: * -> *) a. MonadPlus m => m a
mzero
{-# INLINE guard #-}

-- |Generalization of 'Control.Monad.when'
when :: (ToBool bool, Monad m) => bool -> m () -> m ()
when :: forall bool (m :: * -> *).
(ToBool bool, Monad m) =>
bool -> m () -> m ()
when bool
p m ()
m = forall bool a. ToBool bool => bool -> a -> a -> a
if' bool
p m ()
m (forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINE when #-}

-- |Generalization of 'Control.Monad.unless'
unless :: (Boolean bool, ToBool bool, Monad m) => bool -> m() -> m()
unless :: forall bool (m :: * -> *).
(Boolean bool, ToBool bool, Monad m) =>
bool -> m () -> m ()
unless bool
p m ()
m = forall bool a. ToBool bool => bool -> a -> a -> a
if' (forall b. Boolean b => b -> b
not bool
p) m ()
m (forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINE unless #-}

-- |A variant of 'when' with a monadic predicate.
whenM :: (ToBool bool, Monad m) => m bool -> m () -> m ()
whenM :: forall bool (m :: * -> *).
(ToBool bool, Monad m) =>
m bool -> m () -> m ()
whenM m bool
p m ()
m = forall bool (m :: * -> *) a.
(ToBool bool, Monad m) =>
m bool -> m a -> m a -> m a
ifM m bool
p m ()
m (forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINE whenM #-}

-- |A variant of 'unless' with a monadic predicate.
unlessM :: (ToBool bool, Boolean bool, Monad m) => m bool -> m () -> m ()
unlessM :: forall bool (m :: * -> *).
(ToBool bool, Boolean bool, Monad m) =>
m bool -> m () -> m ()
unlessM m bool
p m ()
m = forall bool (m :: * -> *) a.
(ToBool bool, Monad m) =>
m bool -> m a -> m a -> m a
ifM (forall bool (m :: * -> *).
(Boolean bool, Monad m) =>
m bool -> m bool
notM m bool
p) m ()
m (forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINE unlessM #-}

-- |A variant of 'guard' with a monadic predicate.
guardM :: (ToBool bool, MonadPlus m) => m bool -> m ()
guardM :: forall bool (m :: * -> *).
(ToBool bool, MonadPlus m) =>
m bool -> m ()
guardM = (forall bool (m :: * -> *).
(ToBool bool, MonadPlus m) =>
bool -> m ()
guard forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
{-# INLINE guardM #-}

-- |'select' lifted to 'Monad'.
selectM :: (ToBool bool, Monad m) => 
           (a -> m bool) -> (a -> m b) -> (a -> m b) -> (a -> m b)
selectM :: forall bool (m :: * -> *) a b.
(ToBool bool, Monad m) =>
(a -> m bool) -> (a -> m b) -> (a -> m b) -> a -> m b
selectM a -> m bool
p a -> m b
t a -> m b
f a
x = forall bool (m :: * -> *) a.
(ToBool bool, Monad m) =>
m bool -> m a -> m a -> m a
ifM (a -> m bool
p a
x) (a -> m b
t a
x) (a -> m b
f a
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
bool
p ?<> :: forall bool a. (ToBool bool, Monoid a) => bool -> a -> a
?<> a
m = forall bool a. ToBool bool => bool -> a -> a -> a
if' bool
p a
m forall a. Monoid a => a
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
b
p ? :: forall b a. b -> (b -> a) -> a
? b -> a
f = b -> a
f b
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
bool
p |> :: forall bool a. ToBool bool => bool -> a -> Maybe a
|> a
v = forall bool a. ToBool bool => bool -> a -> a -> a
if' bool
p forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just a
v)
{-# INLINE (|>) #-}

-- |Left bracket of the conditional choice operator. This is equivalent to
-- 'Data.Maybe.fromMaybe'
(<|) :: a -> Maybe a -> a
a
t <| :: forall a. a -> Maybe a -> a
<| Maybe a
Nothing = a
t
a
_ <| Just a
f  = a
f
{-# INLINE (<|) #-}

-- |A monadic variant of '|>'.
(|>>) :: (ToBool bool, Monad m) => m bool -> m a -> m (Maybe a)
m bool
p |>> :: forall bool (m :: * -> *) a.
(ToBool bool, Monad m) =>
m bool -> m a -> m (Maybe a)
|>> m a
v = forall bool (m :: * -> *) a.
(ToBool bool, Monad m) =>
m bool -> m a -> m a -> m a
ifM m bool
p (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. a -> Maybe a
Just m a
v)
{-# INLINE (|>>) #-}

-- |A monadic variant of '<|'.
(<<|) :: Monad m => m a -> m (Maybe a) -> m a
m a
v <<| :: forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
<<| m (Maybe a)
mv = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. a -> Maybe a -> a
fromMaybe m a
v m (Maybe a)
mv
{-# INLINE (<<|) #-}

-- |Unicode rebinding of '<|'. 
(⊲) :: a -> Maybe a -> a
⊲ :: forall a. a -> Maybe a -> a
(⊲) = forall a. a -> Maybe a -> a
(<|)

-- |Unicode rebinding of '|>'.
(⊳) :: ToBool bool => bool -> a -> Maybe a
⊳ :: forall bool a. ToBool bool => bool -> a -> Maybe a
(⊳) = forall bool a. ToBool bool => bool -> a -> Maybe a
(|>)