{-# language FlexibleContexts #-}
{-# language TypeFamilies #-}
{-# language ViewPatterns #-}

module Rel8.Table.Bool
  ( bool
  , case_
  , nullable
  )
where

-- base
import Prelude

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Expr.Bool ( boolExpr, caseExpr )
import Rel8.Expr.Null ( isNull, unsafeUnnullify )
import Rel8.Schema.HTable ( htabulate, hfield )
import Rel8.Table ( Table, fromColumns, toColumns )


-- | An if-then-else expression on tables.
--
-- @bool x y p@ returns @x@ if @p@ is @False@, and returns @y@ if @p@ is
-- @True@.
bool :: Table Expr a => a -> a -> Expr Bool -> a
bool :: a -> a -> Expr Bool -> a
bool (a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
false) (a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
true) Expr Bool
condition =
  Columns a Expr -> a
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Columns a Expr -> a) -> Columns a Expr -> a
forall a b. (a -> b) -> a -> b
$ (forall a. HField (Columns a) a -> Expr a) -> Columns a Expr
forall (t :: HTable) (context :: Context).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate ((forall a. HField (Columns a) a -> Expr a) -> Columns a Expr)
-> (forall a. HField (Columns a) a -> Expr a) -> Columns a Expr
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) a
field ->
    case (Columns a Expr -> HField (Columns a) a -> Expr a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Expr
false HField (Columns a) a
field, Columns a Expr -> HField (Columns a) a -> Expr a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Expr
true HField (Columns a) a
field) of
      (Expr a
falseExpr, Expr a
trueExpr) -> Expr a -> Expr a -> Expr Bool -> Expr a
forall a. Expr a -> Expr a -> Expr Bool -> Expr a
boolExpr Expr a
falseExpr Expr a
trueExpr Expr Bool
condition
{-# INLINABLE bool #-}


-- | Produce a table expression from a list of alternatives. Returns the first
-- table where the @Expr Bool@ expression is @True@. If no alternatives are
-- true, the given default is returned.
case_ :: Table Expr a => [(Expr Bool, a)] -> a -> a
case_ :: [(Expr Bool, a)] -> a -> a
case_ (((Expr Bool, a) -> (Expr Bool, Columns a Expr))
-> [(Expr Bool, a)] -> [(Expr Bool, Columns a Expr)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Columns a Expr)
-> (Expr Bool, a) -> (Expr Bool, Columns a Expr)
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns) -> [(Expr Bool, Columns a Expr)]
branches) (a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
fallback) =
  Columns a Expr -> a
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Columns a Expr -> a) -> Columns a Expr -> a
forall a b. (a -> b) -> a -> b
$ (forall a. HField (Columns a) a -> Expr a) -> Columns a Expr
forall (t :: HTable) (context :: Context).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate ((forall a. HField (Columns a) a -> Expr a) -> Columns a Expr)
-> (forall a. HField (Columns a) a -> Expr a) -> Columns a Expr
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) a
field -> case Columns a Expr -> HField (Columns a) a -> Expr a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Expr
fallback HField (Columns a) a
field of
    Expr a
fallbackExpr ->
      case ((Expr Bool, Columns a Expr) -> (Expr Bool, Expr a))
-> [(Expr Bool, Columns a Expr)] -> [(Expr Bool, Expr a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Columns a Expr -> Expr a)
-> (Expr Bool, Columns a Expr) -> (Expr Bool, Expr a)
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap (Columns a Expr -> HField (Columns a) a -> Expr a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
`hfield` HField (Columns a) a
field)) [(Expr Bool, Columns a Expr)]
branches of
        [(Expr Bool, Expr a)]
branchExprs -> [(Expr Bool, Expr a)] -> Expr a -> Expr a
forall a. [(Expr Bool, Expr a)] -> Expr a -> Expr a
caseExpr [(Expr Bool, Expr a)]
branchExprs Expr a
fallbackExpr


-- | Like 'maybe', but to eliminate @null@.
nullable :: Table Expr b => b -> (Expr a -> b) -> Expr (Maybe a) -> b
nullable :: b -> (Expr a -> b) -> Expr (Maybe a) -> b
nullable b
b Expr a -> b
f Expr (Maybe a)
ma = b -> b -> Expr Bool -> b
forall a. Table Expr a => a -> a -> Expr Bool -> a
bool (Expr a -> b
f (Expr (Maybe a) -> Expr a
forall a. Expr (Maybe a) -> Expr a
unsafeUnnullify Expr (Maybe a)
ma)) b
b (Expr (Maybe a) -> Expr Bool
forall a. Expr (Maybe a) -> Expr Bool
isNull Expr (Maybe a)
ma)