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

{-# LANGUAGE LambdaCase #-}

module Opaleye.Internal.HaskellDB.Sql.Default  where

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 = [SqlExpr] -> Maybe (NonEmpty SqlExpr)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr]
partition)
  , sqlOrderBy :: Maybe (NonEmpty (SqlExpr, SqlOrder))
sqlOrderBy = [(SqlExpr, SqlOrder)] -> Maybe (NonEmpty (SqlExpr, SqlOrder))
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty ((OrderExpr -> (SqlExpr, SqlOrder))
-> [OrderExpr] -> [(SqlExpr, SqlOrder)]
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 = ((String, PrimExpr) -> (SqlColumn, SqlExpr))
-> Assoc -> [(SqlColumn, SqlExpr)]
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) ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
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 ((String -> SqlColumn) -> [String] -> [SqlColumn]
forall a b. (a -> b) -> [a] -> [b]
map String -> SqlColumn
toSqlColumn [String]
attrs) ((([PrimExpr] -> [SqlExpr])
-> NonEmpty [PrimExpr] -> NonEmpty [SqlExpr]
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
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
                 -> 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 ((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 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')
      AggrExpr (Aggr AggrOp
op [PrimExpr]
e [OrderExpr]
ord AggrDistinct
distinct [OrderExpr]
group Maybe PrimExpr
mfilter) ->
        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 (OrderExpr -> (SqlExpr, SqlOrder))
-> [OrderExpr] -> [(SqlExpr, SqlOrder)]
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
          group' :: [(SqlExpr, SqlOrder)]
group' = SqlGenerator -> OrderExpr -> (SqlExpr, SqlOrder)
toSqlOrder SqlGenerator
gen (OrderExpr -> (SqlExpr, SqlOrder))
-> [OrderExpr] -> [(SqlExpr, SqlOrder)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OrderExpr]
group
          mfilter' :: Maybe SqlExpr
mfilter' = SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen (PrimExpr -> SqlExpr) -> Maybe PrimExpr -> Maybe SqlExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PrimExpr
mfilter
         in String
-> [SqlExpr]
-> [(SqlExpr, SqlOrder)]
-> SqlDistinct
-> [(SqlExpr, SqlOrder)]
-> Maybe SqlExpr
-> SqlExpr
AggrFunSqlExpr String
op' [SqlExpr]
e' [(SqlExpr, SqlOrder)]
ord' SqlDistinct
distinct' [(SqlExpr, SqlOrder)]
group' Maybe SqlExpr
mfilter'
      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 [(SqlExpr, SqlExpr)] -> Maybe (NonEmpty (SqlExpr, SqlExpr))
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 ((PrimExpr -> SqlExpr) -> NonEmpty PrimExpr -> NonEmpty SqlExpr
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
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 ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
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 ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
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 (SqlExpr -> SqlExpr) -> SqlExpr -> SqlExpr
forall a b. (a -> b) -> a -> b
$ SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen PrimExpr
e1) (SqlExpr -> SqlExpr
ParensSqlExpr (SqlExpr -> SqlExpr) -> SqlExpr -> SqlExpr
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]
args = (AggrOp -> String
showAggrOpFunction AggrOp
op, (PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map (SqlGenerator -> PrimExpr -> SqlExpr
sqlExpr SqlGenerator
gen) [PrimExpr]
args)


showAggrOpFunction :: AggrOp -> String
showAggrOpFunction :: AggrOp -> String
showAggrOpFunction = \case
  AggrOp
AggrCount -> String
"COUNT"
  AggrOp
AggrSum -> String
"SUM"
  AggrOp
AggrAvg -> String
"AVG"
  AggrOp
AggrMin -> String
"MIN"
  AggrOp
AggrMax -> String
"MAX"
  AggrOp
AggrStdDev -> String
"StdDev"
  AggrOp
AggrStdDevP -> String
"StdDevP"
  AggrOp
AggrVar -> String
"Var"
  AggrOp
AggrVarP -> String
"VarP"
  AggrOp
AggrBoolAnd -> String
"BOOL_AND"
  AggrOp
AggrBoolOr -> String
"BOOL_OR"
  AggrOp
AggrArr -> String
"ARRAY_AGG"
  AggrOp
JsonArr -> String
"JSON_AGG"
  AggrOp
AggrStringAggr -> String
"STRING_AGG"
  AggrOther String
s -> String
s


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", (PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
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", (PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
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", (PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
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  -> Integer -> String
forall a. Show a => a -> String
show Integer
i
      DoubleLit Double
d   -> if Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
d then String
"'NaN'"
                       else if Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
d Bool -> Bool -> Bool
&& Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 then String
"'-Infinity'"
                       else if Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
d Bool -> Bool -> Bool
&& Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 then String
"'Infinity'"
                       else Double -> String
forall a. Show a => a -> String
show Double
d
      NumericLit Scientific
n  -> Text -> String
LT.unpack (Text -> String) -> (Scientific -> Text) -> Scientific -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LT.toLazyText (Builder -> Text) -> (Scientific -> Builder) -> Scientific -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Builder
Sci.scientificBuilder (Scientific -> String) -> Scientific -> String
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'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escape String
s String -> String -> String
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 String -> Int -> String
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" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS8.unpack (ByteString -> ByteString
Base16.encode ByteString
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"