module Opaleye.SQLite.Internal.HaskellDB.Sql.Default where
import Opaleye.SQLite.Internal.HaskellDB.PrimQuery
import qualified Opaleye.SQLite.Internal.HaskellDB.PrimQuery as PQ
import Opaleye.SQLite.Internal.HaskellDB.Sql
import Opaleye.SQLite.Internal.HaskellDB.Sql.Generate
import qualified Opaleye.SQLite.Internal.HaskellDB.Sql as Sql
import Opaleye.SQLite.Internal.Tag (tagWith)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Base16 as Base16
import qualified Data.List.NonEmpty as NEL
mkSqlGenerator :: SqlGenerator -> SqlGenerator
mkSqlGenerator :: SqlGenerator -> SqlGenerator
mkSqlGenerator SqlGenerator
gen = SqlGenerator :: (TableName -> [PrimExpr] -> Assoc -> SqlUpdate)
-> (TableName -> [PrimExpr] -> SqlDelete)
-> (TableName -> [TableName] -> NonEmpty [PrimExpr] -> SqlInsert)
-> (PrimExpr -> SqlExpr)
-> (Literal -> TableName)
-> (TableName -> TableName)
-> SqlGenerator
SqlGenerator
{
sqlUpdate :: TableName -> [PrimExpr] -> Assoc -> SqlUpdate
sqlUpdate = SqlGenerator -> TableName -> [PrimExpr] -> Assoc -> SqlUpdate
defaultSqlUpdate SqlGenerator
gen,
sqlDelete :: TableName -> [PrimExpr] -> SqlDelete
sqlDelete = SqlGenerator -> TableName -> [PrimExpr] -> SqlDelete
defaultSqlDelete SqlGenerator
gen,
sqlInsert :: TableName -> [TableName] -> NonEmpty [PrimExpr] -> SqlInsert
sqlInsert = SqlGenerator
-> TableName -> [TableName] -> NonEmpty [PrimExpr] -> SqlInsert
defaultSqlInsert SqlGenerator
gen,
sqlExpr :: PrimExpr -> SqlExpr
sqlExpr = SqlGenerator -> PrimExpr -> SqlExpr
defaultSqlExpr SqlGenerator
gen,
sqlLiteral :: Literal -> TableName
sqlLiteral = SqlGenerator -> Literal -> TableName
defaultSqlLiteral SqlGenerator
gen,
sqlQuote :: TableName -> TableName
sqlQuote = SqlGenerator -> TableName -> TableName
defaultSqlQuote SqlGenerator
gen
}
defaultSqlGenerator :: SqlGenerator
defaultSqlGenerator :: SqlGenerator
defaultSqlGenerator = SqlGenerator -> SqlGenerator
mkSqlGenerator SqlGenerator
defaultSqlGenerator
toSqlOrder :: SqlGenerator -> OrderExpr -> (SqlExpr,SqlOrder)
toSqlOrder :: SqlGenerator -> OrderExpr -> (SqlExpr, SqlOrder)
toSqlOrder SqlGenerator
gen (OrderExpr OrderOp
o PrimExpr
e) =
(SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e, SqlOrder :: SqlOrderDirection -> SqlOrderNulls -> SqlOrder
Sql.SqlOrder { sqlOrderDirection :: SqlOrderDirection
sqlOrderDirection = SqlOrderDirection
o'
, sqlOrderNulls :: SqlOrderNulls
sqlOrderNulls = SqlOrderNulls
orderNulls' })
where o' :: SqlOrderDirection
o' = case OrderOp -> OrderDirection
PQ.orderDirection OrderOp
o of
OrderDirection
PQ.OpAsc -> SqlOrderDirection
Sql.SqlAsc
OrderDirection
PQ.OpDesc -> SqlOrderDirection
Sql.SqlDesc
orderNulls' :: SqlOrderNulls
orderNulls' = case OrderOp -> OrderNulls
PQ.orderNulls OrderOp
o of
OrderNulls
PQ.NullsFirst -> SqlOrderNulls
Sql.SqlNullsFirst
OrderNulls
PQ.NullsLast -> SqlOrderNulls
Sql.SqlNullsLast
toSqlColumn :: Attribute -> SqlColumn
toSqlColumn :: TableName -> SqlColumn
toSqlColumn TableName
attr = TableName -> SqlColumn
SqlColumn TableName
attr
toSqlAssoc :: SqlGenerator -> Assoc -> [(SqlColumn,SqlExpr)]
toSqlAssoc :: SqlGenerator -> Assoc -> [(SqlColumn, SqlExpr)]
toSqlAssoc SqlGenerator
gen = ((TableName, PrimExpr) -> (SqlColumn, SqlExpr))
-> Assoc -> [(SqlColumn, SqlExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (\(TableName
attr,PrimExpr
expr) -> (TableName -> SqlColumn
toSqlColumn TableName
attr, SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
expr))
defaultSqlUpdate :: SqlGenerator
-> TableName
-> [PrimExpr]
-> Assoc
-> SqlUpdate
defaultSqlUpdate :: SqlGenerator -> TableName -> [PrimExpr] -> Assoc -> SqlUpdate
defaultSqlUpdate SqlGenerator
gen TableName
name [PrimExpr]
criteria Assoc
assigns
= SqlTable -> [(SqlColumn, SqlExpr)] -> [SqlExpr] -> SqlUpdate
SqlUpdate (TableName -> SqlTable
SqlTable TableName
name) (SqlGenerator -> Assoc -> [(SqlColumn, SqlExpr)]
toSqlAssoc SqlGenerator
gen Assoc
assigns) ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr]
criteria)
defaultSqlInsert :: SqlGenerator
-> TableName
-> [Attribute]
-> NEL.NonEmpty [PrimExpr]
-> SqlInsert
defaultSqlInsert :: SqlGenerator
-> TableName -> [TableName] -> NonEmpty [PrimExpr] -> SqlInsert
defaultSqlInsert SqlGenerator
gen TableName
name [TableName]
attrs NonEmpty [PrimExpr]
exprs =
SqlTable -> [SqlColumn] -> NonEmpty [SqlExpr] -> SqlInsert
SqlInsert (TableName -> SqlTable
SqlTable TableName
name) ((TableName -> SqlColumn) -> [TableName] -> [SqlColumn]
forall a b. (a -> b) -> [a] -> [b]
map TableName -> SqlColumn
toSqlColumn [TableName]
attrs) ((([PrimExpr] -> [SqlExpr])
-> NonEmpty [PrimExpr] -> NonEmpty [SqlExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([PrimExpr] -> [SqlExpr])
-> NonEmpty [PrimExpr] -> NonEmpty [SqlExpr])
-> ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr])
-> (PrimExpr -> SqlExpr)
-> NonEmpty [PrimExpr]
-> NonEmpty [SqlExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map) (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) NonEmpty [PrimExpr]
exprs)
defaultSqlDelete :: SqlGenerator
-> TableName
-> [PrimExpr]
-> SqlDelete
defaultSqlDelete :: SqlGenerator -> TableName -> [PrimExpr] -> SqlDelete
defaultSqlDelete SqlGenerator
gen TableName
name [PrimExpr]
criteria = SqlTable -> [SqlExpr] -> SqlDelete
SqlDelete (TableName -> SqlTable
SqlTable TableName
name) ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr]
criteria)
defaultSqlExpr :: SqlGenerator -> PrimExpr -> SqlExpr
defaultSqlExpr :: SqlGenerator -> PrimExpr -> SqlExpr
defaultSqlExpr SqlGenerator
gen PrimExpr
expr =
case PrimExpr
expr of
AttrExpr (Symbol TableName
a Tag
t) -> SqlColumn -> SqlExpr
ColumnSqlExpr (TableName -> SqlColumn
SqlColumn (Tag -> TableName -> TableName
tagWith Tag
t TableName
a))
BaseTableAttrExpr TableName
a -> SqlColumn -> SqlExpr
ColumnSqlExpr (TableName -> SqlColumn
SqlColumn TableName
a)
BinExpr BinOp
op PrimExpr
e1 PrimExpr
e2 ->
let leftE :: SqlExpr
leftE = SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e1
rightE :: SqlExpr
rightE = SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e2
paren :: SqlExpr -> SqlExpr
paren = SqlExpr -> SqlExpr
ParensSqlExpr
(SqlExpr
expL, SqlExpr
expR) = case (BinOp
op, PrimExpr
e1, PrimExpr
e2) of
(BinOp
OpAnd, BinExpr BinOp
OpOr PrimExpr
_ PrimExpr
_, BinExpr BinOp
OpOr PrimExpr
_ PrimExpr
_) ->
(SqlExpr -> SqlExpr
paren SqlExpr
leftE, SqlExpr -> SqlExpr
paren SqlExpr
rightE)
(BinOp
OpOr, BinExpr BinOp
OpAnd PrimExpr
_ PrimExpr
_, BinExpr BinOp
OpAnd PrimExpr
_ PrimExpr
_) ->
(SqlExpr -> SqlExpr
paren SqlExpr
leftE, SqlExpr -> SqlExpr
paren SqlExpr
rightE)
(BinOp
OpAnd, BinExpr BinOp
OpOr PrimExpr
_ PrimExpr
_, PrimExpr
_) ->
(SqlExpr -> SqlExpr
paren SqlExpr
leftE, SqlExpr
rightE)
(BinOp
OpAnd, PrimExpr
_, BinExpr BinOp
OpOr PrimExpr
_ PrimExpr
_) ->
(SqlExpr
leftE, SqlExpr -> SqlExpr
paren SqlExpr
rightE)
(BinOp
OpOr, BinExpr BinOp
OpAnd PrimExpr
_ PrimExpr
_, PrimExpr
_) ->
(SqlExpr -> SqlExpr
paren SqlExpr
leftE, SqlExpr
rightE)
(BinOp
OpOr, PrimExpr
_, BinExpr BinOp
OpAnd PrimExpr
_ PrimExpr
_) ->
(SqlExpr
leftE, SqlExpr -> SqlExpr
paren SqlExpr
rightE)
(BinOp
_, ConstExpr Literal
_, ConstExpr Literal
_) ->
(SqlExpr
leftE, SqlExpr
rightE)
(BinOp
_, PrimExpr
_, ConstExpr Literal
_) ->
(SqlExpr -> SqlExpr
paren SqlExpr
leftE, SqlExpr
rightE)
(BinOp
_, ConstExpr Literal
_, PrimExpr
_) ->
(SqlExpr
leftE, SqlExpr -> SqlExpr
paren SqlExpr
rightE)
(BinOp, PrimExpr, PrimExpr)
_ -> (SqlExpr -> SqlExpr
paren SqlExpr
leftE, SqlExpr -> SqlExpr
paren SqlExpr
rightE)
in TableName -> SqlExpr -> SqlExpr -> SqlExpr
BinSqlExpr (BinOp -> TableName
showBinOp BinOp
op) SqlExpr
expL SqlExpr
expR
UnExpr UnOp
op PrimExpr
e -> let (TableName
op',UnOpType
t) = UnOp -> (TableName, UnOpType)
sqlUnOp UnOp
op
e' :: SqlExpr
e' = SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e
in case UnOpType
t of
UnOpType
UnOpFun -> TableName -> [SqlExpr] -> SqlExpr
FunSqlExpr TableName
op' [SqlExpr
e']
UnOpType
UnOpPrefix -> TableName -> SqlExpr -> SqlExpr
PrefixSqlExpr TableName
op' (SqlExpr -> SqlExpr
ParensSqlExpr SqlExpr
e')
UnOpType
UnOpPostfix -> TableName -> SqlExpr -> SqlExpr
PostfixSqlExpr TableName
op' SqlExpr
e'
AggrExpr AggrOp
op PrimExpr
e -> let op' :: TableName
op' = AggrOp -> TableName
showAggrOp AggrOp
op
e' :: SqlExpr
e' = SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e
moreAggrFunParams :: [SqlExpr]
moreAggrFunParams = case AggrOp
op of
AggrStringAggr PrimExpr
primE -> [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
primE]
AggrOp
_ -> []
in TableName -> [SqlExpr] -> SqlExpr
AggrFunSqlExpr TableName
op' (SqlExpr
e' SqlExpr -> [SqlExpr] -> [SqlExpr]
forall a. a -> [a] -> [a]
: [SqlExpr]
moreAggrFunParams)
ConstExpr Literal
l -> TableName -> SqlExpr
ConstSqlExpr (SqlGenerator -> Literal -> TableName
sqlLiteral SqlGenerator
gen Literal
l)
CaseExpr [(PrimExpr, PrimExpr)]
cs PrimExpr
e -> let cs' :: [(SqlExpr, SqlExpr)]
cs' = [(SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
c, SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
x)| (PrimExpr
c,PrimExpr
x) <- [(PrimExpr, PrimExpr)]
cs]
e' :: SqlExpr
e' = SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e
in [(SqlExpr, SqlExpr)] -> SqlExpr -> SqlExpr
CaseSqlExpr [(SqlExpr, SqlExpr)]
cs' SqlExpr
e'
ListExpr [PrimExpr]
es -> [SqlExpr] -> SqlExpr
ListSqlExpr ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr]
es)
ParamExpr Maybe TableName
n PrimExpr
_ -> Maybe TableName -> SqlExpr -> SqlExpr
ParamSqlExpr Maybe TableName
n SqlExpr
PlaceHolderSqlExpr
FunExpr TableName
n [PrimExpr]
exprs -> TableName -> [SqlExpr] -> SqlExpr
FunSqlExpr TableName
n ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr]
exprs)
CastExpr TableName
typ PrimExpr
e1 -> TableName -> SqlExpr -> SqlExpr
CastSqlExpr TableName
typ (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e1)
PrimExpr
DefaultInsertExpr -> SqlExpr
DefaultSqlExpr
showBinOp :: BinOp -> String
showBinOp :: BinOp -> TableName
showBinOp BinOp
OpEq = TableName
"="
showBinOp BinOp
OpLt = TableName
"<"
showBinOp BinOp
OpLtEq = TableName
"<="
showBinOp BinOp
OpGt = TableName
">"
showBinOp BinOp
OpGtEq = TableName
">="
showBinOp BinOp
OpNotEq = TableName
"<>"
showBinOp BinOp
OpAnd = TableName
"AND"
showBinOp BinOp
OpOr = TableName
"OR"
showBinOp BinOp
OpLike = TableName
"LIKE"
showBinOp BinOp
OpIn = TableName
"IN"
showBinOp (OpOther TableName
s) = TableName
s
showBinOp BinOp
OpCat = TableName
"||"
showBinOp BinOp
OpPlus = TableName
"+"
showBinOp BinOp
OpMinus = TableName
"-"
showBinOp BinOp
OpMul = TableName
"*"
showBinOp BinOp
OpDiv = TableName
"/"
showBinOp BinOp
OpMod = TableName
"MOD"
showBinOp BinOp
OpBitNot = TableName
"~"
showBinOp BinOp
OpBitAnd = TableName
"&"
showBinOp BinOp
OpBitOr = TableName
"|"
showBinOp BinOp
OpBitXor = TableName
"^"
showBinOp BinOp
OpAsg = TableName
"="
data UnOpType = UnOpFun | UnOpPrefix | UnOpPostfix
sqlUnOp :: UnOp -> (String,UnOpType)
sqlUnOp :: UnOp -> (TableName, UnOpType)
sqlUnOp UnOp
OpNot = (TableName
"NOT", UnOpType
UnOpPrefix)
sqlUnOp UnOp
OpIsNull = (TableName
"IS NULL", UnOpType
UnOpPostfix)
sqlUnOp UnOp
OpIsNotNull = (TableName
"IS NOT NULL", UnOpType
UnOpPostfix)
sqlUnOp UnOp
OpLength = (TableName
"LENGTH", UnOpType
UnOpFun)
sqlUnOp UnOp
OpAbs = (TableName
"ABS", UnOpType
UnOpFun)
sqlUnOp UnOp
OpNegate = (TableName
"-", UnOpType
UnOpFun)
sqlUnOp UnOp
OpLower = (TableName
"LOWER", UnOpType
UnOpFun)
sqlUnOp UnOp
OpUpper = (TableName
"UPPER", UnOpType
UnOpFun)
sqlUnOp (UnOpOther TableName
s) = (TableName
s, UnOpType
UnOpFun)
showAggrOp :: AggrOp -> String
showAggrOp :: AggrOp -> TableName
showAggrOp AggrOp
AggrCount = TableName
"COUNT"
showAggrOp AggrOp
AggrSum = TableName
"SUM"
showAggrOp AggrOp
AggrAvg = TableName
"AVG"
showAggrOp AggrOp
AggrMin = TableName
"MIN"
showAggrOp AggrOp
AggrMax = TableName
"MAX"
showAggrOp AggrOp
AggrStdDev = TableName
"StdDev"
showAggrOp AggrOp
AggrStdDevP = TableName
"StdDevP"
showAggrOp AggrOp
AggrVar = TableName
"Var"
showAggrOp AggrOp
AggrVarP = TableName
"VarP"
showAggrOp AggrOp
AggrBoolAnd = TableName
"BOOL_AND"
showAggrOp AggrOp
AggrBoolOr = TableName
"BOOL_OR"
showAggrOp AggrOp
AggrArr = TableName
"ARRAY_AGG"
showAggrOp (AggrStringAggr PrimExpr
_) = TableName
"STRING_AGG"
showAggrOp (AggrOther TableName
s) = TableName
s
defaultSqlLiteral :: SqlGenerator -> Literal -> String
defaultSqlLiteral :: SqlGenerator -> Literal -> TableName
defaultSqlLiteral SqlGenerator
_ Literal
l =
case Literal
l of
Literal
NullLit -> TableName
"NULL"
Literal
DefaultLit -> TableName
"DEFAULT"
BoolLit Bool
True -> TableName
"1"
BoolLit Bool
False -> TableName
"0"
ByteStringLit ByteString
s
-> ByteString -> TableName
binQuote ByteString
s
StringLit TableName
s -> TableName -> TableName
quote TableName
s
IntegerLit Integer
i -> Integer -> TableName
forall a. Show a => a -> TableName
show Integer
i
DoubleLit Double
d -> Double -> TableName
forall a. Show a => a -> TableName
show Double
d
OtherLit TableName
o -> TableName
o
defaultSqlQuote :: SqlGenerator -> String -> String
defaultSqlQuote :: SqlGenerator -> TableName -> TableName
defaultSqlQuote SqlGenerator
_ TableName
s = TableName -> TableName
quote TableName
s
quote :: String -> String
quote :: TableName -> TableName
quote TableName
s = TableName
"'" TableName -> TableName -> TableName
forall a. [a] -> [a] -> [a]
++ (Char -> TableName) -> TableName -> TableName
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> TableName
escape TableName
s TableName -> TableName -> TableName
forall a. [a] -> [a] -> [a]
++ TableName
"'"
escape :: Char -> String
escape :: Char -> TableName
escape Char
'\NUL' = TableName
"\\0"
escape Char
'\'' = TableName
"''"
escape Char
'"' = TableName
"\\\""
escape Char
'\b' = TableName
"\\b"
escape Char
'\n' = TableName
"\\n"
escape Char
'\r' = TableName
"\\r"
escape Char
'\t' = TableName
"\\t"
escape Char
'\\' = TableName
"\\\\"
escape Char
c = [Char
c]
binQuote :: ByteString -> String
binQuote :: ByteString -> TableName
binQuote ByteString
s = TableName
"E'\\\\x" TableName -> TableName -> TableName
forall a. [a] -> [a] -> [a]
++ ByteString -> TableName
BS8.unpack (ByteString -> ByteString
Base16.encode ByteString
s) TableName -> TableName -> TableName
forall a. [a] -> [a] -> [a]
++ TableName
"'"