src/Rel8/Table/Bool.hs · rel8

on db148ff help sign in

42 lines 1.3 kB history raw

1{-# language FlexibleContexts #-}

2{-# language TypeFamilies #-}

3{-# language ViewPatterns #-}

5module Rel8.Table.Bool

6 ( bool

7 , case_

8 )

9where

11-- base

12import Prelude

14-- rel8

15import Rel8.Expr ( Expr, Col(..) )

16import Rel8.Expr.Bool ( boolExpr, caseExpr )

17import Rel8.Schema.HTable ( htabulate, hfield )

18import Rel8.Table ( Table, fromColumns, toColumns )

21-- | An if-then-else expression on tables.

23-- @bool x y p@ returns @x@ if @p@ is @False@, and returns @y@ if @p@ is

24-- @True@.

25bool :: Table Expr a => a -> a -> Expr Bool -> a

26bool (toColumns -> false) (toColumns -> true) condition =

27 fromColumns $ htabulate $ \field ->

28 case (hfield false field, hfield true field) of

29 (DB falseExpr, DB trueExpr) ->

30 DB (boolExpr falseExpr trueExpr condition)

31{-# INLINABLE bool #-}

34-- | Produce a table expression from a list of alternatives. Returns the first

35-- table where the @Expr Bool@ expression is @True@. If no alternatives are

36-- true, the given default is returned.

37case_ :: Table Expr a => [(Expr Bool, a)] -> a -> a

38case_ (map (fmap toColumns) -> branches) (toColumns -> fallback) =

39 fromColumns $ htabulate $ \field -> case hfield fallback field of

40 DB fallbackExpr ->

41 case map (fmap (unDB . (`hfield` field))) branches of

42 branchExprs -> DB (caseExpr branchExprs fallbackExpr)