module Database.Selda.Query
(select, selectValues
, restrict, groupBy, limit, order
, aggregate, leftJoin, inner, suchThat
) where
import Database.Selda.Column
import Database.Selda.Inner
import Database.Selda.Query.Type
import Database.Selda.SQL
import Database.Selda.Table
import Database.Selda.Transform
import Control.Monad.State.Strict
select :: Columns (Cols s a) => Table a -> Query s (Cols s a)
select (Table name cs) = Query $ do
rns <- mapM (rename . Some . Col) cs'
st <- get
put $ st {sources = SQL rns (TableName name) [] [] [] Nothing : sources st}
return $ toTup [n | Named n _ <- rns]
where
cs' = map colName cs
selectValues :: (Insert a, Columns (Cols s a)) => [a] -> Query s (Cols s a)
selectValues [] = Query $ do
st <- get
put $ st {sources = SQL [] EmptyTable [] [] [] Nothing : sources st}
return $ toTup (repeat "NULL")
selectValues (row:rows) = Query $ do
names <- mapM (const freshName) firstrow
let rns = [Named n (Col n) | n <- names]
row' = mkFirstRow names
s <- get
put $ s {sources = SQL rns (Values row' rows') [] [] [] Nothing : sources s}
return $ toTup [n | Named n _ <- rns]
where
firstrow = map defToVal $ params row
mkFirstRow ns =
[ Named n (Lit l)
| (Param l, n) <- zip firstrow ns
]
rows' = map (map defToVal . params) rows
defToVal (Left x) = x
defToVal (Right x) = x
restrict :: Col s Bool -> Query s ()
restrict (C p) = Query $ do
st <- get
put $ case sources st of
[] ->
st {staticRestricts = p : staticRestricts st}
[SQL cs s ps gs os lim] | not $ p `wasRenamedIn` cs ->
st {sources = [SQL cs s (p : ps) gs os lim]}
ss ->
st {sources = [SQL (allCols ss) (Product ss) [p] [] [] Nothing]}
where
wasRenamedIn predicate cs =
let cs' = [n | Named n _ <- cs]
in any (`elem` cs') (colNames [Some predicate])
aggregate :: (Columns (OuterCols a), Aggregates a)
=> Query (Inner s) a
-> Query s (OuterCols a)
aggregate q = Query $ do
st <- get
(gst, aggrs) <- isolate q
cs <- mapM rename $ unAggrs aggrs
let sql = state2sql gst
sql' = SQL cs (Product [sql]) [] (groupCols gst) [] Nothing
put $ st {sources = sql' : sources st}
pure $ toTup [n | Named n _ <- cs]
leftJoin :: (Columns a, Columns (OuterCols a), Columns (LeftCols a))
=> (OuterCols a -> Col s Bool)
-> Query (Inner s) a
-> Query s (LeftCols a)
leftJoin = someJoin LeftJoin
inner :: (Columns a, Columns (OuterCols a))
=> (OuterCols a -> Col s Bool)
-> Query (Inner s) a
-> Query s (OuterCols a)
inner = someJoin InnerJoin
suchThat :: (Columns a, Columns (OuterCols a))
=> (OuterCols a -> Col s Bool)
-> Query (Inner s) a
-> Query s (OuterCols a)
suchThat = inner
someJoin :: (Columns a, Columns (OuterCols a), Columns a')
=> JoinType
-> (OuterCols a -> Col s Bool)
-> Query (Inner s) a
-> Query s a'
someJoin jointype check q = Query $ do
(join_st, res) <- isolate q
cs <- mapM rename $ fromTup res
st <- get
let nameds = [n | Named n _ <- cs]
left = state2sql st
right = SQL cs (Product [state2sql join_st]) [] [] [] Nothing
C on = check $ toTup nameds
outCols = [Some $ Col n | Named n _ <- cs] ++ allCols [left]
sql = SQL outCols (Join jointype on left right) [] [] [] Nothing
put $ st {sources = [sql]}
pure $ toTup nameds
groupBy :: Col (Inner s) a -> Query (Inner s) (Aggr (Inner s) a)
groupBy (C c) = Query $ do
st <- get
put $ st {groupCols = Some c : groupCols st}
return (Aggr c)
limit :: Int -> Int -> Query (Inner s) a -> Query s a
limit from to q = Query $ do
(lim_st, res) <- isolate q
st <- get
let sql = case sources lim_st of
[SQL cs s ps gs os Nothing] ->
SQL cs s ps gs os (Just (from, to))
ss ->
SQL (allCols ss) (Product ss) [] [] [] (Just (from, to))
put $ st {sources = sql : sources st}
return res
order :: Col s a -> Order -> Query s ()
order (C c) o = Query $ do
st <- get
put $ case sources st of
[SQL cs s ps gs os lim] ->
st {sources = [SQL cs s ps gs ((o, Some c):os) lim]}
ss ->
st {sources = [SQL (allCols ss) (Product ss) [] [] [(o, Some c)] Nothing]}