{-# 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
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), Lateral -> PrimQuery -> PrimQuery, Tag))
-> Select (Any, b)
forall a b.
((a, Tag) -> (b, Lateral -> PrimQuery -> PrimQuery, Tag))
-> SelectArr a b
Opaleye.QueryArr ((((), Tag) -> ((Any, b), Lateral -> PrimQuery -> PrimQuery, Tag))
-> Select (Any, b))
-> (((), Tag)
-> ((Any, b), Lateral -> PrimQuery -> PrimQuery, Tag))
-> Select (Any, b)
forall a b. (a -> b) -> a -> b
$ \(()
_, Tag
tag) ->
let
Opaleye.QueryArr ((), Tag) -> ((Any, a), Lateral -> PrimQuery -> PrimQuery, Tag)
qa = [PrimExpr] -> Select (Any, a)
q [PrimExpr]
dummies
((Any
m, a
a), Lateral -> PrimQuery -> PrimQuery
query, Tag
tag') = ((), Tag) -> ((Any, a), Lateral -> PrimQuery -> PrimQuery, Tag)
qa ((), Tag
tag)
Query [PrimExpr] -> Select (Any, b)
q' = a -> Query b
f a
a
([PrimExpr]
dummies', Lateral -> PrimQuery -> PrimQuery
query', Tag
tag'') =
( PrimExpr
dummy PrimExpr -> [PrimExpr] -> [PrimExpr]
forall a. a -> [a] -> [a]
: [PrimExpr]
dummies
, \Lateral
lateral -> Bool -> Bindings PrimExpr -> PrimQuery -> PrimQuery
forall a. Bool -> Bindings PrimExpr -> PrimQuery' a -> PrimQuery' a
Opaleye.Rebind Bool
True Bindings PrimExpr
bindings (PrimQuery -> PrimQuery)
-> (PrimQuery -> PrimQuery) -> PrimQuery -> PrimQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lateral -> PrimQuery -> PrimQuery
query Lateral
lateral
, 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'
Opaleye.QueryArr (a, Tag) -> ((Any, b), Lateral -> PrimQuery -> PrimQuery, Tag)
qa' = (a -> Select (Any, b)) -> SelectArr a (Any, b)
forall i a. (i -> Select a) -> SelectArr i a
Opaleye.lateral ((a -> Select (Any, b)) -> SelectArr a (Any, b))
-> (a -> Select (Any, b)) -> SelectArr a (Any, b)
forall a b. (a -> b) -> a -> b
$ \a
_ -> [PrimExpr] -> Select (Any, b)
q' [PrimExpr]
dummies'
((m' :: Any
m'@(Any Bool
needsDummies), b
b), Lateral -> PrimQuery -> PrimQuery
query'', Tag
tag''') = ((), Tag) -> ((Any, b), Lateral -> PrimQuery -> PrimQuery, Tag)
forall a.
(a, Tag) -> ((Any, b), Lateral -> PrimQuery -> PrimQuery, Tag)
qa' ((), Tag
tag'')
query''' :: Lateral -> PrimQuery -> PrimQuery
query'''
| Bool
needsDummies = \Lateral
lateral -> Lateral -> PrimQuery -> PrimQuery
query'' Lateral
lateral (PrimQuery -> PrimQuery)
-> (PrimQuery -> PrimQuery) -> PrimQuery -> PrimQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lateral -> PrimQuery -> PrimQuery
query' Lateral
lateral
| Bool
otherwise = \Lateral
lateral -> Lateral -> PrimQuery -> PrimQuery
query'' Lateral
lateral (PrimQuery -> PrimQuery)
-> (PrimQuery -> PrimQuery) -> PrimQuery -> PrimQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lateral -> PrimQuery -> PrimQuery
query Lateral
lateral
m'' :: Any
m'' = Any
m Any -> Any -> Any
forall a. Semigroup a => a -> a -> a
<> Any
m'
in
((Any
m'', b
b), Lateral -> PrimQuery -> PrimQuery
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 []