{-# LANGUAGE FlexibleContexts, OverloadedStrings, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Database.Selda.Query
( select, selectValues, Database.Selda.Query.distinct
, restrict, groupBy, limit, order, orderRandom
, aggregate, leftJoin, innerJoin, union, unionAll
) where
import Data.Maybe (isNothing)
import Database.Selda.Column
( NulOp(Fun0),
Exp(Lit, Col, NulOp),
SomeCol(Some, Named),
hideRenaming,
Same,
Row(..),
Col(..),
Columns(..) )
import Database.Selda.Generic ( gNew, Relational, params )
import Database.Selda.Inner
( Aggregates(..),
LeftCols,
AggrCols,
OuterCols,
Inner,
Aggr(Aggr) )
import Database.Selda.Query.Type
( GenState(staticRestricts, groupCols, sources),
Query(..),
isolate,
renameAll,
freshName )
import Database.Selda.SQL as SQL
( Param(Param),
Order(Asc),
SQL(liveExtras, cols, restricts, groups, limits, ordering,
distinct),
JoinType(..),
SqlSource(Product, TableName, EmptyTable, Values, Union, Join),
sqlFrom )
import Database.Selda.SqlType (SqlType)
import Database.Selda.Table.Type ( ColInfo(colExpr), Table(Table) )
import Database.Selda.Transform ( colNames, state2sql, allCols )
import Control.Monad.State.Strict ( MonadState(put, get), modify )
import Data.Proxy ( Proxy(..) )
import GHC.Generics (Rep)
import Unsafe.Coerce ( unsafeCoerce )
select :: Relational a => Table a -> Query s (Row s a)
select :: forall a s. Relational a => Table a -> Query s (Row s a)
select (Table TableName
name [ColInfo]
cs Bool
_ [([Int], ColAttr)]
_) = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
[SomeCol SQL]
rns <- forall sql. [UntypedCol sql] -> State GenState [SomeCol sql]
renameAll forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ColInfo -> UntypedCol SQL
colExpr [ColInfo]
cs
GenState
st <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ GenState
st {sources :: [SQL]
sources = [SomeCol SQL] -> SqlSource -> SQL
sqlFrom [SomeCol SQL]
rns (TableName -> SqlSource
TableName TableName
name) forall a. a -> [a] -> [a]
: GenState -> [SQL]
sources GenState
st}
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} {k} (s :: k) (a :: k). [UntypedCol SQL] -> Row s a
Many (forall a b. (a -> b) -> [a] -> [b]
map forall sql. SomeCol sql -> UntypedCol sql
hideRenaming [SomeCol SQL]
rns)
selectValues :: forall s a. Relational a => [a] -> Query s (Row s a)
selectValues :: forall s a. Relational a => [a] -> Query s (Row s a)
selectValues [] = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
GenState
st <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ GenState
st {sources :: [SQL]
sources = [SomeCol SQL] -> SqlSource -> SQL
sqlFrom [] SqlSource
EmptyTable forall a. a -> [a] -> [a]
: GenState -> [SQL]
sources GenState
st}
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} {k} (s :: k) (a :: k). [UntypedCol SQL] -> Row s a
Many (forall (f :: * -> *) sql.
GRelation f =>
Proxy f -> [UntypedCol sql]
gNew (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep a)))
selectValues (a
row:[a]
rows) = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
[ColName]
names <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b. a -> b -> a
const State GenState ColName
freshName) [Param]
firstrow
let rns :: [SomeCol sql]
rns = [forall sql a. ColName -> Exp sql a -> SomeCol sql
Named ColName
n (forall sql a. ColName -> Exp sql a
Col ColName
n) | ColName
n <- [ColName]
names]
row' :: [SomeCol sql]
row' = forall {sql}. [ColName] -> [SomeCol sql]
mkFirstRow [ColName]
names
GenState
s <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ GenState
s {sources :: [SQL]
sources = [SomeCol SQL] -> SqlSource -> SQL
sqlFrom forall {sql}. [SomeCol sql]
rns ([SomeCol SQL] -> [[Param]] -> SqlSource
Values forall {sql}. [SomeCol sql]
row' [[Param]]
rows') forall a. a -> [a] -> [a]
: GenState -> [SQL]
sources GenState
s}
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} {k} (s :: k) (a :: k). [UntypedCol SQL] -> Row s a
Many (forall a b. (a -> b) -> [a] -> [b]
map forall sql. SomeCol sql -> UntypedCol sql
hideRenaming forall {sql}. [SomeCol sql]
rns)
where
firstrow :: [Param]
firstrow = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Either a a -> a
defToVal forall a b. (a -> b) -> a -> b
$ forall a. Relational a => a -> [Either Param Param]
params a
row
mkFirstRow :: [ColName] -> [SomeCol sql]
mkFirstRow [ColName]
ns =
[ forall sql a. ColName -> Exp sql a -> SomeCol sql
Named ColName
n (forall a sql. Lit a -> Exp sql a
Lit Lit a
l)
| (Param Lit a
l, ColName
n) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Param]
firstrow [ColName]
ns
]
rows' :: [[Param]]
rows' = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Either a a -> a
defToVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Relational a => a -> [Either Param Param]
params) [a]
rows
defToVal :: Either a a -> a
defToVal (Left a
x) = a
x
defToVal (Right a
x) = a
x
internalUnion :: (Columns a, Columns (OuterCols a))
=> Bool
-> Query (Inner s) a
-> Query (Inner s) a
-> Query s (OuterCols a)
internalUnion :: forall a s.
(Columns a, Columns (OuterCols a)) =>
Bool
-> Query (Inner s) a -> Query (Inner s) a -> Query s (OuterCols a)
internalUnion Bool
union_all Query (Inner s) a
a Query (Inner s) a
b = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
(GenState
st_a, a
cols_a) <- forall s a. Query s a -> State GenState (GenState, a)
isolate Query (Inner s) a
a
(GenState
st_b, a
cols_b) <- forall s a. Query s a -> State GenState (GenState, a)
isolate Query (Inner s) a
b
[SomeCol SQL]
renamed_a <- forall sql. [UntypedCol sql] -> State GenState [SomeCol sql]
renameAll (forall a. Columns a => a -> [UntypedCol SQL]
fromTup a
cols_a)
[SomeCol SQL]
renamed_b <- forall sql. [UntypedCol sql] -> State GenState [SomeCol sql]
renameAll (forall a. Columns a => a -> [UntypedCol SQL]
fromTup a
cols_b)
let sql_a :: SQL
sql_a = ([SomeCol SQL] -> SqlSource -> SQL
sqlFrom [SomeCol SQL]
renamed_a ([SQL] -> SqlSource
Product [GenState -> SQL
state2sql GenState
st_a])) {liveExtras :: [SomeCol SQL]
liveExtras = [SomeCol SQL]
renamed_a}
sql_b :: SQL
sql_b = ([SomeCol SQL] -> SqlSource -> SQL
sqlFrom [SomeCol SQL]
renamed_b ([SQL] -> SqlSource
Product [GenState -> SQL
state2sql GenState
st_b])) {liveExtras :: [SomeCol SQL]
liveExtras = [SomeCol SQL]
renamed_b}
out_col_names :: [ColName]
out_col_names = [ColName
n | Named ColName
n Exp SQL a
_ <- [SomeCol SQL]
renamed_a]
out_cols :: [SomeCol sql]
out_cols = forall a b. (a -> b) -> [a] -> [b]
map (forall sql a. Exp sql a -> SomeCol sql
Some forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sql a. ColName -> Exp sql a
Col) [ColName]
out_col_names
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \GenState
st ->
GenState
st {sources :: [SQL]
sources = [SomeCol SQL] -> SqlSource -> SQL
sqlFrom forall {sql}. [SomeCol sql]
out_cols (Bool -> SQL -> SQL -> SqlSource
Union Bool
union_all SQL
sql_a SQL
sql_b) forall a. a -> [a] -> [a]
: GenState -> [SQL]
sources GenState
st}
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Columns a => [ColName] -> a
toTup [ColName]
out_col_names)
union :: (Columns a, Columns (OuterCols a))
=> Query (Inner s) a
-> Query (Inner s) a
-> Query s (OuterCols a)
union :: forall a s.
(Columns a, Columns (OuterCols a)) =>
Query (Inner s) a -> Query (Inner s) a -> Query s (OuterCols a)
union = forall a s.
(Columns a, Columns (OuterCols a)) =>
Bool
-> Query (Inner s) a -> Query (Inner s) a -> Query s (OuterCols a)
internalUnion Bool
False
unionAll :: (Columns a, Columns (OuterCols a))
=> Query (Inner s) a
-> Query (Inner s) a
-> Query s (OuterCols a)
unionAll :: forall a s.
(Columns a, Columns (OuterCols a)) =>
Query (Inner s) a -> Query (Inner s) a -> Query s (OuterCols a)
unionAll = forall a s.
(Columns a, Columns (OuterCols a)) =>
Bool
-> Query (Inner s) a -> Query (Inner s) a -> Query s (OuterCols a)
internalUnion Bool
True
restrict :: Same s t => Col s Bool -> Query t ()
restrict :: forall s t. Same s t => Col s Bool -> Query t ()
restrict (One Exp SQL Bool
p) = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
GenState
st <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ case GenState -> [SQL]
sources GenState
st of
[] ->
GenState
st {staticRestricts :: [Exp SQL Bool]
staticRestricts = Exp SQL Bool
p forall a. a -> [a] -> [a]
: GenState -> [Exp SQL Bool]
staticRestricts GenState
st}
[SQL
sql] | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Exp SQL Bool
p forall {a} {sql}. Exp SQL a -> [SomeCol sql] -> Bool
`wasRenamedIn` SQL -> [SomeCol SQL]
cols SQL
sql ->
GenState
st {sources :: [SQL]
sources = [SQL
sql {restricts :: [Exp SQL Bool]
restricts = Exp SQL Bool
p forall a. a -> [a] -> [a]
: SQL -> [Exp SQL Bool]
restricts SQL
sql}]}
[SQL]
ss ->
GenState
st {sources :: [SQL]
sources = [([SomeCol SQL] -> SqlSource -> SQL
sqlFrom ([SQL] -> [SomeCol SQL]
allCols [SQL]
ss) ([SQL] -> SqlSource
Product [SQL]
ss)) {restricts :: [Exp SQL Bool]
restricts = [Exp SQL Bool
p]}]}
where
wasRenamedIn :: Exp SQL a -> [SomeCol sql] -> Bool
wasRenamedIn Exp SQL a
predicate [SomeCol sql]
cs =
let cs' :: [ColName]
cs' = [ColName
n | Named ColName
n Exp sql a
_ <- [SomeCol sql]
cs]
in forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ColName]
cs') ([SomeCol SQL] -> [ColName]
colNames [forall sql a. Exp sql a -> SomeCol sql
Some Exp SQL a
predicate])
aggregate :: (Columns (AggrCols a), Aggregates a)
=> Query (Inner s) a
-> Query s (AggrCols a)
aggregate :: forall a s.
(Columns (AggrCols a), Aggregates a) =>
Query (Inner s) a -> Query s (AggrCols a)
aggregate Query (Inner s) a
q = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
(GenState
gst, a
aggrs) <- forall s a. Query s a -> State GenState (GenState, a)
isolate Query (Inner s) a
q
[SomeCol SQL]
cs <- forall sql. [UntypedCol sql] -> State GenState [SomeCol sql]
renameAll forall a b. (a -> b) -> a -> b
$ forall a. Aggregates a => a -> [UntypedCol SQL]
unAggrs a
aggrs
let sql :: SQL
sql = ([SomeCol SQL] -> SqlSource -> SQL
sqlFrom [SomeCol SQL]
cs ([SQL] -> SqlSource
Product [GenState -> SQL
state2sql GenState
gst])) {groups :: [SomeCol SQL]
groups = GenState -> [SomeCol SQL]
groupCols GenState
gst}
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \GenState
st -> GenState
st {sources :: [SQL]
sources = SQL
sql forall a. a -> [a] -> [a]
: GenState -> [SQL]
sources GenState
st}
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Columns a => [ColName] -> a
toTup [ColName
n | Named ColName
n Exp SQL a
_ <- [SomeCol SQL]
cs]
leftJoin :: (Columns a, Columns (OuterCols a), Columns (LeftCols a))
=> (OuterCols a -> Col s Bool)
-> Query (Inner s) a
-> Query s (LeftCols a)
leftJoin :: forall a s.
(Columns a, Columns (OuterCols a), Columns (LeftCols a)) =>
(OuterCols a -> Col s Bool)
-> Query (Inner s) a -> Query s (LeftCols a)
leftJoin = forall a a' s.
(Columns a, Columns (OuterCols a), Columns a') =>
JoinType
-> (OuterCols a -> Col s Bool) -> Query (Inner s) a -> Query s a'
someJoin JoinType
LeftJoin
innerJoin :: (Columns a, Columns (OuterCols a))
=> (OuterCols a -> Col s Bool)
-> Query (Inner s) a
-> Query s (OuterCols a)
innerJoin :: forall a s.
(Columns a, Columns (OuterCols a)) =>
(OuterCols a -> Col s Bool)
-> Query (Inner s) a -> Query s (OuterCols a)
innerJoin = forall a a' s.
(Columns a, Columns (OuterCols a), Columns a') =>
JoinType
-> (OuterCols a -> Col s Bool) -> Query (Inner s) a -> Query s a'
someJoin JoinType
InnerJoin
someJoin :: (Columns a, Columns (OuterCols a), Columns a')
=> JoinType
-> (OuterCols a -> Col s Bool)
-> Query (Inner s) a
-> Query s a'
someJoin :: forall a a' s.
(Columns a, Columns (OuterCols a), Columns a') =>
JoinType
-> (OuterCols a -> Col s Bool) -> Query (Inner s) a -> Query s a'
someJoin JoinType
jointype OuterCols a -> Col s Bool
check Query (Inner s) a
q = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
(GenState
join_st, a
res) <- forall s a. Query s a -> State GenState (GenState, a)
isolate Query (Inner s) a
q
[SomeCol SQL]
cs <- forall sql. [UntypedCol sql] -> State GenState [SomeCol sql]
renameAll forall a b. (a -> b) -> a -> b
$ forall a. Columns a => a -> [UntypedCol SQL]
fromTup a
res
GenState
st <- forall s (m :: * -> *). MonadState s m => m s
get
let nameds :: [ColName]
nameds = [ColName
n | Named ColName
n Exp SQL a
_ <- [SomeCol SQL]
cs]
left :: SQL
left = GenState -> SQL
state2sql GenState
st
right :: SQL
right = [SomeCol SQL] -> SqlSource -> SQL
sqlFrom [SomeCol SQL]
cs ([SQL] -> SqlSource
Product [GenState -> SQL
state2sql GenState
join_st])
One Exp SQL Bool
on = OuterCols a -> Col s Bool
check forall a b. (a -> b) -> a -> b
$ forall a. Columns a => [ColName] -> a
toTup [ColName]
nameds
outCols :: [SomeCol SQL]
outCols = [forall sql a. Exp sql a -> SomeCol sql
Some forall a b. (a -> b) -> a -> b
$ forall sql a. ColName -> Exp sql a
Col ColName
n | Named ColName
n Exp SQL a
_ <- [SomeCol SQL]
cs] forall a. [a] -> [a] -> [a]
++ [SQL] -> [SomeCol SQL]
allCols [SQL
left]
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ GenState
st {sources :: [SQL]
sources = [[SomeCol SQL] -> SqlSource -> SQL
sqlFrom [SomeCol SQL]
outCols (JoinType -> Exp SQL Bool -> SQL -> SQL -> SqlSource
Join JoinType
jointype Exp SQL Bool
on SQL
left SQL
right)]}
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Columns a => [ColName] -> a
toTup [ColName]
nameds
groupBy :: (Same s t, SqlType a) => Col (Inner s) a -> Query (Inner t) (Aggr (Inner t) a)
groupBy :: forall s t a.
(Same s t, SqlType a) =>
Col (Inner s) a -> Query (Inner t) (Aggr (Inner t) a)
groupBy (One Exp SQL a
c) = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
GenState
st <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ GenState
st {groupCols :: [SomeCol SQL]
groupCols = forall sql a. Exp sql a -> SomeCol sql
Some Exp SQL a
c forall a. a -> [a] -> [a]
: GenState -> [SomeCol SQL]
groupCols GenState
st}
forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Exp SQL a -> Aggr s a
Aggr Exp SQL a
c)
limit :: Same s t => Int -> Int -> Query (Inner s) a -> Query t (OuterCols a)
limit :: forall s t a.
Same s t =>
Int -> Int -> Query (Inner s) a -> Query t (OuterCols a)
limit Int
from Int
to Query (Inner s) a
q = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
(GenState
lim_st, a
res) <- forall s a. Query s a -> State GenState (GenState, a)
isolate Query (Inner s) a
q
GenState
st <- forall s (m :: * -> *). MonadState s m => m s
get
let sql' :: SQL
sql' = case GenState -> [SQL]
sources GenState
lim_st of
[SQL
sql] | forall a. Maybe a -> Bool
isNothing (SQL -> Maybe (Int, Int)
limits SQL
sql) -> SQL
sql
[SQL]
ss -> [SomeCol SQL] -> SqlSource -> SQL
sqlFrom ([SQL] -> [SomeCol SQL]
allCols [SQL]
ss) ([SQL] -> SqlSource
Product [SQL]
ss)
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ GenState
st {sources :: [SQL]
sources = SQL
sql' {limits :: Maybe (Int, Int)
limits = forall a. a -> Maybe a
Just (Int
from, Int
to)} forall a. a -> [a] -> [a]
: GenState -> [SQL]
sources GenState
st}
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> b
unsafeCoerce a
res
order :: (Same s t, SqlType a) => Col s a -> Order -> Query t ()
order :: forall s t a.
(Same s t, SqlType a) =>
Col s a -> Order -> Query t ()
order (One Exp SQL a
c) Order
o = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
GenState
st <- forall s (m :: * -> *). MonadState s m => m s
get
case GenState -> [SQL]
sources GenState
st of
[SQL
sql] -> forall s (m :: * -> *). MonadState s m => s -> m ()
put GenState
st {sources :: [SQL]
sources = [SQL
sql {ordering :: [(Order, SomeCol SQL)]
ordering = (Order
o, forall sql a. Exp sql a -> SomeCol sql
Some Exp SQL a
c) forall a. a -> [a] -> [a]
: SQL -> [(Order, SomeCol SQL)]
ordering SQL
sql}]}
[SQL]
ss -> forall s (m :: * -> *). MonadState s m => s -> m ()
put GenState
st {sources :: [SQL]
sources = [SQL
sql {ordering :: [(Order, SomeCol SQL)]
ordering = [(Order
o, forall sql a. Exp sql a -> SomeCol sql
Some Exp SQL a
c)]}]}
where sql :: SQL
sql = [SomeCol SQL] -> SqlSource -> SQL
sqlFrom ([SQL] -> [SomeCol SQL]
allCols [SQL]
ss) ([SQL] -> SqlSource
Product [SQL]
ss)
orderRandom :: Query s ()
orderRandom :: forall s. Query s ()
orderRandom = forall s t a.
(Same s t, SqlType a) =>
Col s a -> Order -> Query t ()
order (forall {k} (s :: k) a. Exp SQL a -> Col s a
One (forall a sql. NulOp a -> Exp sql a
NulOp (forall a. Text -> NulOp a
Fun0 Text
"RANDOM") :: Exp SQL Int)) Order
Asc
distinct :: (Columns a, Columns (OuterCols a))
=> Query (Inner s) a
-> Query s (OuterCols a)
distinct :: forall a s.
(Columns a, Columns (OuterCols a)) =>
Query (Inner s) a -> Query s (OuterCols a)
distinct Query (Inner s) a
q = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
a
res <- forall s a. Query s a -> State GenState a
unQ Query (Inner s) a
q
GenState
st <- forall s (m :: * -> *). MonadState s m => m s
get
let ss :: [SQL]
ss = GenState -> [SQL]
sources GenState
st
forall s (m :: * -> *). MonadState s m => s -> m ()
put GenState
st {sources :: [SQL]
sources = [([SomeCol SQL] -> SqlSource -> SQL
sqlFrom ([SQL] -> [SomeCol SQL]
allCols [SQL]
ss) ([SQL] -> SqlSource
Product [SQL]
ss)) {distinct :: Bool
SQL.distinct = Bool
True}]}
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b
unsafeCoerce a
res)