{-# language FlexibleContexts #-}
{-# language StandaloneKindSignatures #-}
{-# language UndecidableInstances #-}
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.Expr ( Expr )
import Rel8.Query.Set ( unionAll )
import Rel8.Query.Opaleye ( fromOpaleye )
import Rel8.Query.Values ( values )
import Rel8.Table ( 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 :: forall a b. Projecting a b => Projection a b -> Query a -> Query b
project Projection a b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b (context :: * -> *).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection a b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
instance Functor Query where
fmap :: forall a b. (a -> b) -> Query a -> Query b
fmap a -> b
f (Query [PrimExpr] -> Select (Any, a)
a) = forall a. ([PrimExpr] -> Select (Any, a)) -> Query a
Query (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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
<.> :: forall a 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 :: forall a. a -> Query a
pure = forall a. Select a -> Query a
fromOpaleye forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
liftA2 :: forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
liftA2 = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2
instance Bind Query where
>>- :: forall a 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 >>= :: forall a b. Query a -> (a -> Query b) -> Query b
>>= a -> Query b
f = forall a. ([PrimExpr] -> Select (Any, a)) -> Query a
Query forall a b. (a -> b) -> a -> b
$ \[PrimExpr]
dummies -> forall a b. (a -> Tag -> (b, PrimQueryArr, Tag)) -> QueryArr a b
Opaleye.stateQueryArr 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') = 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 forall a. a -> [a] -> [a]
: [PrimExpr]
dummies
, PrimQueryArr
query 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) = forall a r. PM [a] r -> (r, [a])
Opaleye.run forall a b. (a -> b) -> a -> b
$ 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 = forall primExpr.
Name -> Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
Opaleye.extractAttr Name
"dummy" Tag
tag'
qa' :: SelectArr i (Any, b)
qa' = forall i a. (i -> Select a) -> SelectArr i a
Opaleye.lateral 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''') = forall a b. QueryArr a b -> a -> Tag -> (b, PrimQueryArr, Tag)
Opaleye.runStateQueryArr forall {i}. SelectArr i (Any, b)
qa' () Tag
tag''
query''' :: PrimQueryArr
query'''
| Bool
needsDummies = PrimQueryArr
query' forall a. Semigroup a => a -> a -> a
<> PrimQueryArr
query''
| Bool
otherwise = PrimQueryArr
query forall a. Semigroup a => a -> a -> a
<> PrimQueryArr
query''
m'' :: Any
m'' = Any
m forall a. Semigroup a => a -> a -> a
<> Any
m'
in
((Any
m'', b
b), PrimQueryArr
query''', Tag
tag''')
instance AltTable Query where
<|>: :: forall a. Table Expr a => Query a -> Query a -> Query a
(<|>:) = forall a. Table Expr a => Query a -> Query a -> Query a
unionAll
instance AlternativeTable Query where
emptyTable :: forall a. Table Expr a => Query a
emptyTable = forall a (f :: * -> *).
(Table Expr a, Foldable f) =>
f a -> Query a
values []
instance Table Expr a => Semigroup (Query a) where
<> :: Query a -> Query a -> Query a
(<>) = forall (f :: * -> *) a.
(AltTable f, Table Expr a) =>
f a -> f a -> f a
(<|>:)
instance Table Expr a => Monoid (Query a) where
mempty :: Query a
mempty = forall (f :: * -> *) a. (AlternativeTable f, Table Expr a) => f a
emptyTable