{-# language GADTs #-}

module Rel8.Expr.Bool
  ( false, true
  , (&&.), (||.), not_
  , and_, or_
  , boolExpr
  , caseExpr
  , coalesce
  )
where

-- base
import Data.Foldable ( foldl' )
import Prelude hiding ( null )

-- opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

-- rel8
import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) )
import Rel8.Expr.Opaleye ( mapPrimExpr, toPrimExpr, zipPrimExprsWith )
import Rel8.Expr.Serialize ( litExpr )


-- | The SQL @false@ literal.
false :: Expr Bool
false :: Expr Bool
false = Bool -> Expr Bool
forall a. Sql DBType a => a -> Expr a
litExpr Bool
False


-- | The SQL @true@ literal.
true :: Expr Bool
true :: Expr Bool
true = Bool -> Expr Bool
forall a. Sql DBType a => a -> Expr a
litExpr Bool
True


-- | The SQL @AND@ operator.
(&&.) :: Expr Bool -> Expr Bool -> Expr Bool
&&. :: Expr Bool -> Expr Bool -> Expr Bool
(&&.) = (PrimExpr -> PrimExpr -> PrimExpr)
-> Expr Bool -> Expr Bool -> Expr Bool
forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
Opaleye.OpAnd)
infixr 3 &&.


-- | The SQL @OR@ operator.
(||.) :: Expr Bool -> Expr Bool -> Expr Bool
||. :: Expr Bool -> Expr Bool -> Expr Bool
(||.) = (PrimExpr -> PrimExpr -> PrimExpr)
-> Expr Bool -> Expr Bool -> Expr Bool
forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
Opaleye.OpOr)
infixr 2 ||.


-- | The SQL @NOT@ operator.
not_ :: Expr Bool -> Expr Bool
not_ :: Expr Bool -> Expr Bool
not_ = (PrimExpr -> PrimExpr) -> Expr Bool -> Expr Bool
forall a b. (PrimExpr -> PrimExpr) -> Expr a -> Expr b
mapPrimExpr (UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr UnOp
Opaleye.OpNot)


-- | Fold @AND@ over a collection of expressions.
and_ :: Foldable f => f (Expr Bool) -> Expr Bool
and_ :: f (Expr Bool) -> Expr Bool
and_ = (Expr Bool -> Expr Bool -> Expr Bool)
-> Expr Bool -> f (Expr Bool) -> Expr Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Expr Bool -> Expr Bool -> Expr Bool
(&&.) Expr Bool
true


-- | Fold @OR@ over a collection of expressions.
or_ :: Foldable f => f (Expr Bool) -> Expr Bool
or_ :: f (Expr Bool) -> Expr Bool
or_ = (Expr Bool -> Expr Bool -> Expr Bool)
-> Expr Bool -> f (Expr Bool) -> Expr Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Expr Bool -> Expr Bool -> Expr Bool
(||.) Expr Bool
false


-- | Eliminate a boolean-valued expression.
--
-- Corresponds to 'Data.Bool.bool'.
boolExpr :: Expr a -> Expr a -> Expr Bool -> Expr a
boolExpr :: Expr a -> Expr a -> Expr Bool -> Expr a
boolExpr Expr a
ifFalse Expr a
ifTrue Expr Bool
condition = [(Expr Bool, Expr a)] -> Expr a -> Expr a
forall a. [(Expr Bool, Expr a)] -> Expr a -> Expr a
caseExpr [(Expr Bool
condition, Expr a
ifTrue)] Expr a
ifFalse


-- | A multi-way if/then/else statement. The first argument to @caseExpr@ is a
-- list of alternatives. The first alternative that is of the form @(true, x)@
-- will be returned. If no such alternative is found, a fallback expression is
-- returned.
--
-- Corresponds to a @CASE@ expression in SQL.
caseExpr :: [(Expr Bool, Expr a)] -> Expr a -> Expr a
caseExpr :: [(Expr Bool, Expr a)] -> Expr a -> Expr a
caseExpr [(Expr Bool, Expr a)]
branches (Expr PrimExpr
fallback) =
  PrimExpr -> Expr a
forall k (a :: k). (k ~ *) => PrimExpr -> Expr a
Expr (PrimExpr -> Expr a) -> PrimExpr -> Expr a
forall a b. (a -> b) -> a -> b
$ [(PrimExpr, PrimExpr)] -> PrimExpr -> PrimExpr
Opaleye.CaseExpr (((Expr Bool, Expr a) -> (PrimExpr, PrimExpr))
-> [(Expr Bool, Expr a)] -> [(PrimExpr, PrimExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (Expr Bool, Expr a) -> (PrimExpr, PrimExpr)
forall a a. (Expr a, Expr a) -> (PrimExpr, PrimExpr)
go [(Expr Bool, Expr a)]
branches) PrimExpr
fallback
  where
    go :: (Expr a, Expr a) -> (PrimExpr, PrimExpr)
go (Expr a
condition, Expr a
value) = (Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr a
condition, Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr a
value)


-- | Convert a @Expr (Maybe Bool)@ to a @Expr Bool@ by treating @Nothing@ as
-- @False@. This can be useful when combined with 'Rel8.where_', which expects
-- a @Bool@, and produces expressions that optimize better than general case
-- analysis.
coalesce :: Expr (Maybe Bool) -> Expr Bool
coalesce :: Expr (Maybe Bool) -> Expr Bool
coalesce (Expr PrimExpr
a) = PrimExpr -> Expr Bool
forall k (a :: k). (k ~ *) => PrimExpr -> Expr a
Expr PrimExpr
a Expr Bool -> Expr Bool -> Expr Bool
&&. PrimExpr -> Expr Bool
forall k (a :: k). (k ~ *) => PrimExpr -> Expr a
Expr (Name -> [PrimExpr] -> PrimExpr
Opaleye.FunExpr Name
"COALESCE" [PrimExpr
a, PrimExpr
untrue])
  where
    untrue :: PrimExpr
untrue = Literal -> PrimExpr
Opaleye.ConstExpr (Bool -> Literal
Opaleye.BoolLit Bool
False)