{-# language DerivingStrategies #-}
{-# language FlexibleContexts #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language NamedFieldPuns #-}
{-# language StandaloneKindSignatures #-}
module Rel8.Query.Evaluate
( Evaluate
, eval
, evaluate
)
where
import Data.Kind ( Type )
import Data.Monoid ( Endo ( Endo ), appEndo )
import Prelude
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.Query ( Query( Query ) )
import Rel8.Table ( Table )
import Rel8.Table.Opaleye ( unpackspec )
import Data.Functor.Apply ( Apply )
import Data.Functor.Bind ( Bind, (>>-) )
import Control.Monad.Trans.State.Strict ( State, get, put, runState )
type Evaluations :: Type
data Evaluations = Evaluations
{ Evaluations -> Tag
tag :: !Opaleye.Tag
, Evaluations -> Endo (Bindings PrimExpr)
bindings :: !(Endo (Opaleye.Bindings Opaleye.PrimExpr))
}
type Evaluate :: Type -> Type
newtype Evaluate a = Evaluate (State Evaluations a)
deriving newtype (a -> Evaluate b -> Evaluate a
(a -> b) -> Evaluate a -> Evaluate b
(forall a b. (a -> b) -> Evaluate a -> Evaluate b)
-> (forall a b. a -> Evaluate b -> Evaluate a) -> Functor Evaluate
forall a b. a -> Evaluate b -> Evaluate a
forall a b. (a -> b) -> Evaluate a -> Evaluate b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Evaluate b -> Evaluate a
$c<$ :: forall a b. a -> Evaluate b -> Evaluate a
fmap :: (a -> b) -> Evaluate a -> Evaluate b
$cfmap :: forall a b. (a -> b) -> Evaluate a -> Evaluate b
Functor, Functor Evaluate
Functor Evaluate
-> (forall a b. Evaluate (a -> b) -> Evaluate a -> Evaluate b)
-> (forall a b. Evaluate a -> Evaluate b -> Evaluate b)
-> (forall a b. Evaluate a -> Evaluate b -> Evaluate a)
-> (forall a b c.
(a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c)
-> Apply Evaluate
Evaluate a -> Evaluate b -> Evaluate b
Evaluate a -> Evaluate b -> Evaluate a
Evaluate (a -> b) -> Evaluate a -> Evaluate b
(a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c
forall a b. Evaluate a -> Evaluate b -> Evaluate a
forall a b. Evaluate a -> Evaluate b -> Evaluate b
forall a b. Evaluate (a -> b) -> Evaluate a -> Evaluate b
forall a b c.
(a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c
forall (f :: * -> *).
Functor f
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> Apply f
liftF2 :: (a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c
$cliftF2 :: forall a b c.
(a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c
<. :: Evaluate a -> Evaluate b -> Evaluate a
$c<. :: forall a b. Evaluate a -> Evaluate b -> Evaluate a
.> :: Evaluate a -> Evaluate b -> Evaluate b
$c.> :: forall a b. Evaluate a -> Evaluate b -> Evaluate b
<.> :: Evaluate (a -> b) -> Evaluate a -> Evaluate b
$c<.> :: forall a b. Evaluate (a -> b) -> Evaluate a -> Evaluate b
$cp1Apply :: Functor Evaluate
Apply, Functor Evaluate
a -> Evaluate a
Functor Evaluate
-> (forall a. a -> Evaluate a)
-> (forall a b. Evaluate (a -> b) -> Evaluate a -> Evaluate b)
-> (forall a b c.
(a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c)
-> (forall a b. Evaluate a -> Evaluate b -> Evaluate b)
-> (forall a b. Evaluate a -> Evaluate b -> Evaluate a)
-> Applicative Evaluate
Evaluate a -> Evaluate b -> Evaluate b
Evaluate a -> Evaluate b -> Evaluate a
Evaluate (a -> b) -> Evaluate a -> Evaluate b
(a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c
forall a. a -> Evaluate a
forall a b. Evaluate a -> Evaluate b -> Evaluate a
forall a b. Evaluate a -> Evaluate b -> Evaluate b
forall a b. Evaluate (a -> b) -> Evaluate a -> Evaluate b
forall a b c.
(a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Evaluate a -> Evaluate b -> Evaluate a
$c<* :: forall a b. Evaluate a -> Evaluate b -> Evaluate a
*> :: Evaluate a -> Evaluate b -> Evaluate b
$c*> :: forall a b. Evaluate a -> Evaluate b -> Evaluate b
liftA2 :: (a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c
<*> :: Evaluate (a -> b) -> Evaluate a -> Evaluate b
$c<*> :: forall a b. Evaluate (a -> b) -> Evaluate a -> Evaluate b
pure :: a -> Evaluate a
$cpure :: forall a. a -> Evaluate a
$cp1Applicative :: Functor Evaluate
Applicative, Applicative Evaluate
a -> Evaluate a
Applicative Evaluate
-> (forall a b. Evaluate a -> (a -> Evaluate b) -> Evaluate b)
-> (forall a b. Evaluate a -> Evaluate b -> Evaluate b)
-> (forall a. a -> Evaluate a)
-> Monad Evaluate
Evaluate a -> (a -> Evaluate b) -> Evaluate b
Evaluate a -> Evaluate b -> Evaluate b
forall a. a -> Evaluate a
forall a b. Evaluate a -> Evaluate b -> Evaluate b
forall a b. Evaluate a -> (a -> Evaluate b) -> Evaluate b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Evaluate a
$creturn :: forall a. a -> Evaluate a
>> :: Evaluate a -> Evaluate b -> Evaluate b
$c>> :: forall a b. Evaluate a -> Evaluate b -> Evaluate b
>>= :: Evaluate a -> (a -> Evaluate b) -> Evaluate b
$c>>= :: forall a b. Evaluate a -> (a -> Evaluate b) -> Evaluate b
$cp1Monad :: Applicative Evaluate
Monad)
instance Bind Evaluate where
>>- :: Evaluate a -> (a -> Evaluate b) -> Evaluate b
(>>-) = Evaluate a -> (a -> Evaluate b) -> Evaluate b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
eval :: Table Expr a => a -> Evaluate a
eval :: a -> Evaluate a
eval a
a = State Evaluations a -> Evaluate a
forall a. State Evaluations a -> Evaluate a
Evaluate (State Evaluations a -> Evaluate a)
-> State Evaluations a -> Evaluate a
forall a b. (a -> b) -> a -> b
$ do
Evaluations {Tag
tag :: Tag
tag :: Evaluations -> Tag
tag, Endo (Bindings PrimExpr)
bindings :: Endo (Bindings PrimExpr)
bindings :: Evaluations -> Endo (Bindings PrimExpr)
bindings} <- StateT Evaluations Identity Evaluations
forall (m :: * -> *) s. Monad m => StateT s m s
get
let
tag' :: Tag
tag' = Tag -> Tag
Opaleye.next Tag
tag
(a
a', Bindings PrimExpr
bindings') = PM (Bindings PrimExpr) a -> (a, Bindings PrimExpr)
forall a r. PM [a] r -> (r, [a])
Opaleye.run (PM (Bindings PrimExpr) a -> (a, Bindings PrimExpr))
-> PM (Bindings PrimExpr) a -> (a, Bindings PrimExpr)
forall a b. (a -> b) -> a -> b
$
Unpackspec a a
-> (PrimExpr -> StateT (Bindings PrimExpr, Int) Identity PrimExpr)
-> a
-> PM (Bindings 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 (Bindings PrimExpr, Int) Identity PrimExpr
forall primExpr.
String -> Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
Opaleye.extractAttr String
"eval" Tag
tag') a
a
Evaluations -> StateT Evaluations Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Evaluations :: Tag -> Endo (Bindings PrimExpr) -> Evaluations
Evaluations {tag :: Tag
tag = Tag
tag', bindings :: Endo (Bindings PrimExpr)
bindings = Endo (Bindings PrimExpr)
bindings Endo (Bindings PrimExpr)
-> Endo (Bindings PrimExpr) -> Endo (Bindings PrimExpr)
forall a. Semigroup a => a -> a -> a
<> (Bindings PrimExpr -> Bindings PrimExpr)
-> Endo (Bindings PrimExpr)
forall a. (a -> a) -> Endo a
Endo (Bindings PrimExpr
bindings' Bindings PrimExpr -> Bindings PrimExpr -> Bindings PrimExpr
forall a. [a] -> [a] -> [a]
++)}
a -> State Evaluations a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a'
evaluate :: Evaluate a -> Query a
evaluate :: Evaluate a -> Query a
evaluate (Evaluate State Evaluations a
m) = Select a -> Query a
forall a. Select a -> Query a
Query (Select a -> Query a) -> Select a -> Query a
forall a b. (a -> b) -> a -> b
$ (((), PrimQuery, Tag) -> (a, PrimQuery, Tag)) -> Select a
forall a b.
((a, PrimQuery, Tag) -> (b, PrimQuery, Tag)) -> SelectArr a b
Opaleye.QueryArr ((((), PrimQuery, Tag) -> (a, PrimQuery, Tag)) -> Select a)
-> (((), PrimQuery, Tag) -> (a, PrimQuery, Tag)) -> Select a
forall a b. (a -> b) -> a -> b
$ \(()
_, PrimQuery
query, Tag
tag) ->
case State Evaluations a -> Evaluations -> (a, Evaluations)
forall s a. State s a -> s -> (a, s)
runState State Evaluations a
m (Tag -> Endo (Bindings PrimExpr) -> Evaluations
Evaluations Tag
tag Endo (Bindings PrimExpr)
forall a. Monoid a => a
mempty) of
(a
a, Evaluations {tag :: Evaluations -> Tag
tag = Tag
tag', Endo (Bindings PrimExpr)
bindings :: Endo (Bindings PrimExpr)
bindings :: Evaluations -> Endo (Bindings PrimExpr)
bindings}) ->
(a
a, Bool -> Bindings PrimExpr -> PrimQuery -> PrimQuery
forall a. Bool -> Bindings PrimExpr -> PrimQuery' a -> PrimQuery' a
Opaleye.Rebind Bool
True (Endo (Bindings PrimExpr) -> Bindings PrimExpr -> Bindings PrimExpr
forall a. Endo a -> a -> a
appEndo Endo (Bindings PrimExpr)
bindings Bindings PrimExpr
forall a. Monoid a => a
mempty) PrimQuery
query, Tag
tag')