{-# LANGUAGE GADTs, OverloadedStrings, CPP #-}
-- | Pretty-printing for SQL queries. For some values of pretty.
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

-- | O(n log n) equivalent of @nub . sort@
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

-- | SQL pretty-printer. The state is the list of SQL parameters to the
--   prepared statement.
type PP = State PPState

data PPState = PPState
  { PPState -> [Param]
ppParams  :: ![Param]
  , PPState -> Int
ppParamNS :: !Int
  , PPState -> Int
ppQueryNS :: !Int
  , PPState -> PPConfig
ppConfig  :: !PPConfig
  }

-- | Run a pretty-printer.
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))

-- | Compile an SQL AST into a parameterized SQL query.
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

-- | Compile a single column expression.
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

-- | Compile a raw SQL fragment.
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

-- | Compile an @UPATE@ statement.
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
    -- if the update doesn't change anything, pick an arbitrary column to
    -- set to itself just to satisfy SQL's syntactic rules
    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'

-- | Compile a @DELETE@ statement.
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']

-- | Pretty-print a literal as a named parameter and save the
--   name-value binding in the environment.
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)

-- | Generate a unique name for a subquery.
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)

-- | Pretty-print an SQL AST.
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