git.iko.soy/rel8
on ef28940 help sign in
rel8/src/Rel8/Query/Evaluate.hs
68 lines 2.2 kB history raw
1{-# language FlexibleContexts #-}
2{-# language TupleSections #-}
4module Rel8.Query.Evaluate
5 ( evaluate
6 , rebind
7 )
8where
10-- base
11import Control.Monad ( (>=>) )
12import Data.Foldable ( foldl' )
13import Data.List.NonEmpty ( NonEmpty( (:|) ), nonEmpty )
14import Data.Monoid ( Any( Any ) )
15import Prelude hiding ( undefined )
17-- opaleye
18import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
19import qualified Opaleye.Internal.PackMap as Opaleye
20import qualified Opaleye.Internal.PrimQuery as Opaleye
21import qualified Opaleye.Internal.QueryArr as Opaleye
22import qualified Opaleye.Internal.Tag as Opaleye
23import qualified Opaleye.Internal.Unpackspec as Opaleye
25-- rel8
26import Rel8.Expr ( Expr )
27import Rel8.Expr.Bool ( (&&.) )
28import Rel8.Expr.Opaleye ( fromPrimExpr )
29import Rel8.Query ( Query( Query ) )
30import Rel8.Table ( Table )
31import Rel8.Table.Bool ( case_ )
32import Rel8.Table.Opaleye ( unpackspec )
33import Rel8.Table.Undefined
36-- | 'evaluate' takes expressions that could potentially have side effects and
37-- \"runs\" them in the 'Query' monad. The returned expressions have no side
38-- effects and can safely be reused.
39evaluate :: Table Expr a => a -> Query a
40evaluate = laterally >=> rebind
43laterally :: Table Expr a => a -> Query a
44laterally a = Query $ \bindings -> pure $ (Any True,) $
45 case nonEmpty bindings of
46 Nothing -> a
47 Just bindings' -> case_ [(condition, a)] undefined
48 where
49 condition = foldl1' (&&.) (fmap go bindings')
50 where
51 go = fromPrimExpr . Opaleye.UnExpr Opaleye.OpIsNotNull
54-- | 'rebind' takes some expressions, and binds each of them to a new
55-- variable in the SQL. The @a@ returned consists only of these
56-- variables. It's essentially a @let@ binding for Postgres expressions.
57rebind :: Table Expr a => a -> Query a
58rebind a = Query $ \_ -> Opaleye.QueryArr $ \(_, tag) ->
59 let
60 tag' = Opaleye.next tag
61 (a', bindings) = Opaleye.run $
62 Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "eval" tag') a
63 in
64 ((mempty, a'), \_ -> Opaleye.Rebind True bindings, tag')
67foldl1' :: (a -> a -> a) -> NonEmpty a -> a
68foldl1' f (a :| as) = foldl' f a as