on 137ebed help sign in
rel8/src/Rel8/Table/Bool.hs
49 lines 1.6 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, Col( E, unE ) )
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 (E falseExpr, E trueExpr) ->
32 E (boolExpr falseExpr trueExpr condition)
33{-# INLINABLE bool #-}
36-- | Produce a table expression from a list of alternatives. Returns the first
37-- table where the @Expr Bool@ expression is @True@. If no alternatives are
38-- true, the given default is returned.
39case_ :: Table Expr a => [(Expr Bool, a)] -> a -> a
40case_ (map (fmap toColumns) -> branches) (toColumns -> fallback) =
41 fromColumns $ htabulate $ \field -> case hfield fallback field of
42 E fallbackExpr ->
43 case map (fmap (unE . (`hfield` field))) branches of
44 branchExprs -> E (caseExpr branchExprs fallbackExpr)
47-- | Like 'maybe', but to eliminate @null@.
48nullable :: Table Expr b => b -> (Expr a -> b) -> Expr (Maybe a) -> b
49nullable b f ma = bool (f (unsafeUnnullify ma)) b (isNull ma)