{-# language FlexibleContexts #-}
{-# language TupleSections #-}
module Rel8.Query.Evaluate
( evaluate
, rebind
)
where
import Control.Monad ( (>=>) )
import Data.Foldable ( foldl' )
import Data.List.NonEmpty ( NonEmpty( (:|) ), nonEmpty )
import Data.Monoid ( Any( Any ) )
import Prelude hiding ( undefined )
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import qualified Opaleye.Internal.PackMap as Opaleye
import qualified Opaleye.Internal.PrimQuery as Opaleye
import qualified Opaleye.Internal.QueryArr as Opaleye
import qualified Opaleye.Internal.Tag as Opaleye
import qualified Opaleye.Internal.Unpackspec as Opaleye
import Rel8.Expr ( Expr )
import Rel8.Expr.Bool ( (&&.) )
import Rel8.Expr.Opaleye ( fromPrimExpr )
import Rel8.Query ( Query( Query ) )
import Rel8.Table ( Table )
import Rel8.Table.Bool ( case_ )
import Rel8.Table.Opaleye ( unpackspec )
import Rel8.Table.Undefined
evaluate :: Table Expr a => a -> Query a
evaluate :: a -> Query a
evaluate = a -> Query a
forall a. Table Expr a => a -> Query a
laterally (a -> Query a) -> (a -> Query a) -> a -> Query a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Query a
forall a. Table Expr a => a -> Query a
rebind
laterally :: Table Expr a => a -> Query a
laterally :: a -> Query a
laterally a
a = ([PrimExpr] -> Select (Any, a)) -> Query a
forall a. ([PrimExpr] -> Select (Any, a)) -> Query a
Query (([PrimExpr] -> Select (Any, a)) -> Query a)
-> ([PrimExpr] -> Select (Any, a)) -> Query a
forall a b. (a -> b) -> a -> b
$ \[PrimExpr]
bindings -> (Any, a) -> Select (Any, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Any, a) -> Select (Any, a)) -> (Any, a) -> Select (Any, a)
forall a b. (a -> b) -> a -> b
$ (Bool -> Any
Any Bool
True,) (a -> (Any, a)) -> a -> (Any, a)
forall a b. (a -> b) -> a -> b
$
case [PrimExpr] -> Maybe (NonEmpty PrimExpr)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [PrimExpr]
bindings of
Maybe (NonEmpty PrimExpr)
Nothing -> a
a
Just NonEmpty PrimExpr
bindings' -> [(Expr Bool, a)] -> a -> a
forall a. Table Expr a => [(Expr Bool, a)] -> a -> a
case_ [(Expr Bool
condition, a
a)] a
forall a. Table Expr a => a
undefined
where
condition :: Expr Bool
condition = (Expr Bool -> Expr Bool -> Expr Bool)
-> NonEmpty (Expr Bool) -> Expr Bool
forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' Expr Bool -> Expr Bool -> Expr Bool
(&&.) ((PrimExpr -> Expr Bool)
-> NonEmpty PrimExpr -> NonEmpty (Expr Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrimExpr -> Expr Bool
forall a. PrimExpr -> Expr a
go NonEmpty PrimExpr
bindings')
where
go :: PrimExpr -> Expr a
go = PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a)
-> (PrimExpr -> PrimExpr) -> PrimExpr -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr UnOp
Opaleye.OpIsNotNull
rebind :: Table Expr a => a -> Query a
rebind :: a -> Query a
rebind a
a = ([PrimExpr] -> Select (Any, a)) -> Query a
forall a. ([PrimExpr] -> Select (Any, a)) -> Query a
Query (([PrimExpr] -> Select (Any, a)) -> Query a)
-> ([PrimExpr] -> Select (Any, a)) -> Query a
forall a b. (a -> b) -> a -> b
$ \[PrimExpr]
_ -> (((), Tag) -> ((Any, a), Lateral -> PrimQuery -> PrimQuery, Tag))
-> Select (Any, a)
forall a b.
((a, Tag) -> (b, Lateral -> PrimQuery -> PrimQuery, Tag))
-> SelectArr a b
Opaleye.QueryArr ((((), Tag) -> ((Any, a), Lateral -> PrimQuery -> PrimQuery, Tag))
-> Select (Any, a))
-> (((), Tag)
-> ((Any, a), Lateral -> PrimQuery -> PrimQuery, Tag))
-> Select (Any, a)
forall a b. (a -> b) -> a -> b
$ \(()
_, Tag
tag) ->
let
tag' :: Tag
tag' = Tag -> Tag
Opaleye.next Tag
tag
(a
a', [(Symbol, PrimExpr)]
bindings) = PM [(Symbol, PrimExpr)] a -> (a, [(Symbol, PrimExpr)])
forall a r. PM [a] r -> (r, [a])
Opaleye.run (PM [(Symbol, PrimExpr)] a -> (a, [(Symbol, PrimExpr)]))
-> PM [(Symbol, PrimExpr)] a -> (a, [(Symbol, PrimExpr)])
forall a b. (a -> b) -> a -> b
$
Unpackspec a a
-> (PrimExpr
-> StateT ([(Symbol, PrimExpr)], Int) Identity PrimExpr)
-> a
-> PM [(Symbol, PrimExpr)] a
forall (f :: * -> *) columns b.
Applicative f =>
Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
Opaleye.runUnpackspec Unpackspec a a
forall a. Table Expr a => Unpackspec a a
unpackspec (String
-> Tag
-> PrimExpr
-> StateT ([(Symbol, PrimExpr)], Int) Identity PrimExpr
forall primExpr.
String -> Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
Opaleye.extractAttr String
"eval" Tag
tag) a
a
in
((Any
forall a. Monoid a => a
mempty, a
a'), \Lateral
_ -> Bool -> [(Symbol, PrimExpr)] -> PrimQuery -> PrimQuery
forall a.
Bool -> [(Symbol, PrimExpr)] -> PrimQuery' a -> PrimQuery' a
Opaleye.Rebind Bool
True [(Symbol, PrimExpr)]
bindings, Tag
tag')
foldl1' :: (a -> a -> a) -> NonEmpty a -> a
foldl1' :: (a -> a -> a) -> NonEmpty a -> a
foldl1' a -> a -> a
f (a
a :| [a]
as) = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
f a
a [a]
as