    {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies,
                 UndecidableInstances, ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies, FlexibleContexts, CPP #-}
    {-# OPTIONS_GHC -Wall #-}

    {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- TEMP
    {-# OPTIONS_GHC -fno-warn-unused-binds   #-} -- TEMP

    ----------------------------------------------------------------------
    -- |
    -- Module      :  Data.Boolean
    -- Copyright   :  (c) Conal Elliott 2009-2012
    -- License     :  BSD3
    --
    -- Maintainer  :  conal@conal.net
    -- Stability   :  experimental
    --
    -- Some classes for generalized boolean operations.
    --
    -- In this design, for if-then-else, equality and inequality tests, the
    -- boolean type depends on the value type.
    --
    -- I also tried using a unary type constructor class.  The class doesn't work
    -- for regular booleans, so generality is lost.  Also, we'd probably have
    -- to wire class constraints in like: @(==*) :: Eq a => f Bool -> f a -> f
    -- a -> f a@, which disallows situations needing additional constraints,
    -- e.g., Show.
    --
    -- Starting with 0.1.0, this package uses type families.
    -- Up to version 0.0.2, it used MPTCs with functional dependencies.
    -- My thanks to Andy Gill for suggesting & helping with the change.

    ----------------------------------------------------------------------

    module Data.Boolean
      ( Boolean(..), BooleanOf, IfB(..)
      , boolean, cond, crop
      , EqB(..), OrdB(..)
      , minB, maxB, sort2B
      , guardedB, caseB
      ) where

    #if MIN_VERSION_base(4,8,0)
    import Prelude hiding ((<*))
    #endif
    import Data.Monoid (Monoid,mempty)
    import Control.Applicative (Applicative(pure),liftA2,liftA3)

    {--------------------------------------------------------------------
        Classes
    --------------------------------------------------------------------}

    infixr 3  &&*
    infixr 2  ||*

    -- | Generalized boolean class
    class Boolean b where
      true, false  :: b
      notB         :: b -> b
      (&&*), (||*) :: b -> b -> b

    instance Boolean Bool where
      true :: Bool
    true  = Bool
    True
      false :: Bool
    false = Bool
    False
      notB :: Bool -> Bool
    notB  = Bool -> Bool
    not
      &&* :: Bool -> Bool -> Bool
    (&&*) = Bool -> Bool -> Bool
    (&&)
      ||* :: Bool -> Bool -> Bool
    (||*) = Bool -> Bool -> Bool
    (||)

    -- | 'BooleanOf' computed the boolean analog of a specific type.
    type family BooleanOf a

    -- | Types with conditionals
    class Boolean (BooleanOf a) => IfB a where
      ifB  :: (bool ~ BooleanOf a) => bool -> a -> a -> a

    -- | Expression-lifted conditional with condition last
    boolean :: (IfB a, bool ~ BooleanOf a) => a -> a -> bool -> a
    boolean :: forall a bool. (IfB a, bool ~ BooleanOf a) => a -> a -> bool -> a
    boolean a
    t a
    e bool
    bool = bool -> a -> a -> a
    forall bool. (bool ~ BooleanOf a) => bool -> a -> a -> a
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB bool
    bool a
    t a
    e

    -- | Point-wise conditional
    cond :: (Applicative f, IfB a, bool ~ BooleanOf a) => f bool -> f a -> f a -> f a
    cond :: forall (f :: * -> *) a bool.
    (Applicative f, IfB a, bool ~ BooleanOf a) =>
    f bool -> f a -> f a -> f a
    cond = (bool -> a -> a -> a) -> f bool -> f a -> f a -> f a
    forall (f :: * -> *) a b c d.
    Applicative f =>
    (a -> b -> c -> d) -> f a -> f b -> f c -> f d
    liftA3 bool -> a -> a -> a
    forall bool. (bool ~ BooleanOf a) => bool -> a -> a -> a
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB

    -- | Generalized cropping, filling in 'mempty' where the test yields false.
    crop :: (Applicative f, Monoid (f a), IfB a, bool ~ BooleanOf a) => f bool -> f a -> f a
    crop :: forall (f :: * -> *) a bool.
    (Applicative f, Monoid (f a), IfB a, bool ~ BooleanOf a) =>
    f bool -> f a -> f a
    crop f bool
    r f a
    f = f bool -> f a -> f a -> f a
    forall (f :: * -> *) a bool.
    (Applicative f, IfB a, bool ~ BooleanOf a) =>
    f bool -> f a -> f a -> f a
    cond f bool
    r f a
    f f a
    forall a. Monoid a => a
    mempty

    -- | A generalized replacement for guards and chained ifs.
    guardedB :: (IfB b, bool ~ BooleanOf b) => bool -> [(bool,b)] -> b -> b
    guardedB :: forall b bool.
    (IfB b, bool ~ BooleanOf b) =>
    bool -> [(bool, b)] -> b -> b
    guardedB bool
    _ []        b
    e = b
    e
    guardedB bool
    a ((bool
    c,b
    b):[(bool, b)]
    l) b
    e = bool -> b -> b -> b
    forall bool. (bool ~ BooleanOf b) => bool -> b -> b -> b
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB bool
    c b
    b (bool -> [(bool, b)] -> b -> b
    forall b bool.
    (IfB b, bool ~ BooleanOf b) =>
    bool -> [(bool, b)] -> b -> b
    guardedB bool
    a [(bool, b)]
    l b
    e)

    -- | A generalized version of a case like control structure.
    caseB :: (IfB b, bool ~ BooleanOf b) => a -> [(a -> bool, b)] -> b -> b
    caseB :: forall b bool a.
    (IfB b, bool ~ BooleanOf b) =>
    a -> [(a -> bool, b)] -> b -> b
    caseB a
    _ []        b
    e = b
    e
    caseB a
    x ((a -> bool
    p,b
    b):[(a -> bool, b)]
    l) b
    e = bool -> b -> b -> b
    forall bool. (bool ~ BooleanOf b) => bool -> b -> b -> b
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB (a -> bool
    p a
    x) b
    b (a -> [(a -> bool, b)] -> b -> b
    forall b bool a.
    (IfB b, bool ~ BooleanOf b) =>
    a -> [(a -> bool, b)] -> b -> b
    caseB a
    x [(a -> bool, b)]
    l b
    e)

    infix  4  ==*, /=*

    -- | Types with equality.  Minimum definition: '(==*)'.
    class Boolean (BooleanOf a) => EqB a where
      (==*), (/=*) :: (bool ~ BooleanOf a) => a -> a -> bool
      a
    u /=* a
    v = bool -> bool
    forall b. Boolean b => b -> b
    notB (a
    u a -> a -> bool
    forall bool. (bool ~ BooleanOf a) => a -> a -> bool
    forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
    ==* a
    v)

    infix  4  <*, <=*, >=*, >*

    -- | Types with inequality.  Minimum definition: '(<*)'.
    class Boolean (BooleanOf a) => OrdB a where
      (<*), (<=*), (>*), (>=*) :: (bool ~ BooleanOf a) => a -> a -> bool
      a
    u >*  a
    v = a
    v a -> a -> bool
    forall bool. (bool ~ BooleanOf a) => a -> a -> bool
    forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
    <* a
    u
      a
    u >=* a
    v = bool -> bool
    forall b. Boolean b => b -> b
    notB (a
    u a -> a -> bool
    forall bool. (bool ~ BooleanOf a) => a -> a -> bool
    forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
    <* a
    v)
      a
    u <=* a
    v = a
    v a -> a -> bool
    forall bool. (bool ~ BooleanOf a) => a -> a -> bool
    forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
    >=* a
    u

    -- | Variant of 'min' using 'ifB' and '(<=*)'
    minB :: (IfB a, OrdB a) => a -> a -> a
    a
    u minB :: forall a. (IfB a, OrdB a) => a -> a -> a
    `minB` a
    v = BooleanOf a -> a -> a -> a
    forall bool. (bool ~ BooleanOf a) => bool -> a -> a -> a
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB (a
    u a -> a -> BooleanOf a
    forall bool. (bool ~ BooleanOf a) => a -> a -> bool
    forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
    <=* a
    v) a
    u a
    v

    -- | Variant of 'max' using 'ifB' and '(>=*)'
    maxB :: (IfB a, OrdB a) => a -> a -> a
    a
    u maxB :: forall a. (IfB a, OrdB a) => a -> a -> a
    `maxB` a
    v = BooleanOf a -> a -> a -> a
    forall bool. (bool ~ BooleanOf a) => bool -> a -> a -> a
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB (a
    u a -> a -> BooleanOf a
    forall bool. (bool ~ BooleanOf a) => a -> a -> bool
    forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
    >=* a
    v) a
    u a
    v

    -- | Variant of 'min' and 'max' using 'ifB' and '(<=*)'
    sort2B :: (IfB a, OrdB a) => (a,a) -> (a,a)
    sort2B :: forall a. (IfB a, OrdB a) => (a, a) -> (a, a)
    sort2B (a
    u,a
    v) = BooleanOf a -> (a, a) -> (a, a) -> (a, a)
    forall bool.
    (bool ~ BooleanOf (a, a)) =>
    bool -> (a, a) -> (a, a) -> (a, a)
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB (a
    u a -> a -> BooleanOf a
    forall bool. (bool ~ BooleanOf a) => a -> a -> bool
    forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
    <=* a
    v) (a
    u,a
    v) (a
    v,a
    u)

    {--------------------------------------------------------------------
        Instances for Prelude types
    --------------------------------------------------------------------}

    -- Simple if-then-else as function.
    ife :: Bool -> a -> a -> a
    ife :: forall a. Bool -> a -> a -> a
    ife Bool
    c a
    t a
    e = if Bool
    c then a
    t else a
    e

    -- I'd give the following instances:
    --
    --     instance          IfB a where ifB = ife
    --     instance Eq  a => EqB a where { (==*) = (==) ; (/=*) = (/=) }
    --     instance Ord a => Ord a where { (<*) = (<) ; (<=*) = (<=)}
    --
    -- Sadly, doing so would break the a->bool fundep, which is needed elsewhere
    -- for disambiguation.  So use the instances above as templates, filling
    -- in specific types for a.

    #define SimpleInstances(Ty) \
    instance IfB  (Ty) where { ifB = ife } ;\
    instance EqB  (Ty) where { (==*) = (==) ; (/=*) = (/=) } ;\
    instance OrdB (Ty) where { (<*) = (<) ; (<=*) = (<=) }

    #define SimpleTy(Ty) \
    type instance BooleanOf (Ty) = Bool ;\
    SimpleInstances(Ty)

    SimpleTy(Int)
    SimpleTy(Integer)
    SimpleTy(Float)
    SimpleTy(Double)
    SimpleTy(Bool)
    SimpleTy(Char)

    -- Similarly for other simple types.

    -- TODO: Export these macros for external use. I guess I'd want a .h file as in
    -- the applicative-numbers package.

    type instance BooleanOf [a]       = BooleanOf a
    type instance BooleanOf (a,b)     = BooleanOf a
    type instance BooleanOf (a,b,c)   = BooleanOf a
    type instance BooleanOf (a,b,c,d) = BooleanOf a
    type instance BooleanOf (z -> a)  = z -> BooleanOf a

    -- I'm uncomfortable with this list instance. It's unlike tuples and unlike
    -- functions. It could be generalized from BooleanOf a ~ Bool to a general case
    -- for applicatives, but then the list version would form cross products.
    -- Consider strings and other list types under a variety of use scenarios.

    instance (Boolean (BooleanOf a),BooleanOf a ~ Bool) => IfB [a] where { ifB :: forall bool. (bool ~ BooleanOf [a]) => bool -> [a] -> [a] -> [a]
    ifB = bool -> [a] -> [a] -> [a]
    Bool -> [a] -> [a] -> [a]
    forall a. Bool -> a -> a -> a
    ife }

    instance (bool ~ BooleanOf p, bool ~ BooleanOf q
             ,IfB p, IfB q) => IfB (p,q) where
      ifB :: forall bool.
    (bool ~ BooleanOf (p, q)) =>
    bool -> (p, q) -> (p, q) -> (p, q)
    ifB bool
    w (p
    p,q
    q) (p
    p',q
    q') = (bool -> p -> p -> p
    forall bool. (bool ~ BooleanOf p) => bool -> p -> p -> p
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB bool
    w p
    p p
    p', bool -> q -> q -> q
    forall bool. (bool ~ BooleanOf q) => bool -> q -> q -> q
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB bool
    w q
    q q
    q')

    instance (bool ~ BooleanOf p, bool ~ BooleanOf q, bool ~ BooleanOf r
             ,IfB p, IfB q, IfB r)
          => IfB (p,q,r) where
      ifB :: forall bool.
    (bool ~ BooleanOf (p, q, r)) =>
    bool -> (p, q, r) -> (p, q, r) -> (p, q, r)
    ifB bool
    w (p
    p,q
    q,r
    r) (p
    p',q
    q',r
    r') = (bool -> p -> p -> p
    forall bool. (bool ~ BooleanOf p) => bool -> p -> p -> p
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB bool
    w p
    p p
    p', bool -> q -> q -> q
    forall bool. (bool ~ BooleanOf q) => bool -> q -> q -> q
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB bool
    w q
    q q
    q', bool -> r -> r -> r
    forall bool. (bool ~ BooleanOf r) => bool -> r -> r -> r
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB bool
    w r
    r r
    r')

    instance (bool ~ BooleanOf p, bool ~ BooleanOf q, bool ~ BooleanOf r, bool ~ BooleanOf s
             ,IfB p, IfB q, IfB r, IfB s) => IfB (p,q,r,s) where
      ifB :: forall bool.
    (bool ~ BooleanOf (p, q, r, s)) =>
    bool -> (p, q, r, s) -> (p, q, r, s) -> (p, q, r, s)
    ifB bool
    w (p
    p,q
    q,r
    r,s
    s) (p
    p',q
    q',r
    r',s
    s') =
        (bool -> p -> p -> p
    forall bool. (bool ~ BooleanOf p) => bool -> p -> p -> p
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB bool
    w p
    p p
    p', bool -> q -> q -> q
    forall bool. (bool ~ BooleanOf q) => bool -> q -> q -> q
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB bool
    w q
    q q
    q', bool -> r -> r -> r
    forall bool. (bool ~ BooleanOf r) => bool -> r -> r -> r
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB bool
    w r
    r r
    r', bool -> s -> s -> s
    forall bool. (bool ~ BooleanOf s) => bool -> s -> s -> s
    forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
    ifB bool
    w s
    s s
    s')

    -- Instances for functions, using the standard pattern for applicative functions.
    -- Note that the [] applicative does not use this instance. Fishy.

    instance Boolean bool => Boolean (z -> bool) where
      true :: z -> bool
    true  = bool -> z -> bool
    forall a. a -> z -> a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure bool
    forall b. Boolean b => b
    true
      false :: z -> bool
    false = bool -> z -> bool
    forall a. a -> z -> a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure bool
    forall b. Boolean b => b
    false
      notB :: (z -> bool) -> z -> bool
    notB  = (bool -> bool) -> (z -> bool) -> z -> bool
    forall a b. (a -> b) -> (z -> a) -> z -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap bool -> bool
    forall b. Boolean b => b -> b
    notB
      &&* :: (z -> bool) -> (z -> bool) -> z -> bool
    (&&*) = (bool -> bool -> bool) -> (z -> bool) -> (z -> bool) -> z -> bool
    forall a b c. (a -> b -> c) -> (z -> a) -> (z -> b) -> z -> c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 bool -> bool -> bool
    forall b. Boolean b => b -> b -> b
    (&&*)
      ||* :: (z -> bool) -> (z -> bool) -> z -> bool
    (||*) = (bool -> bool -> bool) -> (z -> bool) -> (z -> bool) -> z -> bool
    forall a b c. (a -> b -> c) -> (z -> a) -> (z -> b) -> z -> c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 bool -> bool -> bool
    forall b. Boolean b => b -> b -> b
    (||*)

    instance IfB a => IfB (z -> a) where
      ifB :: forall bool.
    (bool ~ BooleanOf (z -> a)) =>
    bool -> (z -> a) -> (z -> a) -> z -> a
    ifB = bool -> (z -> a) -> (z -> a) -> z -> a
    (z -> BooleanOf a) -> (z -> a) -> (z -> a) -> z -> a
    forall (f :: * -> *) a bool.
    (Applicative f, IfB a, bool ~ BooleanOf a) =>
    f bool -> f a -> f a -> f a
    cond

    instance EqB a => EqB (z -> a) where
      { ==* :: forall bool.
    (bool ~ BooleanOf (z -> a)) =>
    (z -> a) -> (z -> a) -> bool
    (==*) = (a -> a -> BooleanOf a) -> (z -> a) -> (z -> a) -> z -> BooleanOf a
    forall a b c. (a -> b -> c) -> (z -> a) -> (z -> b) -> z -> c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 a -> a -> BooleanOf a
    forall bool. (bool ~ BooleanOf a) => a -> a -> bool
    forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
    (==*) ; /=* :: forall bool.
    (bool ~ BooleanOf (z -> a)) =>
    (z -> a) -> (z -> a) -> bool
    (/=*) = (a -> a -> BooleanOf a) -> (z -> a) -> (z -> a) -> z -> BooleanOf a
    forall a b c. (a -> b -> c) -> (z -> a) -> (z -> b) -> z -> c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 a -> a -> BooleanOf a
    forall bool. (bool ~ BooleanOf a) => a -> a -> bool
    forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
    (/=*) }
    instance OrdB a => OrdB (z -> a) where
      { <* :: forall bool.
    (bool ~ BooleanOf (z -> a)) =>
    (z -> a) -> (z -> a) -> bool
    (<*) = (a -> a -> BooleanOf a) -> (z -> a) -> (z -> a) -> z -> BooleanOf a
    forall a b c. (a -> b -> c) -> (z -> a) -> (z -> b) -> z -> c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 a -> a -> BooleanOf a
    forall bool. (bool ~ BooleanOf a) => a -> a -> bool
    forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
    (<*) ; <=* :: forall bool.
    (bool ~ BooleanOf (z -> a)) =>
    (z -> a) -> (z -> a) -> bool
    (<=*) = (a -> a -> BooleanOf a) -> (z -> a) -> (z -> a) -> z -> BooleanOf a
    forall a b c. (a -> b -> c) -> (z -> a) -> (z -> b) -> z -> c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 a -> a -> BooleanOf a
    forall bool. (bool ~ BooleanOf a) => a -> a -> bool
    forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
    (<=*) }

    -- TODO: Generalize the function instance into a macro for arbitrary
    -- applicatives. Instantiate for functions.

    {-

    {--------------------------------------------------------------------
        Tests
    --------------------------------------------------------------------}

    t1 :: String
    t1 = ifB True "foo" "bar"

    t2 :: Float -> Float
    t2 = ifB (< 0) negate id

    --     No instance for (IfB (a -> Bool) (a1 -> a1))
    --       arising from a use of `ifB'
    --
    -- t2 = ifB (< 0) negate id                -- abs

    -}