{-# LANGUAGE LambdaCase  #-}
{-# LANGUAGE QuasiQuotes #-}
{-|
Module      : PostgREST.Query.SqlFragment
Description : Helper functions for PostgREST.QueryBuilder.

Any function that outputs a SqlFragment should be in this module.
-}
module PostgREST.Query.SqlFragment
  ( noLocationF
  , SqlFragment
  , asBinaryF
  , asCsvF
  , asJsonF
  , asJsonSingleF
  , countF
  , fromQi
  , ftsOperators
  , limitOffsetF
  , locationF
  , normalizedBody
  , operators
  , pgFmtColumn
  , pgFmtIdent
  , pgFmtJoinCondition
  , pgFmtLogicTree
  , pgFmtOrderTerm
  , pgFmtSelectItem
  , responseHeadersF
  , responseStatusF
  , returningF
  , selectBody
  , singleParameter
  , sourceCTEName
  , unknownEncoder
  , intercalateSnippet
  ) where

import qualified Data.ByteString.Char8           as BS
import qualified Data.ByteString.Lazy            as LBS
import qualified Data.HashMap.Strict             as M
import qualified Data.Text                       as T
import qualified Hasql.DynamicStatements.Snippet as SQL
import qualified Hasql.Encoders                  as HE

import Data.Foldable                 (foldr1)
import Text.InterpolatedString.Perl6 (qc)

import PostgREST.DbStructure.Identifiers (FieldName,
                                          QualifiedIdentifier (..))
import PostgREST.RangeQuery              (NonnegRange, allRange,
                                          rangeLimit, rangeOffset)
import PostgREST.Request.Types           (Alias, Field, Filter (..),
                                          JoinCondition (..),
                                          JsonOperand (..),
                                          JsonOperation (..),
                                          JsonPath,
                                          LogicOperator (..),
                                          LogicTree (..), OpExpr (..),
                                          Operation (..),
                                          OrderDirection (..),
                                          OrderNulls (..),
                                          OrderTerm (..), SelectItem,
                                          TrileanVal (..))

import Protolude hiding (cast)


-- | A part of a SQL query that cannot be executed independently
type SqlFragment = ByteString

noLocationF :: SqlFragment
noLocationF :: SqlFragment
noLocationF = SqlFragment
"array[]::text[]"

sourceCTEName :: SqlFragment
sourceCTEName :: SqlFragment
sourceCTEName = SqlFragment
"pgrst_source"

operators :: M.HashMap Text SqlFragment
operators :: HashMap Text SqlFragment
operators = HashMap Text SqlFragment
-> HashMap Text SqlFragment -> HashMap Text SqlFragment
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
M.union ([(Text, SqlFragment)] -> HashMap Text SqlFragment
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [
  (Text
"eq", SqlFragment
"="),
  (Text
"gte", SqlFragment
">="),
  (Text
"gt", SqlFragment
">"),
  (Text
"lte", SqlFragment
"<="),
  (Text
"lt", SqlFragment
"<"),
  (Text
"neq", SqlFragment
"<>"),
  (Text
"like", SqlFragment
"LIKE"),
  (Text
"ilike", SqlFragment
"ILIKE"),
  (Text
"in", SqlFragment
"IN"),
  (Text
"is", SqlFragment
"IS"),
  (Text
"cs", SqlFragment
"@>"),
  (Text
"cd", SqlFragment
"<@"),
  (Text
"ov", SqlFragment
"&&"),
  (Text
"sl", SqlFragment
"<<"),
  (Text
"sr", SqlFragment
">>"),
  (Text
"nxr", SqlFragment
"&<"),
  (Text
"nxl", SqlFragment
"&>"),
  (Text
"adj", SqlFragment
"-|-")]) HashMap Text SqlFragment
ftsOperators

ftsOperators :: M.HashMap Text SqlFragment
ftsOperators :: HashMap Text SqlFragment
ftsOperators = [(Text, SqlFragment)] -> HashMap Text SqlFragment
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [
  (Text
"fts", SqlFragment
"@@ to_tsquery"),
  (Text
"plfts", SqlFragment
"@@ plainto_tsquery"),
  (Text
"phfts", SqlFragment
"@@ phraseto_tsquery"),
  (Text
"wfts", SqlFragment
"@@ websearch_to_tsquery")
  ]

-- |
-- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads
-- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays
-- We do this in SQL to avoid processing the JSON in application code
-- TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body
normalizedBody :: Maybe LBS.ByteString -> SQL.Snippet
normalizedBody :: Maybe ByteString -> Snippet
normalizedBody Maybe ByteString
body =
  Snippet
"pgrst_payload AS (SELECT " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
jsonPlaceHolder Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" AS json_data), " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  SqlFragment -> Snippet
SQL.sql ([SqlFragment] -> SqlFragment
BS.unwords [
    SqlFragment
"pgrst_body AS (",
      SqlFragment
"SELECT",
        SqlFragment
"CASE WHEN json_typeof(json_data) = 'array'",
          SqlFragment
"THEN json_data",
          SqlFragment
"ELSE json_build_array(json_data)",
        SqlFragment
"END AS val",
      SqlFragment
"FROM pgrst_payload)"])
  where
    jsonPlaceHolder :: Snippet
jsonPlaceHolder = NullableOrNot Value (Maybe SqlFragment)
-> Maybe SqlFragment -> Snippet
forall param. NullableOrNot Value param -> param -> Snippet
SQL.encoderAndParam (Value SqlFragment -> NullableOrNot Value (Maybe SqlFragment)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
HE.nullable Value SqlFragment
HE.unknown) (ByteString -> SqlFragment
LBS.toStrict (ByteString -> SqlFragment)
-> Maybe ByteString -> Maybe SqlFragment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
body) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
"::json"

singleParameter :: Maybe LBS.ByteString -> ByteString -> SQL.Snippet
singleParameter :: Maybe ByteString -> SqlFragment -> Snippet
singleParameter Maybe ByteString
body SqlFragment
typ =
  if SqlFragment
typ SqlFragment -> SqlFragment -> Bool
forall a. Eq a => a -> a -> Bool
== SqlFragment
"bytea"
    -- TODO: Hasql fails when using HE.unknown with bytea(pg tries to utf8 encode).
    then NullableOrNot Value (Maybe SqlFragment)
-> Maybe SqlFragment -> Snippet
forall param. NullableOrNot Value param -> param -> Snippet
SQL.encoderAndParam (Value SqlFragment -> NullableOrNot Value (Maybe SqlFragment)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
HE.nullable Value SqlFragment
HE.bytea) (ByteString -> SqlFragment
LBS.toStrict (ByteString -> SqlFragment)
-> Maybe ByteString -> Maybe SqlFragment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
body)
    else NullableOrNot Value (Maybe SqlFragment)
-> Maybe SqlFragment -> Snippet
forall param. NullableOrNot Value param -> param -> Snippet
SQL.encoderAndParam (Value SqlFragment -> NullableOrNot Value (Maybe SqlFragment)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
HE.nullable Value SqlFragment
HE.unknown) (ByteString -> SqlFragment
LBS.toStrict (ByteString -> SqlFragment)
-> Maybe ByteString -> Maybe SqlFragment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
body) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
"::" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> SqlFragment -> Snippet
SQL.sql SqlFragment
typ

selectBody :: SqlFragment
selectBody :: SqlFragment
selectBody = SqlFragment
"(SELECT val FROM pgrst_body)"

-- Here we build the pg array literal, e.g '{"Hebdon, John","Other","Another"}', manually.
-- This is necessary to pass an "unknown" array and let pg infer the type.
-- There are backslashes here, but since this value is parametrized and is not a string constant
-- https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-STRINGS
-- we don't need to use the E'string' form for C-style escapes
-- https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-STRINGS-ESCAPE
pgBuildArrayLiteral :: [Text] -> Text
pgBuildArrayLiteral :: [Text] -> Text
pgBuildArrayLiteral [Text]
vals =
 let trimmed :: Text -> Text
trimmed = Text -> Text
trimNullChars
     slashed :: Text -> Text
slashed = Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"\\\\" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimmed
     escaped :: Text -> Text
escaped Text
x = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\\\"" (Text -> Text
slashed Text
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" in
 Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," (Text -> Text
escaped (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
vals) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

-- TODO: refactor by following https://github.com/PostgREST/postgrest/pull/1631#issuecomment-711070833
pgFmtIdent :: Text -> SqlFragment
pgFmtIdent :: Text -> SqlFragment
pgFmtIdent Text
x = Text -> SqlFragment
encodeUtf8 (Text -> SqlFragment) -> Text -> SqlFragment
forall a b. (a -> b) -> a -> b
$ Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\"\"" (Text -> Text
trimNullChars Text
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

trimNullChars :: Text -> Text
trimNullChars :: Text -> Text
trimNullChars = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\x0')

asCsvF :: SqlFragment
asCsvF :: SqlFragment
asCsvF = SqlFragment
asCsvHeaderF SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
" || '\n' || " SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
asCsvBodyF
  where
    asCsvHeaderF :: SqlFragment
asCsvHeaderF =
      SqlFragment
"(SELECT coalesce(string_agg(a.k, ','), '')" SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<>
      SqlFragment
"  FROM (" SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<>
      SqlFragment
"    SELECT json_object_keys(r)::text as k" SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<>
      SqlFragment
"    FROM ( " SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<>
      SqlFragment
"      SELECT row_to_json(hh) as r from " SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
sourceCTEName SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
" as hh limit 1" SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<>
      SqlFragment
"    ) s" SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<>
      SqlFragment
"  ) a" SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<>
      SqlFragment
")"
    asCsvBodyF :: SqlFragment
asCsvBodyF = SqlFragment
"coalesce(string_agg(substring(_postgrest_t::text, 2, length(_postgrest_t::text) - 2), '\n'), '')"

asJsonF :: Bool -> SqlFragment
asJsonF :: Bool -> SqlFragment
asJsonF Bool
returnsScalar
  | Bool
returnsScalar = SqlFragment
"coalesce(json_agg(_postgrest_t.pgrst_scalar), '[]')::character varying"
  | Bool
otherwise     = SqlFragment
"coalesce(json_agg(_postgrest_t), '[]')::character varying"

asJsonSingleF :: Bool -> SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
asJsonSingleF :: Bool -> SqlFragment
asJsonSingleF Bool
returnsScalar
  | Bool
returnsScalar = SqlFragment
"coalesce(string_agg(to_json(_postgrest_t.pgrst_scalar)::text, ','), 'null')::character varying"
  | Bool
otherwise     = SqlFragment
"coalesce(string_agg(to_json(_postgrest_t)::text, ','), '')::character varying"

asBinaryF :: FieldName -> SqlFragment
asBinaryF :: Text -> SqlFragment
asBinaryF Text
fieldName = SqlFragment
"coalesce(string_agg(_postgrest_t." SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> Text -> SqlFragment
pgFmtIdent Text
fieldName SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
", ''), '')"

locationF :: [Text] -> SqlFragment
locationF :: [Text] -> SqlFragment
locationF [Text]
pKeys = [qc|(
  WITH data AS (SELECT row_to_json(_) AS row FROM {sourceCTEName} AS _ LIMIT 1)
  SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))
  FROM data CROSS JOIN json_each_text(data.row) AS json_data
  WHERE json_data.key IN ('{fmtPKeys}')
)|]
  where
    fmtPKeys :: Text
fmtPKeys = Text -> [Text] -> Text
T.intercalate Text
"','" [Text]
pKeys

fromQi :: QualifiedIdentifier -> SqlFragment
fromQi :: QualifiedIdentifier -> SqlFragment
fromQi QualifiedIdentifier
t = (if Text -> Bool
T.null Text
s then SqlFragment
forall a. Monoid a => a
mempty else Text -> SqlFragment
pgFmtIdent Text
s SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
".") SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> Text -> SqlFragment
pgFmtIdent Text
n
  where
    n :: Text
n = QualifiedIdentifier -> Text
qiName QualifiedIdentifier
t
    s :: Text
s = QualifiedIdentifier -> Text
qiSchema QualifiedIdentifier
t

pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
pgFmtColumn QualifiedIdentifier
table Text
"*" = QualifiedIdentifier -> SqlFragment
fromQi QualifiedIdentifier
table SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
".*"
pgFmtColumn QualifiedIdentifier
table Text
c   = QualifiedIdentifier -> SqlFragment
fromQi QualifiedIdentifier
table SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
"." SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> Text -> SqlFragment
pgFmtIdent Text
c

pgFmtField :: QualifiedIdentifier -> Field -> SQL.Snippet
pgFmtField :: QualifiedIdentifier -> Field -> Snippet
pgFmtField QualifiedIdentifier
table (Text
c, JsonPath
jp) = SqlFragment -> Snippet
SQL.sql (QualifiedIdentifier -> Text -> SqlFragment
pgFmtColumn QualifiedIdentifier
table Text
c) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> JsonPath -> Snippet
pgFmtJsonPath JsonPath
jp

pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SQL.Snippet
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Snippet
pgFmtSelectItem QualifiedIdentifier
table (f :: Field
f@(Text
fName, JsonPath
jp), Maybe Text
Nothing, Maybe Text
alias, Maybe Text
_, Maybe JoinType
_) = QualifiedIdentifier -> Field -> Snippet
pgFmtField QualifiedIdentifier
table Field
f Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> SqlFragment -> Snippet
SQL.sql (Text -> JsonPath -> Maybe Text -> SqlFragment
pgFmtAs Text
fName JsonPath
jp Maybe Text
alias)
-- Ideally we'd quote the cast with "pgFmtIdent cast". However, that would invalidate common casts such as "int", "bigint", etc.
-- Try doing: `select 1::"bigint"` - it'll err, using "int8" will work though. There's some parser magic that pg does that's invalidated when quoting.
-- Not quoting should be fine, we validate the input on Parsers.
pgFmtSelectItem QualifiedIdentifier
table (f :: Field
f@(Text
fName, JsonPath
jp), Just Text
cast, Maybe Text
alias, Maybe Text
_, Maybe JoinType
_) = Snippet
"CAST (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> QualifiedIdentifier -> Field -> Snippet
pgFmtField QualifiedIdentifier
table Field
f Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" AS " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> SqlFragment -> Snippet
SQL.sql (Text -> SqlFragment
encodeUtf8 Text
cast) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" )" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> SqlFragment -> Snippet
SQL.sql (Text -> JsonPath -> Maybe Text -> SqlFragment
pgFmtAs Text
fName JsonPath
jp Maybe Text
alias)

pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SQL.Snippet
pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> Snippet
pgFmtOrderTerm QualifiedIdentifier
qi OrderTerm
ot =
  QualifiedIdentifier -> Field -> Snippet
pgFmtField QualifiedIdentifier
qi (OrderTerm -> Field
otTerm OrderTerm
ot) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  SqlFragment -> Snippet
SQL.sql ([SqlFragment] -> SqlFragment
BS.unwords [
    SqlFragment
-> (OrderDirection -> SqlFragment)
-> Maybe OrderDirection
-> SqlFragment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SqlFragment
forall a. Monoid a => a
mempty OrderDirection -> SqlFragment
forall p. IsString p => OrderDirection -> p
direction (Maybe OrderDirection -> SqlFragment)
-> Maybe OrderDirection -> SqlFragment
forall a b. (a -> b) -> a -> b
$ OrderTerm -> Maybe OrderDirection
otDirection OrderTerm
ot,
    SqlFragment
-> (OrderNulls -> SqlFragment) -> Maybe OrderNulls -> SqlFragment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SqlFragment
forall a. Monoid a => a
mempty OrderNulls -> SqlFragment
forall p. IsString p => OrderNulls -> p
nullOrder (Maybe OrderNulls -> SqlFragment)
-> Maybe OrderNulls -> SqlFragment
forall a b. (a -> b) -> a -> b
$ OrderTerm -> Maybe OrderNulls
otNullOrder OrderTerm
ot])
  where
    direction :: OrderDirection -> p
direction OrderDirection
OrderAsc  = p
"ASC"
    direction OrderDirection
OrderDesc = p
"DESC"

    nullOrder :: OrderNulls -> p
nullOrder OrderNulls
OrderNullsFirst = p
"NULLS FIRST"
    nullOrder OrderNulls
OrderNullsLast  = p
"NULLS LAST"


pgFmtFilter :: QualifiedIdentifier -> Filter -> SQL.Snippet
pgFmtFilter :: QualifiedIdentifier -> Filter -> Snippet
pgFmtFilter QualifiedIdentifier
table (Filter Field
fld (OpExpr Bool
hasNot Operation
oper)) = Snippet
notOp Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> case Operation
oper of
   Op Text
op Text
val  -> Text -> Snippet
pgFmtFieldOp Text
op Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> case Text
op of
     Text
"like"  -> Text -> Snippet
unknownLiteral ((Char -> Char) -> Text -> Text
T.map Char -> Char
star Text
val)
     Text
"ilike" -> Text -> Snippet
unknownLiteral ((Char -> Char) -> Text -> Text
T.map Char -> Char
star Text
val)
     Text
_       -> Text -> Snippet
unknownLiteral Text
val

   -- IS cannot be prepared. `PREPARE boolplan AS SELECT * FROM projects where id IS $1` will give a syntax error.
   -- The above can be fixed by using `PREPARE boolplan AS SELECT * FROM projects where id IS NOT DISTINCT FROM $1;`
   -- However that would not accept the TRUE/FALSE/NULL/UNKNOWN keywords. See: https://stackoverflow.com/questions/6133525/proper-way-to-set-preparedstatement-parameter-to-null-under-postgres.
   -- This is why `IS` operands are whitelisted at the Parsers.hs level
   Is TrileanVal
triVal -> QualifiedIdentifier -> Field -> Snippet
pgFmtField QualifiedIdentifier
table Field
fld Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" IS " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> case TrileanVal
triVal of
     TrileanVal
TriTrue    -> Snippet
"TRUE"
     TrileanVal
TriFalse   -> Snippet
"FALSE"
     TrileanVal
TriNull    -> Snippet
"NULL"
     TrileanVal
TriUnknown -> Snippet
"UNKNOWN"

   -- We don't use "IN", we use "= ANY". IN has the following disadvantages:
   -- + No way to use an empty value on IN: "col IN ()" is invalid syntax. With ANY we can do "= ANY('{}')"
   -- + Can invalidate prepared statements: multiple parameters on an IN($1, $2, $3) will lead to using different prepared statements and not take advantage of caching.
   In [Text]
vals -> QualifiedIdentifier -> Field -> Snippet
pgFmtField QualifiedIdentifier
table Field
fld Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> case [Text]
vals of
      [Text
""] -> Snippet
"= ANY('{}') "
      [Text]
_    -> Snippet
"= ANY (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
unknownLiteral ([Text] -> Text
pgBuildArrayLiteral [Text]
vals) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
") "

   Fts Text
op Maybe Text
lang Text
val ->
     Text -> Snippet
pgFmtFieldOp Text
op Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
"(" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Snippet
ftsLang Maybe Text
lang Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
unknownLiteral Text
val Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
") "
 where
   ftsLang :: Maybe Text -> Snippet
ftsLang = Snippet -> (Text -> Snippet) -> Maybe Text -> Snippet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Snippet
forall a. Monoid a => a
mempty (\Text
l -> Text -> Snippet
unknownLiteral Text
l Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
", ")
   pgFmtFieldOp :: Text -> Snippet
pgFmtFieldOp Text
op = QualifiedIdentifier -> Field -> Snippet
pgFmtField QualifiedIdentifier
table Field
fld Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
sqlOperator Text
op
   sqlOperator :: Text -> Snippet
sqlOperator Text
o = SqlFragment -> Snippet
SQL.sql (SqlFragment -> Snippet) -> SqlFragment -> Snippet
forall a b. (a -> b) -> a -> b
$ SqlFragment -> Text -> HashMap Text SqlFragment -> SqlFragment
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault SqlFragment
"=" Text
o HashMap Text SqlFragment
operators
   notOp :: Snippet
notOp = if Bool
hasNot then Snippet
"NOT" else Snippet
forall a. Monoid a => a
mempty
   star :: Char -> Char
star Char
c = if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' then Char
'%' else Char
c

pgFmtJoinCondition :: JoinCondition -> SQL.Snippet
pgFmtJoinCondition :: JoinCondition -> Snippet
pgFmtJoinCondition (JoinCondition (QualifiedIdentifier
qi1, Text
col1) (QualifiedIdentifier
qi2, Text
col2)) =
  SqlFragment -> Snippet
SQL.sql (SqlFragment -> Snippet) -> SqlFragment -> Snippet
forall a b. (a -> b) -> a -> b
$ QualifiedIdentifier -> Text -> SqlFragment
pgFmtColumn QualifiedIdentifier
qi1 Text
col1 SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
" = " SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> QualifiedIdentifier -> Text -> SqlFragment
pgFmtColumn QualifiedIdentifier
qi2 Text
col2

pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SQL.Snippet
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> Snippet
pgFmtLogicTree QualifiedIdentifier
qi (Expr Bool
hasNot LogicOperator
op [LogicTree]
forest) = SqlFragment -> Snippet
SQL.sql SqlFragment
notOp Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> SqlFragment -> [Snippet] -> Snippet
intercalateSnippet (LogicOperator -> SqlFragment
forall p. IsString p => LogicOperator -> p
opSql LogicOperator
op) (QualifiedIdentifier -> LogicTree -> Snippet
pgFmtLogicTree QualifiedIdentifier
qi (LogicTree -> Snippet) -> [LogicTree] -> [Snippet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LogicTree]
forest) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
")"
  where
    notOp :: SqlFragment
notOp =  if Bool
hasNot then SqlFragment
"NOT" else SqlFragment
forall a. Monoid a => a
mempty

    opSql :: LogicOperator -> p
opSql LogicOperator
And = p
" AND "
    opSql LogicOperator
Or  = p
" OR "
pgFmtLogicTree QualifiedIdentifier
qi (Stmnt Filter
flt) = QualifiedIdentifier -> Filter -> Snippet
pgFmtFilter QualifiedIdentifier
qi Filter
flt

pgFmtJsonPath :: JsonPath -> SQL.Snippet
pgFmtJsonPath :: JsonPath -> Snippet
pgFmtJsonPath = \case
  []             -> Snippet
forall a. Monoid a => a
mempty
  (JArrow JsonOperand
x:JsonPath
xs)  -> Snippet
"->" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> JsonOperand -> Snippet
pgFmtJsonOperand JsonOperand
x Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> JsonPath -> Snippet
pgFmtJsonPath JsonPath
xs
  (J2Arrow JsonOperand
x:JsonPath
xs) -> Snippet
"->>" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> JsonOperand -> Snippet
pgFmtJsonOperand JsonOperand
x Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> JsonPath -> Snippet
pgFmtJsonPath JsonPath
xs
  where
    pgFmtJsonOperand :: JsonOperand -> Snippet
pgFmtJsonOperand (JKey Text
k) = Text -> Snippet
unknownLiteral Text
k
    pgFmtJsonOperand (JIdx Text
i) = Text -> Snippet
unknownLiteral Text
i Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
"::int"

pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SqlFragment
pgFmtAs :: Text -> JsonPath -> Maybe Text -> SqlFragment
pgFmtAs Text
_ [] Maybe Text
Nothing = SqlFragment
forall a. Monoid a => a
mempty
pgFmtAs Text
fName JsonPath
jp Maybe Text
Nothing = case JsonOperation -> JsonOperand
jOp (JsonOperation -> JsonOperand)
-> Maybe JsonOperation -> Maybe JsonOperand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsonPath -> Maybe JsonOperation
forall a. [a] -> Maybe a
lastMay JsonPath
jp of
  Just (JKey Text
key) -> SqlFragment
" AS " SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> Text -> SqlFragment
pgFmtIdent Text
key
  Just (JIdx Text
_)   -> SqlFragment
" AS " SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> Text -> SqlFragment
pgFmtIdent (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
fName Maybe Text
lastKey)
    -- We get the lastKey because on:
    -- `select=data->1->mycol->>2`, we need to show the result as [ {"mycol": ..}, {"mycol": ..} ]
    -- `select=data->3`, we need to show the result as [ {"data": ..}, {"data": ..} ]
    where lastKey :: Maybe Text
lastKey = JsonOperand -> Text
jVal (JsonOperand -> Text) -> Maybe JsonOperand -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JsonOperand -> Bool) -> [JsonOperand] -> Maybe JsonOperand
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\case JKey{} -> Bool
True; JsonOperand
_ -> Bool
False) (JsonOperation -> JsonOperand
jOp (JsonOperation -> JsonOperand) -> JsonPath -> [JsonOperand]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsonPath -> JsonPath
forall a. [a] -> [a]
reverse JsonPath
jp)
  Maybe JsonOperand
Nothing -> SqlFragment
forall a. Monoid a => a
mempty
pgFmtAs Text
_ JsonPath
_ (Just Text
alias) = SqlFragment
" AS " SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> Text -> SqlFragment
pgFmtIdent Text
alias

countF :: SQL.Snippet -> Bool -> (SQL.Snippet, SqlFragment)
countF :: Snippet -> Bool -> (Snippet, SqlFragment)
countF Snippet
countQuery Bool
shouldCount =
  if Bool
shouldCount
    then (
        Snippet
", pgrst_source_count AS (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
countQuery Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
")"
      , SqlFragment
"(SELECT pg_catalog.count(*) FROM pgrst_source_count)" )
    else (
        Snippet
forall a. Monoid a => a
mempty
      , SqlFragment
"null::bigint")

returningF :: QualifiedIdentifier -> [FieldName] -> SqlFragment
returningF :: QualifiedIdentifier -> [Text] -> SqlFragment
returningF QualifiedIdentifier
qi [Text]
returnings =
  if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
returnings
    then SqlFragment
"RETURNING 1" -- For mutation cases where there's no ?select, we return 1 to know how many rows were modified
    else SqlFragment
"RETURNING " SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment -> [SqlFragment] -> SqlFragment
BS.intercalate SqlFragment
", " (QualifiedIdentifier -> Text -> SqlFragment
pgFmtColumn QualifiedIdentifier
qi (Text -> SqlFragment) -> [Text] -> [SqlFragment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
returnings)

limitOffsetF :: NonnegRange -> SQL.Snippet
limitOffsetF :: NonnegRange -> Snippet
limitOffsetF NonnegRange
range =
  if NonnegRange
range NonnegRange -> NonnegRange -> Bool
forall a. Eq a => a -> a -> Bool
== NonnegRange
allRange then Snippet
forall a. Monoid a => a
mempty else Snippet
"LIMIT " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
limit Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" OFFSET " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
offset
  where
    limit :: Snippet
limit = Snippet -> (Integer -> Snippet) -> Maybe Integer -> Snippet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Snippet
"ALL" (\Integer
l -> SqlFragment -> Snippet
unknownEncoder (String -> SqlFragment
BS.pack (String -> SqlFragment) -> String -> SqlFragment
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Integer
l)) (Maybe Integer -> Snippet) -> Maybe Integer -> Snippet
forall a b. (a -> b) -> a -> b
$ NonnegRange -> Maybe Integer
rangeLimit NonnegRange
range
    offset :: Snippet
offset = SqlFragment -> Snippet
unknownEncoder (String -> SqlFragment
BS.pack (String -> SqlFragment)
-> (Integer -> String) -> Integer -> SqlFragment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (Integer -> SqlFragment) -> Integer -> SqlFragment
forall a b. (a -> b) -> a -> b
$ NonnegRange -> Integer
rangeOffset NonnegRange
range)

responseHeadersF :: SqlFragment
responseHeadersF :: SqlFragment
responseHeadersF = SqlFragment -> SqlFragment
currentSettingF SqlFragment
"response.headers"

responseStatusF :: SqlFragment
responseStatusF :: SqlFragment
responseStatusF = SqlFragment -> SqlFragment
currentSettingF SqlFragment
"response.status"

currentSettingF :: SqlFragment -> SqlFragment
currentSettingF :: SqlFragment -> SqlFragment
currentSettingF SqlFragment
setting =
  -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
  SqlFragment
"nullif(current_setting('" SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
setting SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
"', true), '')"

-- Hasql Snippet utilities
unknownEncoder :: ByteString -> SQL.Snippet
unknownEncoder :: SqlFragment -> Snippet
unknownEncoder = NullableOrNot Value SqlFragment -> SqlFragment -> Snippet
forall param. NullableOrNot Value param -> param -> Snippet
SQL.encoderAndParam (Value SqlFragment -> NullableOrNot Value SqlFragment
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
HE.nonNullable Value SqlFragment
HE.unknown)

unknownLiteral :: Text -> SQL.Snippet
unknownLiteral :: Text -> Snippet
unknownLiteral = SqlFragment -> Snippet
unknownEncoder (SqlFragment -> Snippet)
-> (Text -> SqlFragment) -> Text -> Snippet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SqlFragment
encodeUtf8

intercalateSnippet :: ByteString -> [SQL.Snippet] -> SQL.Snippet
intercalateSnippet :: SqlFragment -> [Snippet] -> Snippet
intercalateSnippet SqlFragment
_ [] = Snippet
forall a. Monoid a => a
mempty
intercalateSnippet SqlFragment
frag [Snippet]
snippets = (Snippet -> Snippet -> Snippet) -> [Snippet] -> Snippet
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Snippet
a Snippet
b -> Snippet
a Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> SqlFragment -> Snippet
SQL.sql SqlFragment
frag Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
b) [Snippet]
snippets