src/Rel8/Table/Bool.hs · rel8

on ca7aaef 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, Col(..) )

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

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

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

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

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

23 fromColumns $ htabulate $ \field ->

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

25 (DB falseExpr, DB trueExpr) ->

26 DB (boolExpr falseExpr trueExpr condition)

27{-# INLINABLE bool #-}

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)