src/Rel8/Query/Evaluate.hs · rel8

on da76712 help sign in

rel8/src/Rel8/Query/Evaluate.hs

49 lines 1.4 kB history raw

1{-# language FlexibleContexts #-}

2{-# language TupleSections #-}

4module Rel8.Query.Evaluate

5 ( evaluate

6 )

7where

9-- base

10import Control.Monad ( (>=>) )

11import Data.Foldable ( foldl' )

12import Data.List.NonEmpty ( NonEmpty( (:|) ), nonEmpty )

13import Data.Monoid ( Any( Any ) )

14import Prelude hiding ( undefined )

16-- opaleye

17import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

19-- rel8

20import Rel8.Expr ( Expr )

21import Rel8.Expr.Bool ( (&&.) )

22import Rel8.Expr.Opaleye ( fromPrimExpr )

23import Rel8.Query ( Query( Query ) )

24import Rel8.Query.Rebind ( rebind )

25import Rel8.Table ( Table )

26import Rel8.Table.Bool ( case_ )

27import Rel8.Table.Undefined ( undefined )

30-- | 'evaluate' takes expressions that could potentially have side effects and

31-- \"runs\" them in the 'Query' monad. The returned expressions have no side

32-- effects and can safely be reused.

33evaluate :: Table Expr a => a -> Query a

34evaluate = laterally >=> rebind "eval"

37laterally :: Table Expr a => a -> Query a

38laterally a = Query $ \bindings -> pure $ (Any True,) $

39 case nonEmpty bindings of

40 Nothing -> a

41 Just bindings' -> case_ [(condition, a)] undefined

42 where

43 condition = foldl1' (&&.) (fmap go bindings')

44 where

45 go = fromPrimExpr . Opaleye.UnExpr Opaleye.OpIsNotNull

48foldl1' :: (a -> a -> a) -> NonEmpty a -> a

49foldl1' f (a :| as) = foldl' f a as