-- Copyright   :  Daan Leijen (c) 1999, daan@cs.uu.nl
--                HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net
-- License     :  BSD-style

module Opaleye.Internal.HaskellDB.Sql.Default  where

import Control.Applicative ((<$>))

import Opaleye.Internal.HaskellDB.PrimQuery
import qualified Opaleye.Internal.HaskellDB.PrimQuery as PQ
import Opaleye.Internal.HaskellDB.Sql
import Opaleye.Internal.HaskellDB.Sql.Generate
import qualified Opaleye.Internal.HaskellDB.Sql as Sql
import Opaleye.Internal.Tag (tagWith)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Base16 as Base16
import qualified Data.Char
import qualified Data.List.NonEmpty as NEL
import qualified Data.Text.Lazy.Builder.Scientific as Sci
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as LT
import qualified Text.Printf


mkSqlGenerator :: SqlGenerator -> SqlGenerator
mkSqlGenerator :: SqlGenerator -> SqlGenerator
mkSqlGenerator SqlGenerator
gen = SqlGenerator
    {
     sqlUpdate :: SqlTable -> [PrimExpr] -> Assoc -> SqlUpdate
sqlUpdate      = SqlGenerator -> SqlTable -> [PrimExpr] -> Assoc -> SqlUpdate
defaultSqlUpdate      SqlGenerator
gen,
     sqlDelete :: SqlTable -> [PrimExpr] -> SqlDelete
sqlDelete      = SqlGenerator -> SqlTable -> [PrimExpr] -> SqlDelete
defaultSqlDelete      SqlGenerator
gen,
     sqlInsert :: SqlTable
-> [String] -> NonEmpty [PrimExpr] -> Maybe OnConflict -> SqlInsert
sqlInsert      = SqlGenerator
-> SqlTable
-> [String]
-> NonEmpty [PrimExpr]
-> Maybe OnConflict
-> SqlInsert
defaultSqlInsert      SqlGenerator
gen,
     sqlExpr :: PrimExpr -> SqlExpr
sqlExpr        = SqlGenerator -> PrimExpr -> SqlExpr
defaultSqlExpr        SqlGenerator
gen,
     sqlLiteral :: Literal -> String
sqlLiteral     = SqlGenerator -> Literal -> String
defaultSqlLiteral     SqlGenerator
gen,
     sqlQuote :: String -> String
sqlQuote       = SqlGenerator -> String -> String
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, 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


toSqlPartition :: SqlGenerator -> Partition -> SqlPartition
toSqlPartition :: SqlGenerator -> Partition -> SqlPartition
toSqlPartition SqlGenerator
gen (Partition [PrimExpr]
partition [OrderExpr]
order) = SqlPartition
  { sqlPartitionBy :: Maybe (NonEmpty SqlExpr)
sqlPartitionBy = forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty (forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr]
partition)
  , sqlOrderBy :: Maybe (NonEmpty (SqlExpr, SqlOrder))
sqlOrderBy = forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty (forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> OrderExpr -> (SqlExpr, SqlOrder)
toSqlOrder SqlGenerator
gen) [OrderExpr]
order)
  }


toSqlColumn :: Attribute -> SqlColumn
toSqlColumn :: String -> SqlColumn
toSqlColumn = String -> SqlColumn
SqlColumn

toSqlAssoc :: SqlGenerator -> Assoc -> [(SqlColumn,SqlExpr)]
toSqlAssoc :: SqlGenerator -> Assoc -> [(SqlColumn, SqlExpr)]
toSqlAssoc SqlGenerator
gen = forall a b. (a -> b) -> [a] -> [b]
map (\(String
attr,PrimExpr
expr) -> (String -> SqlColumn
toSqlColumn String
attr, SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
expr))


defaultSqlUpdate :: SqlGenerator
                 -> SqlTable   -- ^ Table to update
                 -> [PrimExpr] -- ^ Conditions which must all be true for a row
                               --   to be updated.
                 -> Assoc -- ^ Update the data with this.
                 -> SqlUpdate
defaultSqlUpdate :: SqlGenerator -> SqlTable -> [PrimExpr] -> Assoc -> SqlUpdate
defaultSqlUpdate SqlGenerator
gen SqlTable
tbl [PrimExpr]
criteria Assoc
assigns
        = SqlTable -> [(SqlColumn, SqlExpr)] -> [SqlExpr] -> SqlUpdate
SqlUpdate SqlTable
tbl (SqlGenerator -> Assoc -> [(SqlColumn, SqlExpr)]
toSqlAssoc SqlGenerator
gen Assoc
assigns) (forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr]
criteria)


defaultSqlInsert :: SqlGenerator
                 -> SqlTable
                 -> [Attribute]
                 -> NEL.NonEmpty [PrimExpr]
                 -> Maybe OnConflict
                 -> SqlInsert
defaultSqlInsert :: SqlGenerator
-> SqlTable
-> [String]
-> NonEmpty [PrimExpr]
-> Maybe OnConflict
-> SqlInsert
defaultSqlInsert SqlGenerator
gen SqlTable
tbl [String]
attrs NonEmpty [PrimExpr]
exprs =
  SqlTable
-> [SqlColumn]
-> NonEmpty [SqlExpr]
-> Maybe OnConflict
-> SqlInsert
SqlInsert SqlTable
tbl (forall a b. (a -> b) -> [a] -> [b]
map String -> SqlColumn
toSqlColumn [String]
attrs) ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) NonEmpty [PrimExpr]
exprs)

defaultSqlDelete :: SqlGenerator
                 -> SqlTable
                 -> [PrimExpr] -- ^ Criteria which must all be true for a row
                               --   to be deleted.
                 -> SqlDelete
defaultSqlDelete :: SqlGenerator -> SqlTable -> [PrimExpr] -> SqlDelete
defaultSqlDelete SqlGenerator
gen SqlTable
tbl [PrimExpr]
criteria = SqlTable -> [SqlExpr] -> SqlDelete
SqlDelete SqlTable
tbl (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 String
a Tag
t) -> SqlColumn -> SqlExpr
ColumnSqlExpr (String -> SqlColumn
SqlColumn (Tag -> String -> String
tagWith Tag
t String
a))
      BaseTableAttrExpr String
a -> SqlColumn -> SqlExpr
ColumnSqlExpr (String -> SqlColumn
SqlColumn String
a)
      CompositeExpr PrimExpr
e String
x -> SqlExpr -> String -> SqlExpr
CompositeSqlExpr (SqlGenerator -> PrimExpr -> SqlExpr
defaultSqlExpr SqlGenerator
gen PrimExpr
e) String
x
      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
OpIn, PrimExpr
_, ListExpr NonEmpty PrimExpr
_) ->
                (SqlExpr
leftE, 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 String -> SqlExpr -> SqlExpr -> SqlExpr
BinSqlExpr (BinOp -> String
showBinOp BinOp
op) SqlExpr
expL SqlExpr
expR
      UnExpr UnOp
op PrimExpr
e      -> let (String
op',UnOpType
t) = UnOp -> (String, UnOpType)
sqlUnOp UnOp
op
                              e' :: SqlExpr
e' = SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e
                           in case UnOpType
t of
                                UnOpType
UnOpFun     -> String -> [SqlExpr] -> SqlExpr
FunSqlExpr String
op' [SqlExpr
e']
                                UnOpType
UnOpPrefix  -> String -> SqlExpr -> SqlExpr
PrefixSqlExpr String
op' (SqlExpr -> SqlExpr
ParensSqlExpr SqlExpr
e')
                                UnOpType
UnOpPostfix -> String -> SqlExpr -> SqlExpr
PostfixSqlExpr String
op' (SqlExpr -> SqlExpr
ParensSqlExpr SqlExpr
e')
      -- TODO: The current arrangement whereby the delimiter parameter
      -- of string_agg is in the AggrStringAggr constructor, but the
      -- parameter being aggregated is not, seems unsatisfactory
      -- because it leads to a non-uniformity of treatment, as seen
      -- below.  Perhaps we should have just `AggrExpr AggrOp` and
      -- always put the `PrimExpr` in the `AggrOp`.
      AggrExpr AggrDistinct
distinct AggrOp
op PrimExpr
e [OrderExpr]
ord -> let (String
op', [SqlExpr]
e') = SqlGenerator -> AggrOp -> PrimExpr -> (String, [SqlExpr])
showAggrOp SqlGenerator
gen AggrOp
op PrimExpr
e
                                        ord' :: [(SqlExpr, SqlOrder)]
ord' = SqlGenerator -> OrderExpr -> (SqlExpr, SqlOrder)
toSqlOrder SqlGenerator
gen forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OrderExpr]
ord
                                        distinct' :: SqlDistinct
distinct' = case AggrDistinct
distinct of
                                                      AggrDistinct
AggrDistinct -> SqlDistinct
SqlDistinct
                                                      AggrDistinct
AggrAll      -> SqlDistinct
SqlNotDistinct
                                     in String
-> [SqlExpr] -> [(SqlExpr, SqlOrder)] -> SqlDistinct -> SqlExpr
AggrFunSqlExpr String
op' [SqlExpr]
e' [(SqlExpr, SqlOrder)]
ord' SqlDistinct
distinct'
      WndwExpr WndwOp
op Partition
window  -> let (String
op', [SqlExpr]
e') = SqlGenerator -> WndwOp -> (String, [SqlExpr])
showWndwOp SqlGenerator
gen WndwOp
op
                                 window' :: SqlPartition
window' = SqlGenerator -> Partition -> SqlPartition
toSqlPartition SqlGenerator
gen Partition
window
                              in String -> [SqlExpr] -> SqlPartition -> SqlExpr
WndwFunSqlExpr String
op' [SqlExpr]
e' SqlPartition
window'
      ConstExpr Literal
l      -> String -> SqlExpr
ConstSqlExpr (SqlGenerator -> Literal -> String
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 case forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [(SqlExpr, SqlExpr)]
cs' of
                            Just NonEmpty (SqlExpr, SqlExpr)
nel -> NonEmpty (SqlExpr, SqlExpr) -> SqlExpr -> SqlExpr
CaseSqlExpr NonEmpty (SqlExpr, SqlExpr)
nel SqlExpr
e'
                            Maybe (NonEmpty (SqlExpr, SqlExpr))
Nothing  -> SqlExpr
e'
      ListExpr NonEmpty PrimExpr
es      -> NonEmpty SqlExpr -> SqlExpr
ListSqlExpr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) NonEmpty PrimExpr
es)
      ParamExpr Maybe String
n PrimExpr
_    -> Maybe String -> SqlExpr -> SqlExpr
ParamSqlExpr Maybe String
n SqlExpr
PlaceHolderSqlExpr
      FunExpr String
n [PrimExpr]
exprs  -> String -> [SqlExpr] -> SqlExpr
FunSqlExpr String
n (forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr]
exprs)
      CastExpr String
typ PrimExpr
e1 -> String -> SqlExpr -> SqlExpr
CastSqlExpr String
typ (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e1)
      PrimExpr
DefaultInsertExpr -> SqlExpr
DefaultSqlExpr
      ArrayExpr [PrimExpr]
es -> [SqlExpr] -> SqlExpr
ArraySqlExpr (forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr]
es)
      RangeExpr String
t BoundExpr
l BoundExpr
r -> let bound :: PQ.BoundExpr -> Sql.SqlRangeBound
                             bound :: BoundExpr -> SqlRangeBound
bound (PQ.Inclusive PrimExpr
a) = SqlExpr -> SqlRangeBound
Sql.Inclusive (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
a)
                             bound (PQ.Exclusive PrimExpr
a) = SqlExpr -> SqlRangeBound
Sql.Exclusive (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
a)
                             bound BoundExpr
PQ.PosInfinity   = SqlRangeBound
Sql.PosInfinity
                             bound BoundExpr
PQ.NegInfinity   = SqlRangeBound
Sql.NegInfinity
                        in String -> SqlRangeBound -> SqlRangeBound -> SqlExpr
RangeSqlExpr String
t (BoundExpr -> SqlRangeBound
bound BoundExpr
l) (BoundExpr -> SqlRangeBound
bound BoundExpr
r)
      ArrayIndex PrimExpr
e1 PrimExpr
e2 -> SqlExpr -> SqlExpr -> SqlExpr
SubscriptSqlExpr (SqlExpr -> SqlExpr
ParensSqlExpr forall a b. (a -> b) -> a -> b
$ SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e1) (SqlExpr -> SqlExpr
ParensSqlExpr forall a b. (a -> b) -> a -> b
$ SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e2)

showBinOp :: BinOp -> String
showBinOp :: BinOp -> String
showBinOp  BinOp
(:==)        = String
"="
showBinOp  BinOp
(:<)         = String
"<"
showBinOp  BinOp
(:<=)        = String
"<="
showBinOp  BinOp
(:>)         = String
">"
showBinOp  BinOp
(:>=)        = String
">="
showBinOp  BinOp
(:<>)        = String
"<>"
showBinOp  BinOp
OpAnd        = String
"AND"
showBinOp  BinOp
OpOr         = String
"OR"
showBinOp  BinOp
OpLike       = String
"LIKE"
showBinOp  BinOp
OpILike      = String
"ILIKE"
showBinOp  BinOp
OpIn         = String
"IN"
showBinOp  (OpOther String
s)  = String
s
showBinOp  BinOp
(:||)        = String
"||"
showBinOp  BinOp
(:+)         = String
"+"
showBinOp  BinOp
(:-)         = String
"-"
showBinOp  BinOp
(:*)         = String
"*"
showBinOp  BinOp
(:/)         = String
"/"
showBinOp  BinOp
OpMod        = String
"MOD"
showBinOp  BinOp
(:~)         = String
"~"
showBinOp  BinOp
(:&)         = String
"&"
showBinOp  BinOp
(:|)         = String
"|"
showBinOp  BinOp
(:^)         = String
"^"
showBinOp  BinOp
(:=)         = String
"="
showBinOp  BinOp
OpAtTimeZone = String
"AT TIME ZONE"
showBinOp  BinOp
(:->)        = String
"->"
showBinOp  BinOp
(:->>)       = String
"->>"
showBinOp  BinOp
(:#>)        = String
"#>"
showBinOp  BinOp
(:#>>)       = String
"#>>"
showBinOp  BinOp
(:@>)        = String
"@>"
showBinOp  BinOp
(:<@)        = String
"<@"
showBinOp  BinOp
(:?)         = String
"?"
showBinOp  BinOp
(:?|)        = String
"?|"
showBinOp  BinOp
(:?&)        = String
"?&"
showBinOp  BinOp
(:&&)        = String
"&&"
showBinOp  BinOp
(:<<)        = String
"<<"
showBinOp  BinOp
(:>>)        = String
">>"
showBinOp  BinOp
(:&<)        = String
"&<"
showBinOp  BinOp
(:&>)        = String
"&>"
showBinOp  BinOp
(:-|-)       = String
"-|-"

data UnOpType = UnOpFun | UnOpPrefix | UnOpPostfix

sqlUnOp :: UnOp -> (String,UnOpType)
sqlUnOp :: UnOp -> (String, UnOpType)
sqlUnOp  UnOp
OpNot         = (String
"NOT", UnOpType
UnOpPrefix)
sqlUnOp  UnOp
OpIsNull      = (String
"IS NULL", UnOpType
UnOpPostfix)
sqlUnOp  UnOp
OpIsNotNull   = (String
"IS NOT NULL", UnOpType
UnOpPostfix)
sqlUnOp  UnOp
OpLength      = (String
"LENGTH", UnOpType
UnOpFun)
sqlUnOp  UnOp
OpAbs         = (String
"@", UnOpType
UnOpFun)
sqlUnOp  UnOp
OpNegate      = (String
"-", UnOpType
UnOpFun)
sqlUnOp  UnOp
OpLower       = (String
"LOWER", UnOpType
UnOpFun)
sqlUnOp  UnOp
OpUpper       = (String
"UPPER", UnOpType
UnOpFun)
sqlUnOp  (UnOpOther String
s) = (String
s, UnOpType
UnOpFun)


showAggrOp :: SqlGenerator -> AggrOp -> PrimExpr -> (String, [SqlExpr])
showAggrOp :: SqlGenerator -> AggrOp -> PrimExpr -> (String, [SqlExpr])
showAggrOp SqlGenerator
gen AggrOp
op PrimExpr
arg = case AggrOp
op of
  AggrOp
AggrCount -> (String
"COUNT", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrOp
AggrSum -> (String
"SUM", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrOp
AggrAvg -> (String
"AVG", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrOp
AggrMin -> (String
"MIN", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrOp
AggrMax -> (String
"MAX", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrOp
AggrStdDev -> (String
"StdDev", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrOp
AggrStdDevP -> (String
"StdDevP", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrOp
AggrVar -> (String
"Var", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrOp
AggrVarP -> (String
"VarP", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrOp
AggrBoolAnd -> (String
"BOOL_AND", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrOp
AggrBoolOr -> (String
"BOOL_OR", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrOp
AggrArr -> (String
"ARRAY_AGG", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrOp
JsonArr -> (String
"JSON_AGG", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])
  AggrStringAggr PrimExpr
sep -> (String
"STRING_AGG", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg, SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
sep])
  AggrOther String
s -> (String
s, [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
arg])


showWndwOp :: SqlGenerator -> WndwOp -> (String, [SqlExpr])
showWndwOp :: SqlGenerator -> WndwOp -> (String, [SqlExpr])
showWndwOp SqlGenerator
gen WndwOp
op = case WndwOp
op of
  WndwOp
WndwRowNumber -> (String
"ROW_NUMBER", [])
  WndwOp
WndwRank -> (String
"RANK", [])
  WndwOp
WndwDenseRank -> (String
"DENSE_RANK", [])
  WndwOp
WndwPercentRank -> (String
"PERCENT_RANK", [])
  WndwOp
WndwCumeDist -> (String
"CUME_DIST", [])
  WndwNtile PrimExpr
e -> (String
"NTILE", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e])
  WndwLag PrimExpr
e PrimExpr
offset PrimExpr
def -> (String
"LAG", forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr
e, PrimExpr
offset, PrimExpr
def])
  WndwLead PrimExpr
e PrimExpr
offset PrimExpr
def -> (String
"LEAD", forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr
e, PrimExpr
offset, PrimExpr
def])
  WndwFirstValue PrimExpr
e -> (String
"FIRST_VALUE", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e])
  WndwLastValue PrimExpr
e -> (String
"LAST_VALUE", [SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e])
  WndwNthValue PrimExpr
e PrimExpr
n -> (String
"NTH_VALUE", forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr
e, PrimExpr
n])
  WndwAggregate AggrOp
op' PrimExpr
arg -> SqlGenerator -> AggrOp -> PrimExpr -> (String, [SqlExpr])
showAggrOp SqlGenerator
gen AggrOp
op' PrimExpr
arg


defaultSqlLiteral :: SqlGenerator -> Literal -> String
defaultSqlLiteral :: SqlGenerator -> Literal -> String
defaultSqlLiteral SqlGenerator
_ Literal
l =
    case Literal
l of
      Literal
NullLit       -> String
"NULL"
      Literal
DefaultLit    -> String
"DEFAULT"
      BoolLit Bool
True  -> String
"TRUE"
      BoolLit Bool
False -> String
"FALSE"
      ByteStringLit ByteString
s
                    -> ByteString -> String
binQuote ByteString
s
      StringLit String
s   -> String -> String
quote String
s
      IntegerLit Integer
i  -> forall a. Show a => a -> String
show Integer
i
      DoubleLit Double
d   -> if forall a. RealFloat a => a -> Bool
isNaN Double
d then String
"'NaN'"
                       else if forall a. RealFloat a => a -> Bool
isInfinite Double
d Bool -> Bool -> Bool
&& Double
d forall a. Ord a => a -> a -> Bool
< Double
0 then String
"'-Infinity'"
                       else if forall a. RealFloat a => a -> Bool
isInfinite Double
d Bool -> Bool -> Bool
&& Double
d forall a. Ord a => a -> a -> Bool
> Double
0 then String
"'Infinity'"
                       else forall a. Show a => a -> String
show Double
d
      NumericLit Scientific
n  -> Text -> String
LT.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LT.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Builder
Sci.scientificBuilder forall a b. (a -> b) -> a -> b
$ Scientific
n
      OtherLit String
o    -> String
o


defaultSqlQuote :: SqlGenerator -> String -> String
defaultSqlQuote :: SqlGenerator -> String -> String
defaultSqlQuote SqlGenerator
_ = String -> String
quote

-- | Quote a string and escape characters that need escaping
--   We use Postgres "escape strings", i.e. strings prefixed
--   with E, to ensure that escaping with backslash is valid.
quote :: String -> String
quote :: String -> String
quote String
s = String
"E'" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escape String
s forall a. [a] -> [a] -> [a]
++ String
"'"

-- | Escape characters that need escaping
escape :: Char -> String
escape :: Char -> String
escape Char
'\NUL' = String
"\\0"
escape Char
'\'' = String
"''"
escape Char
'"' = String
"\\\""
escape Char
'\b' = String
"\\b"
escape Char
'\n' = String
"\\n"
escape Char
'\r' = String
"\\r"
escape Char
'\t' = String
"\\t"
escape Char
'\\' = String
"\\\\"
escape Char
c = if Char -> Bool
Data.Char.isPrint Char
c
           then [Char
c]
           else forall r. PrintfType r => String -> r
Text.Printf.printf String
"\\U%0.8x" (Char -> Int
Data.Char.ord Char
c)


-- | Quote binary literals using Postgresql's hex format.
binQuote :: ByteString -> String
binQuote :: ByteString -> String
binQuote ByteString
s = String
"E'\\\\x" forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS8.unpack (ByteString -> ByteString
Base16.encode ByteString
s) forall a. [a] -> [a] -> [a]
++ String
"'"