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

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

-- base
import Prelude

-- rel8
import Rel8.Expr ( Expr, Col( E, unE ) )
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 (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns -> Columns a (Col Expr)
false) (a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns -> Columns a (Col Expr)
true) Expr Bool
condition =
  Columns a (Col Expr) -> a
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (Columns a (Col Expr) -> a) -> Columns a (Col Expr) -> a
forall a b. (a -> b) -> a -> b
$ (forall (spec :: Spec). HField (Columns a) spec -> Col Expr spec)
-> Columns a (Col Expr)
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (spec :: Spec). HField t spec -> context spec) -> t context
htabulate ((forall (spec :: Spec). HField (Columns a) spec -> Col Expr spec)
 -> Columns a (Col Expr))
-> (forall (spec :: Spec).
    HField (Columns a) spec -> Col Expr spec)
-> Columns a (Col Expr)
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) spec
field ->
    case (Columns a (Col Expr) -> HField (Columns a) spec -> Col Expr spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield Columns a (Col Expr)
false HField (Columns a) spec
field, Columns a (Col Expr) -> HField (Columns a) spec -> Col Expr spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield Columns a (Col Expr)
true HField (Columns a) spec
field) of
      (E falseExpr, E trueExpr) ->
        Expr a -> Col Expr ('Spec labels a)
forall a (labels :: Labels). Expr a -> Col Expr ('Spec labels a)
E (Expr a -> Expr a -> Expr Bool -> Expr a
forall a. Expr a -> Expr a -> Expr Bool -> Expr a
boolExpr Expr a
falseExpr Expr a
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 (Col Expr)))
-> [(Expr Bool, a)] -> [(Expr Bool, Columns a (Col Expr))]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Columns a (Col Expr))
-> (Expr Bool, a) -> (Expr Bool, Columns a (Col Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns) -> [(Expr Bool, Columns a (Col Expr))]
branches) (a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns -> Columns a (Col Expr)
fallback) =
  Columns a (Col Expr) -> a
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (Columns a (Col Expr) -> a) -> Columns a (Col Expr) -> a
forall a b. (a -> b) -> a -> b
$ (forall (spec :: Spec). HField (Columns a) spec -> Col Expr spec)
-> Columns a (Col Expr)
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (spec :: Spec). HField t spec -> context spec) -> t context
htabulate ((forall (spec :: Spec). HField (Columns a) spec -> Col Expr spec)
 -> Columns a (Col Expr))
-> (forall (spec :: Spec).
    HField (Columns a) spec -> Col Expr spec)
-> Columns a (Col Expr)
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) spec
field -> case Columns a (Col Expr) -> HField (Columns a) spec -> Col Expr spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield Columns a (Col Expr)
fallback HField (Columns a) spec
field of
    E fallbackExpr ->
      case ((Expr Bool, Columns a (Col Expr)) -> (Expr Bool, Expr a))
-> [(Expr Bool, Columns a (Col Expr))] -> [(Expr Bool, Expr a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Columns a (Col Expr) -> Expr a)
-> (Expr Bool, Columns a (Col Expr)) -> (Expr Bool, Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Col Expr ('Spec labels a) -> Expr a
forall (labels :: Labels) a. Col Expr ('Spec labels a) -> Expr a
unE (Col Expr ('Spec labels a) -> Expr a)
-> (Columns a (Col Expr) -> Col Expr ('Spec labels a))
-> Columns a (Col Expr)
-> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Columns a (Col Expr)
-> HField (Columns a) ('Spec labels a) -> Col Expr ('Spec labels a)
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
`hfield` HField (Columns a) spec
HField (Columns a) ('Spec labels a)
field))) [(Expr Bool, Columns a (Col Expr))]
branches of
        [(Expr Bool, Expr a)]
branchExprs -> Expr a -> Col Expr ('Spec labels a)
forall a (labels :: Labels). Expr a -> Col Expr ('Spec labels a)
E ([(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)