module Opaleye.SQLite.Internal.HaskellDB.Sql.Print (
deliteral,
ppUpdate,
ppDelete,
ppInsert,
ppSqlExpr,
ppWhere,
ppGroupBy,
ppOrderBy,
ppTable,
ppAs,
commaV,
commaH
) where
import Prelude hiding ((<>))
import Opaleye.SQLite.Internal.HaskellDB.Sql (SqlColumn(..), SqlDelete(..),
SqlExpr(..), SqlOrder(..), SqlInsert(..),
SqlUpdate(..), SqlTable(..))
import qualified Opaleye.SQLite.Internal.HaskellDB.Sql as Sql
import Data.List (intersperse)
import qualified Data.List.NonEmpty as NEL
import Text.PrettyPrint.HughesPJ (Doc, (<+>), ($$), (<>), comma, doubleQuotes,
empty, equals, hcat, hsep, parens, punctuate,
text, vcat)
deliteral :: SqlExpr -> SqlExpr
deliteral :: SqlExpr -> SqlExpr
deliteral c :: SqlExpr
c@(ColumnSqlExpr (SqlColumn String
_)) = SqlExpr
c
deliteral SqlExpr
expr = String -> [SqlExpr] -> SqlExpr
FunSqlExpr String
"COALESCE" [SqlExpr
expr, SqlExpr
expr]
ppWhere :: [SqlExpr] -> Doc
ppWhere :: [SqlExpr] -> Doc
ppWhere [] = Doc
empty
ppWhere [SqlExpr]
es = String -> Doc
text String
"WHERE"
Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (String -> Doc
text String
"AND")
((SqlExpr -> Doc) -> [SqlExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
parens (Doc -> Doc) -> (SqlExpr -> Doc) -> SqlExpr -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlExpr -> Doc
ppSqlExpr) [SqlExpr]
es))
ppGroupBy :: [SqlExpr] -> Doc
ppGroupBy :: [SqlExpr] -> Doc
ppGroupBy [SqlExpr]
es = String -> Doc
text String
"GROUP BY" Doc -> Doc -> Doc
<+> [SqlExpr] -> Doc
ppGroupAttrs [SqlExpr]
es
where
ppGroupAttrs :: [SqlExpr] -> Doc
ppGroupAttrs :: [SqlExpr] -> Doc
ppGroupAttrs [SqlExpr]
cs = (SqlExpr -> Doc) -> [SqlExpr] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaV (SqlExpr -> Doc
ppSqlExpr (SqlExpr -> Doc) -> (SqlExpr -> SqlExpr) -> SqlExpr -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlExpr -> SqlExpr
deliteral) [SqlExpr]
cs
ppOrderBy :: [(SqlExpr,SqlOrder)] -> Doc
ppOrderBy :: [(SqlExpr, SqlOrder)] -> Doc
ppOrderBy [] = Doc
empty
ppOrderBy [(SqlExpr, SqlOrder)]
ord = String -> Doc
text String
"ORDER BY" Doc -> Doc -> Doc
<+> ((SqlExpr, SqlOrder) -> Doc) -> [(SqlExpr, SqlOrder)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaV (SqlExpr, SqlOrder) -> Doc
ppOrd [(SqlExpr, SqlOrder)]
ord
where
ppOrd :: (SqlExpr, SqlOrder) -> Doc
ppOrd (SqlExpr
e,SqlOrder
o) = SqlExpr -> Doc
ppSqlExpr (SqlExpr -> SqlExpr
deliteral SqlExpr
e)
Doc -> Doc -> Doc
<+> SqlOrder -> Doc
ppSqlDirection SqlOrder
o
Doc -> Doc -> Doc
<+> SqlOrder -> Doc
ppSqlNulls SqlOrder
o
ppSqlDirection :: Sql.SqlOrder -> Doc
ppSqlDirection :: SqlOrder -> Doc
ppSqlDirection SqlOrder
x = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ case SqlOrder -> SqlOrderDirection
Sql.sqlOrderDirection SqlOrder
x of
SqlOrderDirection
Sql.SqlAsc -> String
"ASC"
SqlOrderDirection
Sql.SqlDesc -> String
"DESC"
ppSqlNulls :: Sql.SqlOrder -> Doc
ppSqlNulls :: SqlOrder -> Doc
ppSqlNulls SqlOrder
_ = Doc
empty
ppAs :: String -> Doc -> Doc
ppAs :: String -> Doc -> Doc
ppAs String
alias Doc
expr | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
alias = Doc
expr
| Bool
otherwise = Doc
expr Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep [String -> Doc
text String
"as", Doc -> Doc
doubleQuotes (String -> Doc
text String
alias)]
ppUpdate :: SqlUpdate -> Doc
ppUpdate :: SqlUpdate -> Doc
ppUpdate (SqlUpdate SqlTable
table [(SqlColumn, SqlExpr)]
assigns [SqlExpr]
criteria)
= String -> Doc
text String
"UPDATE" Doc -> Doc -> Doc
<+> SqlTable -> Doc
ppTable SqlTable
table
Doc -> Doc -> Doc
$$ String -> Doc
text String
"SET" Doc -> Doc -> Doc
<+> ((SqlColumn, SqlExpr) -> Doc) -> [(SqlColumn, SqlExpr)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaV (SqlColumn, SqlExpr) -> Doc
ppAssign [(SqlColumn, SqlExpr)]
assigns
Doc -> Doc -> Doc
$$ [SqlExpr] -> Doc
ppWhere [SqlExpr]
criteria
where
ppAssign :: (SqlColumn, SqlExpr) -> Doc
ppAssign (SqlColumn
c,SqlExpr
e) = SqlColumn -> Doc
ppColumn SqlColumn
c Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> SqlExpr -> Doc
ppSqlExpr SqlExpr
e
ppDelete :: SqlDelete -> Doc
ppDelete :: SqlDelete -> Doc
ppDelete (SqlDelete SqlTable
table [SqlExpr]
criteria) =
String -> Doc
text String
"DELETE FROM" Doc -> Doc -> Doc
<+> SqlTable -> Doc
ppTable SqlTable
table Doc -> Doc -> Doc
$$ [SqlExpr] -> Doc
ppWhere [SqlExpr]
criteria
ppInsert :: SqlInsert -> Doc
ppInsert :: SqlInsert -> Doc
ppInsert (SqlInsert SqlTable
table [SqlColumn]
names NonEmpty [SqlExpr]
values)
= String -> Doc
text String
"INSERT INTO" Doc -> Doc -> Doc
<+> SqlTable -> Doc
ppTable SqlTable
table
Doc -> Doc -> Doc
<+> Doc -> Doc
parens ((SqlColumn -> Doc) -> [SqlColumn] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaV SqlColumn -> Doc
ppColumn [SqlColumn]
names)
Doc -> Doc -> Doc
$$ String -> Doc
text String
"VALUES" Doc -> Doc -> Doc
<+> ([SqlExpr] -> Doc) -> [[SqlExpr]] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaV (\[SqlExpr]
v -> Doc -> Doc
parens ((SqlExpr -> Doc) -> [SqlExpr] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaV SqlExpr -> Doc
ppSqlExpr [SqlExpr]
v))
(NonEmpty [SqlExpr] -> [[SqlExpr]]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty [SqlExpr]
values)
ppColumn :: SqlColumn -> Doc
ppColumn :: SqlColumn -> Doc
ppColumn (SqlColumn String
s) = Doc -> Doc
doubleQuotes (String -> Doc
text String
s)
ppTable :: SqlTable -> Doc
ppTable :: SqlTable -> Doc
ppTable (SqlTable String
s) = Doc -> Doc
doubleQuotes (String -> Doc
text String
s)
ppSqlExpr :: SqlExpr -> Doc
ppSqlExpr :: SqlExpr -> Doc
ppSqlExpr SqlExpr
expr =
case SqlExpr
expr of
ColumnSqlExpr SqlColumn
c -> SqlColumn -> Doc
ppColumn SqlColumn
c
ParensSqlExpr SqlExpr
e -> Doc -> Doc
parens (SqlExpr -> Doc
ppSqlExpr SqlExpr
e)
BinSqlExpr String
op SqlExpr
e1 SqlExpr
e2 -> SqlExpr -> Doc
ppSqlExpr SqlExpr
e1 Doc -> Doc -> Doc
<+> String -> Doc
text String
op Doc -> Doc -> Doc
<+> SqlExpr -> Doc
ppSqlExpr SqlExpr
e2
PrefixSqlExpr String
op SqlExpr
e -> String -> Doc
text String
op Doc -> Doc -> Doc
<+> SqlExpr -> Doc
ppSqlExpr SqlExpr
e
PostfixSqlExpr String
op SqlExpr
e -> SqlExpr -> Doc
ppSqlExpr SqlExpr
e Doc -> Doc -> Doc
<+> String -> Doc
text String
op
FunSqlExpr String
f [SqlExpr]
es -> String -> Doc
text String
f Doc -> Doc -> Doc
<> Doc -> Doc
parens ((SqlExpr -> Doc) -> [SqlExpr] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaH SqlExpr -> Doc
ppSqlExpr [SqlExpr]
es)
AggrFunSqlExpr String
f [SqlExpr]
es -> String -> Doc
text String
f Doc -> Doc -> Doc
<> Doc -> Doc
parens ((SqlExpr -> Doc) -> [SqlExpr] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaH SqlExpr -> Doc
ppSqlExpr [SqlExpr]
es)
ConstSqlExpr String
c -> String -> Doc
text String
c
CaseSqlExpr [(SqlExpr, SqlExpr)]
cs SqlExpr
el -> String -> Doc
text String
"CASE" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat (((SqlExpr, SqlExpr) -> Doc) -> [(SqlExpr, SqlExpr)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (SqlExpr, SqlExpr) -> Doc
ppWhen [(SqlExpr, SqlExpr)]
cs)
Doc -> Doc -> Doc
<+> String -> Doc
text String
"ELSE" Doc -> Doc -> Doc
<+> SqlExpr -> Doc
ppSqlExpr SqlExpr
el Doc -> Doc -> Doc
<+> String -> Doc
text String
"END"
where ppWhen :: (SqlExpr, SqlExpr) -> Doc
ppWhen (SqlExpr
w,SqlExpr
t) = String -> Doc
text String
"WHEN" Doc -> Doc -> Doc
<+> SqlExpr -> Doc
ppSqlExpr SqlExpr
w
Doc -> Doc -> Doc
<+> String -> Doc
text String
"THEN" Doc -> Doc -> Doc
<+> SqlExpr -> Doc
ppSqlExpr SqlExpr
t
ListSqlExpr [SqlExpr]
es -> Doc -> Doc
parens ((SqlExpr -> Doc) -> [SqlExpr] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaH SqlExpr -> Doc
ppSqlExpr [SqlExpr]
es)
ParamSqlExpr Maybe String
_ SqlExpr
v -> SqlExpr -> Doc
ppSqlExpr SqlExpr
v
SqlExpr
PlaceHolderSqlExpr -> String -> Doc
text String
"?"
CastSqlExpr String
typ SqlExpr
e -> String -> Doc
text String
"CAST" Doc -> Doc -> Doc
<> Doc -> Doc
parens (SqlExpr -> Doc
ppSqlExpr SqlExpr
e Doc -> Doc -> Doc
<+> String -> Doc
text String
"AS" Doc -> Doc -> Doc
<+> String -> Doc
text String
typ)
SqlExpr
DefaultSqlExpr -> String -> Doc
text String
"DEFAULT"
commaH :: (a -> Doc) -> [a] -> Doc
commaH :: (a -> Doc) -> [a] -> Doc
commaH a -> Doc
f = [Doc] -> Doc
hcat ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
f
commaV :: (a -> Doc) -> [a] -> Doc
commaV :: (a -> Doc) -> [a] -> Doc
commaV a -> Doc
f = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
f