{-# language StandaloneKindSignatures #-}
module Rel8.Query
( Query( Query )
)
where
import Control.Applicative ( liftA2 )
import Control.Monad ( liftM2 )
import Data.Kind ( Type )
import Data.Monoid ( Any( Any ) )
import Prelude
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import qualified Opaleye.Internal.PackMap as Opaleye
import qualified Opaleye.Internal.PrimQuery as Opaleye hiding (lateral)
import qualified Opaleye.Internal.QueryArr as Opaleye
import qualified Opaleye.Internal.Tag as Opaleye
import Rel8.Query.Set ( unionAll )
import Rel8.Query.Opaleye ( fromOpaleye )
import Rel8.Query.Values ( values )
import Rel8.Table ( fromColumns, toColumns )
import Rel8.Table.Alternative
( AltTable, (<|>:)
, AlternativeTable, emptyTable
)
import Rel8.Table.Projection ( Projectable, apply, project )
import Data.Functor.Apply ( Apply, (<.>) )
import Data.Functor.Bind ( Bind, (>>-) )
type Query :: Type -> Type
newtype Query a =
Query (
[Opaleye.PrimExpr] -> Opaleye.Select (Any, a)
)
instance Projectable Query where
project :: Projection a b -> Query a -> Query b
project Projection a b
f = (a -> b) -> Query a -> Query b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Columns (Transpose (Field a) b) (Context b) -> b
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Columns (Transpose (Field a) b) (Context b) -> b)
-> (a -> Columns (Transpose (Field a) b) (Context b)) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Projection a b -> Columns a (Context b) -> Columns b (Context b)
forall a b (context :: * -> *).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection a b
f (Columns a (Context b)
-> Columns (Transpose (Field a) b) (Context b))
-> (a -> Columns a (Context b))
-> a
-> Columns (Transpose (Field a) b) (Context b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Columns a (Context b)
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
instance Functor Query where
fmap :: (a -> b) -> Query a -> Query b
fmap a -> b
f (Query [PrimExpr] -> Select (Any, a)
a) = ([PrimExpr] -> Select (Any, b)) -> Query b
forall a. ([PrimExpr] -> Select (Any, a)) -> Query a
Query ((Select (Any, a) -> Select (Any, b))
-> ([PrimExpr] -> Select (Any, a)) -> [PrimExpr] -> Select (Any, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Any, a) -> (Any, b)) -> Select (Any, a) -> Select (Any, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (Any, a) -> (Any, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) [PrimExpr] -> Select (Any, a)
a)
instance Apply Query where
<.> :: Query (a -> b) -> Query a -> Query b
(<.>) = Query (a -> b) -> Query a -> Query b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
instance Applicative Query where
pure :: a -> Query a
pure = Select a -> Query a
forall a. Select a -> Query a
fromOpaleye (Select a -> Query a) -> (a -> Select a) -> a -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Select a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
liftA2 :: (a -> b -> c) -> Query a -> Query b -> Query c
liftA2 = (a -> b -> c) -> Query a -> Query b -> Query c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2
instance Bind Query where
>>- :: Query a -> (a -> Query b) -> Query b
(>>-) = Query a -> (a -> Query b) -> Query b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Monad Query where
Query [PrimExpr] -> Select (Any, a)
q >>= :: Query a -> (a -> Query b) -> Query b
>>= a -> Query b
f = ([PrimExpr] -> Select (Any, b)) -> Query b
forall a. ([PrimExpr] -> Select (Any, a)) -> Query a
Query (([PrimExpr] -> Select (Any, b)) -> Query b)
-> ([PrimExpr] -> Select (Any, b)) -> Query b
forall a b. (a -> b) -> a -> b
$ \[PrimExpr]
dummies -> (() -> Tag -> ((Any, b), PrimQueryArr, Tag)) -> Select (Any, b)
forall a b. (a -> Tag -> (b, PrimQueryArr, Tag)) -> QueryArr a b
Opaleye.stateQueryArr ((() -> Tag -> ((Any, b), PrimQueryArr, Tag)) -> Select (Any, b))
-> (() -> Tag -> ((Any, b), PrimQueryArr, Tag)) -> Select (Any, b)
forall a b. (a -> b) -> a -> b
$ \()
_ Tag
tag ->
let
qa :: Select (Any, a)
qa = [PrimExpr] -> Select (Any, a)
q [PrimExpr]
dummies
((Any
m, a
a), PrimQueryArr
query, Tag
tag') = Select (Any, a) -> () -> Tag -> ((Any, a), PrimQueryArr, Tag)
forall a b. QueryArr a b -> a -> Tag -> (b, PrimQueryArr, Tag)
Opaleye.runStateQueryArr Select (Any, a)
qa () Tag
tag
Query [PrimExpr] -> Select (Any, b)
q' = a -> Query b
f a
a
([PrimExpr]
dummies', PrimQueryArr
query', Tag
tag'') =
( PrimExpr
dummy PrimExpr -> [PrimExpr] -> [PrimExpr]
forall a. a -> [a] -> [a]
: [PrimExpr]
dummies
, PrimQueryArr
query PrimQueryArr -> PrimQueryArr -> PrimQueryArr
forall a. Semigroup a => a -> a -> a
<> Bindings PrimExpr -> PrimQueryArr
Opaleye.aRebind Bindings PrimExpr
bindings
, Tag -> Tag
Opaleye.next Tag
tag'
)
where
(PrimExpr
dummy, Bindings PrimExpr
bindings) = PM (Bindings PrimExpr) PrimExpr -> (PrimExpr, Bindings PrimExpr)
forall a r. PM [a] r -> (r, [a])
Opaleye.run (PM (Bindings PrimExpr) PrimExpr -> (PrimExpr, Bindings PrimExpr))
-> PM (Bindings PrimExpr) PrimExpr -> (PrimExpr, Bindings PrimExpr)
forall a b. (a -> b) -> a -> b
$ PrimExpr -> PM (Bindings PrimExpr) PrimExpr
forall primExpr. primExpr -> PM [(Symbol, primExpr)] PrimExpr
name PrimExpr
random
where
random :: PrimExpr
random = Name -> [PrimExpr] -> PrimExpr
Opaleye.FunExpr Name
"random" []
name :: primExpr -> PM [(Symbol, primExpr)] PrimExpr
name = Name -> Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
forall primExpr.
Name -> Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
Opaleye.extractAttr Name
"dummy" Tag
tag'
qa' :: SelectArr i (Any, b)
qa' = (i -> Select (Any, b)) -> SelectArr i (Any, b)
forall i a. (i -> Select a) -> SelectArr i a
Opaleye.lateral ((i -> Select (Any, b)) -> SelectArr i (Any, b))
-> (i -> Select (Any, b)) -> SelectArr i (Any, b)
forall a b. (a -> b) -> a -> b
$ \i
_ -> [PrimExpr] -> Select (Any, b)
q' [PrimExpr]
dummies'
((m' :: Any
m'@(Any Bool
needsDummies), b
b), PrimQueryArr
query'', Tag
tag''') = Select (Any, b) -> () -> Tag -> ((Any, b), PrimQueryArr, Tag)
forall a b. QueryArr a b -> a -> Tag -> (b, PrimQueryArr, Tag)
Opaleye.runStateQueryArr Select (Any, b)
forall i. SelectArr i (Any, b)
qa' () Tag
tag''
query''' :: PrimQueryArr
query'''
| Bool
needsDummies = PrimQueryArr
query' PrimQueryArr -> PrimQueryArr -> PrimQueryArr
forall a. Semigroup a => a -> a -> a
<> PrimQueryArr
query''
| Bool
otherwise = PrimQueryArr
query PrimQueryArr -> PrimQueryArr -> PrimQueryArr
forall a. Semigroup a => a -> a -> a
<> PrimQueryArr
query''
m'' :: Any
m'' = Any
m Any -> Any -> Any
forall a. Semigroup a => a -> a -> a
<> Any
m'
in
((Any
m'', b
b), PrimQueryArr
query''', Tag
tag''')
instance AltTable Query where
<|>: :: Query a -> Query a -> Query a
(<|>:) = Query a -> Query a -> Query a
forall a. Table Expr a => Query a -> Query a -> Query a
unionAll
instance AlternativeTable Query where
emptyTable :: Query a
emptyTable = [a] -> Query a
forall a (f :: * -> *).
(Table Expr a, Foldable f) =>
f a -> Query a
values []