on da76712 help sign in
rel8/src/Rel8/Table/Bool.hs
48 lines 1.5 kB history raw
1{-# language FlexibleContexts #-}
2{-# language TypeFamilies #-}
3{-# language ViewPatterns #-}
5module Rel8.Table.Bool
6 ( bool
7 , case_
8 , nullable
9 )
10where
12-- base
13import Prelude
15-- rel8
16import Rel8.Expr ( Expr )
17import Rel8.Expr.Bool ( boolExpr, caseExpr )
18import Rel8.Expr.Null ( isNull, unsafeUnnullify )
19import Rel8.Schema.HTable ( htabulate, hfield )
20import Rel8.Table ( Table, fromColumns, toColumns )
23-- | An if-then-else expression on tables.
24--
25-- @bool x y p@ returns @x@ if @p@ is @False@, and returns @y@ if @p@ is
26-- @True@.
27bool :: Table Expr a => a -> a -> Expr Bool -> a
28bool (toColumns -> false) (toColumns -> true) condition =
29 fromColumns $ htabulate $ \field ->
30 case (hfield false field, hfield true field) of
31 (falseExpr, trueExpr) -> boolExpr falseExpr trueExpr condition
32{-# INLINABLE bool #-}
35-- | Produce a table expression from a list of alternatives. Returns the first
36-- table where the @Expr Bool@ expression is @True@. If no alternatives are
37-- true, the given default is returned.
38case_ :: Table Expr a => [(Expr Bool, a)] -> a -> a
39case_ (map (fmap toColumns) -> branches) (toColumns -> fallback) =
40 fromColumns $ htabulate $ \field -> case hfield fallback field of
41 fallbackExpr ->
42 case map (fmap (`hfield` field)) branches of
43 branchExprs -> caseExpr branchExprs fallbackExpr
46-- | Like 'maybe', but to eliminate @null@.
47nullable :: Table Expr b => b -> (Expr a -> b) -> Expr (Maybe a) -> b
48nullable b f ma = bool (f (unsafeUnnullify ma)) b (isNull ma)