src/Rel8/Table/Bool.hs · rel8

on 00a36f5 help sign in

35 lines 1.0 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 )

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

17import Rel8.Schema.Context ( Col'(..) )

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

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

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

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

24 fromColumns $ htabulate $ \field ->

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

26 (DB falseExpr, DB trueExpr) ->

27 DB (boolExpr falseExpr trueExpr condition)

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

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

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

33 DB fallbackExpr ->

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

35 branchExprs -> DB (caseExpr branchExprs fallbackExpr)