{-# LANGUAGE GADTs, OverloadedStrings, CPP #-}
module Database.Selda.SQL.Print where
import Database.Selda.Exp
( BinOp(..), UnOp(..), NulOp(..), Exp(..), SomeCol(..) )
import Database.Selda.SQL
( Param(..),
Order(Desc, Asc),
SQL(SQL),
JoinType(InnerJoin, LeftJoin),
SqlSource(Union, EmptyTable, RawSql, TableName, Product, Values,
Join),
QueryFragment(..) )
import Database.Selda.SQL.Print.Config (PPConfig)
import qualified Database.Selda.SQL.Print.Config as Cfg
import Database.Selda.SqlType ( Lit(LJust, LNull), SqlTypeRep )
import Database.Selda.Types
( TableName, ColName, fromColName, fromTableName )
import Control.Monad.State
( liftM2, MonadState(get, put), runState, State )
import Data.List ( group, sort )
import Data.Text (Text)
import qualified Data.Text as Text
snub :: (Ord a, Eq a) => [a] -> [a]
snub :: forall a. (Ord a, Eq a) => [a] -> [a]
snub = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
type PP = State PPState
data PPState = PPState
{ PPState -> [Param]
ppParams :: ![Param]
, PPState -> Int
ppParamNS :: !Int
, PPState -> Int
ppQueryNS :: !Int
, PPState -> PPConfig
ppConfig :: !PPConfig
}
runPP :: PPConfig
-> PP Text
-> (Text, [Param])
runPP :: PPConfig -> PP Text -> (Text, [Param])
runPP PPConfig
cfg PP Text
pp =
case forall s a. State s a -> s -> (a, s)
runState PP Text
pp ([Param] -> Int -> Int -> PPConfig -> PPState
PPState [] Int
1 Int
0 PPConfig
cfg) of
(Text
q, PPState
st) -> (Text
q, forall a. [a] -> [a]
reverse (PPState -> [Param]
ppParams PPState
st))
compSql :: PPConfig -> SQL -> (Text, [Param])
compSql :: PPConfig -> SQL -> (Text, [Param])
compSql PPConfig
cfg = PPConfig -> PP Text -> (Text, [Param])
runPP PPConfig
cfg forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQL -> PP Text
ppSql
compExp :: PPConfig -> Exp SQL a -> (Text, [Param])
compExp :: forall a. PPConfig -> Exp SQL a -> (Text, [Param])
compExp PPConfig
cfg = PPConfig -> PP Text -> (Text, [Param])
runPP PPConfig
cfg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Exp SQL a -> PP Text
ppCol
compRaw :: PPConfig -> QueryFragment -> (Text, [Param])
compRaw :: PPConfig -> QueryFragment -> (Text, [Param])
compRaw PPConfig
cfg = PPConfig -> PP Text -> (Text, [Param])
runPP PPConfig
cfg forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryFragment -> PP Text
ppRaw
compUpdate :: PPConfig
-> TableName
-> Exp SQL Bool
-> [(ColName, SomeCol SQL)]
-> (Text, [Param])
compUpdate :: PPConfig
-> TableName
-> Exp SQL Bool
-> [(ColName, SomeCol SQL)]
-> (Text, [Param])
compUpdate PPConfig
cfg TableName
tbl Exp SQL Bool
p [(ColName, SomeCol SQL)]
cs = PPConfig -> PP Text -> (Text, [Param])
runPP PPConfig
cfg PP Text
ppUpd
where
ppUpd :: PP Text
ppUpd = do
[Either Text Text]
updates <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ColName, SomeCol SQL)
-> StateT PPState Identity (Either Text Text)
ppUpdate [(ColName, SomeCol SQL)]
cs
Text
check <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL Bool
p
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords
[ Text
"UPDATE", TableName -> Text
fromTableName TableName
tbl
, Text
"SET", [Either Text Text] -> Text
set [Either Text Text]
updates
, Text
"WHERE", Text
check
]
ppUpdate :: (ColName, SomeCol SQL)
-> StateT PPState Identity (Either Text Text)
ppUpdate (ColName
n, SomeCol SQL
c) = do
let n' :: Text
n' = ColName -> Text
fromColName ColName
n
Text
c' <- SomeCol SQL -> PP Text
ppSomeCol SomeCol SQL
c
let upd :: Text
upd = [Text] -> Text
Text.unwords [Text
n', Text
"=", Text
c']
if Text
n' forall a. Eq a => a -> a -> Bool
== Text
c'
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
upd
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
upd
set :: [Either Text Text] -> Text
set [Either Text Text]
us =
case [Text
u | Right Text
u <- [Either Text Text]
us] of
[] -> [Either Text Text] -> Text
set (forall a. Int -> [a] -> [a]
take Int
1 [forall a b. b -> Either a b
Right Text
u | Left Text
u <- [Either Text Text]
us])
[Text]
us' -> Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
us'
compDelete :: PPConfig -> TableName -> Exp SQL Bool -> (Text, [Param])
compDelete :: PPConfig -> TableName -> Exp SQL Bool -> (Text, [Param])
compDelete PPConfig
cfg TableName
tbl Exp SQL Bool
p = PPConfig -> PP Text -> (Text, [Param])
runPP PPConfig
cfg PP Text
ppDelete
where
ppDelete :: PP Text
ppDelete = do
Text
c' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL Bool
p
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords [Text
"DELETE FROM", TableName -> Text
fromTableName TableName
tbl, Text
"WHERE", Text
c']
ppLit :: Lit a -> PP Text
ppLit :: forall a. Lit a -> PP Text
ppLit Lit a
LNull = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"NULL"
ppLit (LJust Lit a
l) = forall a. Lit a -> PP Text
ppLit Lit a
l
ppLit Lit a
l = do
PPState [Param]
ps Int
ns Int
qns PPConfig
tr <- 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
$ [Param] -> Int -> Int -> PPConfig -> PPState
PPState (forall a. Lit a -> Param
Param Lit a
l forall a. a -> [a] -> [a]
: [Param]
ps) (forall a. Enum a => a -> a
succ Int
ns) Int
qns PPConfig
tr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (Char
'$'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Int
ns)
freshQueryName :: PP Text
freshQueryName :: PP Text
freshQueryName = do
PPState [Param]
ps Int
ns Int
qns PPConfig
tr <- 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
$ [Param] -> Int -> Int -> PPConfig -> PPState
PPState [Param]
ps Int
ns (forall a. Enum a => a -> a
succ Int
qns) PPConfig
tr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (Char
'q'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Int
qns)
ppSql :: SQL -> PP Text
ppSql :: SQL -> PP Text
ppSql (SQL [SomeCol SQL]
cs SqlSource
src [Exp SQL Bool]
r [SomeCol SQL]
gs [(Order, SomeCol SQL)]
ord Maybe (Int, Int)
lim [SomeCol SQL]
_live Bool
dist) = do
[Text]
cs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SomeCol SQL -> PP Text
ppSomeCol [SomeCol SQL]
cs
Text
src' <- SqlSource -> PP Text
ppSrc SqlSource
src
Text
r' <- [Exp SQL Bool] -> PP Text
ppRestricts [Exp SQL Bool]
r
Text
gs' <- [SomeCol SQL] -> PP Text
ppGroups [SomeCol SQL]
gs
Text
ord' <- [(Order, SomeCol SQL)] -> PP Text
ppOrder [(Order, SomeCol SQL)]
ord
Text
lim' <- Maybe (Int, Int) -> PP Text
ppLimit Maybe (Int, Int)
lim
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ Text
"SELECT ", if Bool
dist then Text
"DISTINCT " else Text
"", [Text] -> Text
result [Text]
cs'
, Text
src'
, Text
r'
, Text
gs'
, Text
ord'
, Text
lim'
]
where
result :: [Text] -> Text
result [] = Text
"1"
result [Text]
cs' = Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
cs'
ppSrc :: SqlSource -> PP Text
ppSrc SqlSource
EmptyTable = do
Text
qn <- PP Text
freshQueryName
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
" FROM (SELECT NULL LIMIT 0) AS " forall a. Semigroup a => a -> a -> a
<> Text
qn
ppSrc (RawSql QueryFragment
raw) = do
Text
s <- QueryFragment -> PP Text
ppRaw QueryFragment
raw
Text
qn <- PP Text
freshQueryName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
" FROM (" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
") AS " forall a. Semigroup a => a -> a -> a
<> Text
qn)
ppSrc (TableName TableName
n) = do
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
" FROM " forall a. Semigroup a => a -> a -> a
<> TableName -> Text
fromTableName TableName
n
ppSrc (Product []) = do
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
ppSrc (Product [SQL]
sqls) = do
[Text]
srcs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SQL -> PP Text
ppSql (forall a. [a] -> [a]
reverse [SQL]
sqls)
[Text]
qs <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
")" | Text
s <- [Text]
srcs] forall a b. (a -> b) -> a -> b
$ \Text
q -> do
Text
qn <- PP Text
freshQueryName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
q forall a. Semigroup a => a -> a -> a
<> Text
" AS " forall a. Semigroup a => a -> a -> a
<> Text
qn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
" FROM " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
qs
ppSrc (Values [SomeCol SQL]
row [[Param]]
rows) = do
Text
row' <- Text -> [Text] -> Text
Text.intercalate Text
", " forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SomeCol SQL -> PP Text
ppSomeCol [SomeCol SQL]
row
[Text]
rows' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Param] -> PP Text
ppRow [[Param]]
rows
Text
qn <- PP Text
freshQueryName
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ Text
" FROM (SELECT "
, Text -> [Text] -> Text
Text.intercalate Text
" UNION ALL SELECT " (Text
row'forall a. a -> [a] -> [a]
:[Text]
rows')
, Text
") AS "
, Text
qn
]
ppSrc (Join JoinType
jointype Exp SQL Bool
on SQL
left SQL
right) = do
Text
l' <- SQL -> PP Text
ppSql SQL
left
Text
r' <- SQL -> PP Text
ppSql SQL
right
Text
on' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL Bool
on
Text
lqn <- PP Text
freshQueryName
Text
rqn <- PP Text
freshQueryName
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ Text
" FROM (", Text
l', Text
") AS ", Text
lqn
, Text
" ", forall {a}. IsString a => JoinType -> a
ppJoinType JoinType
jointype, Text
" (", Text
r', Text
") AS ", Text
rqn
, Text
" ON ", Text
on'
]
ppSrc (Union Bool
union_all SQL
left SQL
right) = do
[Text]
qs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SQL -> PP Text
ppSql [SQL
left, SQL
right]
Text
qn <- PP Text
freshQueryName
let union :: Text
union = if Bool
union_all then Text
" UNION ALL " else Text
" UNION "
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ Text
" FROM ("
, Text -> [Text] -> Text
Text.intercalate Text
union [Text]
qs
, Text
") AS "
, Text
qn
]
ppJoinType :: JoinType -> a
ppJoinType JoinType
LeftJoin = a
"LEFT JOIN"
ppJoinType JoinType
InnerJoin = a
"JOIN"
ppRow :: [Param] -> PP Text
ppRow [Param]
xs = do
[Text]
ls <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall a. Lit a -> PP Text
ppLit Lit a
l | Param Lit a
l <- [Param]
xs]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
ls
ppRestricts :: [Exp SQL Bool] -> PP Text
ppRestricts [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
ppRestricts [Exp SQL Bool]
rs = [Exp SQL Bool] -> PP Text
ppCols [Exp SQL Bool]
rs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
rs' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
" WHERE " forall a. Semigroup a => a -> a -> a
<> Text
rs'
ppGroups :: [SomeCol SQL] -> PP Text
ppGroups [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
ppGroups [SomeCol SQL]
grps = do
[Text]
cls <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
c | Some Exp SQL a
c <- [SomeCol SQL]
grps]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
" GROUP BY " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
cls
ppOrder :: [(Order, SomeCol SQL)] -> PP Text
ppOrder [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
ppOrder [(Order, SomeCol SQL)]
os = do
[Text]
os' <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [(forall a. Semigroup a => a -> a -> a
<> (Text
" " forall a. Semigroup a => a -> a -> a
<> forall {a}. IsString a => Order -> a
ppOrd Order
o)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
c | (Order
o, Some Exp SQL a
c) <- [(Order, SomeCol SQL)]
os]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
" ORDER BY " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
os'
ppOrd :: Order -> a
ppOrd Order
Asc = a
"ASC"
ppOrd Order
Desc = a
"DESC"
ppLimit :: Maybe (Int, Int) -> PP Text
ppLimit Maybe (Int, Int)
Nothing =
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
ppLimit (Just (Int
off, Int
limit)) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
" LIMIT " forall a. Semigroup a => a -> a -> a
<> Int -> Text
ppInt Int
limit forall a. Semigroup a => a -> a -> a
<> Text
" OFFSET " forall a. Semigroup a => a -> a -> a
<> Int -> Text
ppInt Int
off
ppInt :: Int -> Text
ppInt = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
ppRaw :: QueryFragment -> PP Text
ppRaw :: QueryFragment -> PP Text
ppRaw (RawText Text
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
ppRaw (RawExp Exp SQL a
e) = forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
e
ppRaw (RawCat QueryFragment
a QueryFragment
b) = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. Semigroup a => a -> a -> a
(<>) (QueryFragment -> PP Text
ppRaw QueryFragment
a) (QueryFragment -> PP Text
ppRaw QueryFragment
b)
ppSomeCol :: SomeCol SQL -> PP Text
ppSomeCol :: SomeCol SQL -> PP Text
ppSomeCol (Some Exp SQL a
c) = forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
c
ppSomeCol (Named ColName
n Exp SQL a
c) = do
Text
c' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
c
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
c' forall a. Semigroup a => a -> a -> a
<> Text
" AS " forall a. Semigroup a => a -> a -> a
<> ColName -> Text
fromColName ColName
n
ppCols :: [Exp SQL Bool] -> PP Text
ppCols :: [Exp SQL Bool] -> PP Text
ppCols [Exp SQL Bool]
cs = do
[Text]
cs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Exp SQL a -> PP Text
ppCol (forall a. [a] -> [a]
reverse [Exp SQL Bool]
cs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
"(" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
") AND (" [Text]
cs' forall a. Semigroup a => a -> a -> a
<> Text
")"
ppType :: SqlTypeRep -> PP Text
ppType :: SqlTypeRep -> PP Text
ppType SqlTypeRep
t = do
PPConfig
c <- PPState -> PPConfig
ppConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PPConfig -> SqlTypeRep -> Text
Cfg.ppType PPConfig
c SqlTypeRep
t
ppTypePK :: SqlTypeRep -> PP Text
ppTypePK :: SqlTypeRep -> PP Text
ppTypePK SqlTypeRep
t = do
PPConfig
c <- PPState -> PPConfig
ppConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PPConfig -> SqlTypeRep -> Text
Cfg.ppTypePK PPConfig
c SqlTypeRep
t
ppCol :: Exp SQL a -> PP Text
ppCol :: forall a. Exp SQL a -> PP Text
ppCol (Col ColName
name) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColName -> Text
fromColName ColName
name)
ppCol (Lit Lit a
l) = forall a. Lit a -> PP Text
ppLit Lit a
l
ppCol (BinOp BinOp a b a
op Exp SQL a
a Exp SQL b
b) = forall a b c. BinOp a b c -> Exp SQL a -> Exp SQL b -> PP Text
ppBinOp BinOp a b a
op Exp SQL a
a Exp SQL b
b
ppCol (UnOp UnOp a a
op Exp SQL a
a) = forall a b. UnOp a b -> Exp SQL a -> PP Text
ppUnOp UnOp a a
op Exp SQL a
a
ppCol (NulOp NulOp a
a) = forall a. NulOp a -> PP Text
ppNulOp NulOp a
a
ppCol (Raw Text
e) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
e
ppCol (Fun2 Text
f Exp SQL a
a Exp SQL b
b) = do
Text
a' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
a
Text
b' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL b
b
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text
f, Text
"(", Text
a', Text
", ", Text
b', Text
")"]
ppCol (If Exp SQL Bool
a Exp SQL a
b Exp SQL a
c) = do
Text
a' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL Bool
a
Text
b' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
b
Text
c' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
c
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text
"CASE WHEN ", Text
a', Text
" THEN ", Text
b', Text
" ELSE ", Text
c', Text
" END"]
ppCol (AggrEx Text
f Exp SQL a
x) = forall a b. UnOp a b -> Exp SQL a -> PP Text
ppUnOp (forall a b. Text -> UnOp a b
Fun Text
f) Exp SQL a
x
ppCol (Cast SqlTypeRep
t Exp SQL a
x) = do
Text
x' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
x
Text
t' <- SqlTypeRep -> PP Text
ppType SqlTypeRep
t
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text
"CAST(", Text
x', Text
" AS ", Text
t', Text
")"]
ppCol (InList Exp SQL a
x [Exp SQL a]
xs) = do
Text
x' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
x
[Text]
xs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Exp SQL a -> PP Text
ppCol [Exp SQL a]
xs
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text
x', Text
" IN (", Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
xs', Text
")"]
ppCol (InQuery Exp SQL a
x SQL
q) = do
Text
x' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
x
Text
q' <- SQL -> PP Text
ppSql SQL
q
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text
x', Text
" IN (", Text
q', Text
")"]
ppNulOp :: NulOp a -> PP Text
ppNulOp :: forall a. NulOp a -> PP Text
ppNulOp (Fun0 Text
f) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
f forall a. Semigroup a => a -> a -> a
<> Text
"()"
ppUnOp :: UnOp a b -> Exp SQL a -> PP Text
ppUnOp :: forall a b. UnOp a b -> Exp SQL a -> PP Text
ppUnOp UnOp a b
op Exp SQL a
c = do
Text
c' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
c
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case UnOp a b
op of
UnOp a b
Abs -> Text
"ABS(" forall a. Semigroup a => a -> a -> a
<> Text
c' forall a. Semigroup a => a -> a -> a
<> Text
")"
UnOp a b
Sgn -> Text
"SIGN(" forall a. Semigroup a => a -> a -> a
<> Text
c' forall a. Semigroup a => a -> a -> a
<> Text
")"
UnOp a b
Neg -> Text
"-(" forall a. Semigroup a => a -> a -> a
<> Text
c' forall a. Semigroup a => a -> a -> a
<> Text
")"
UnOp a b
Not -> Text
"NOT(" forall a. Semigroup a => a -> a -> a
<> Text
c' forall a. Semigroup a => a -> a -> a
<> Text
")"
UnOp a b
IsNull -> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
c' forall a. Semigroup a => a -> a -> a
<> Text
") IS NULL"
Fun Text
f -> Text
f forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
c' forall a. Semigroup a => a -> a -> a
<> Text
")"
ppBinOp :: BinOp a b c -> Exp SQL a -> Exp SQL b -> PP Text
ppBinOp :: forall a b c. BinOp a b c -> Exp SQL a -> Exp SQL b -> PP Text
ppBinOp BinOp a b c
op Exp SQL a
a Exp SQL b
b = do
Text
a' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL a
a
Text
b' <- forall a. Exp SQL a -> PP Text
ppCol Exp SQL b
b
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Exp SQL a -> Text -> Text
paren Exp SQL a
a Text
a' forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall a b c. BinOp a b c -> Text
ppOp BinOp a b c
op forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. Exp SQL a -> Text -> Text
paren Exp SQL b
b Text
b'
where
paren :: Exp SQL a -> Text -> Text
paren :: forall a. Exp SQL a -> Text -> Text
paren (Col{}) Text
c = Text
c
paren (Lit{}) Text
c = Text
c
paren Exp SQL a
_ Text
c = Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
c forall a. Semigroup a => a -> a -> a
<> Text
")"
ppOp :: BinOp a b c -> Text
ppOp :: forall a b c. BinOp a b c -> Text
ppOp BinOp a b c
Gt = Text
">"
ppOp BinOp a b c
Lt = Text
"<"
ppOp BinOp a b c
Gte = Text
">="
ppOp BinOp a b c
Lte = Text
"<="
ppOp BinOp a b c
Eq = Text
"="
ppOp BinOp a b c
Neq = Text
"!="
ppOp BinOp a b c
And = Text
"AND"
ppOp BinOp a b c
Or = Text
"OR"
ppOp BinOp a b c
Add = Text
"+"
ppOp BinOp a b c
Sub = Text
"-"
ppOp BinOp a b c
Mul = Text
"*"
ppOp BinOp a b c
Div = Text
"/"
ppOp BinOp a b c
Like = Text
"LIKE"
ppOp (CustomOp Text
s) = Text
s