{-# 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
  , jsonPlaceHolder
  , limitOffsetF
  , locationF
  , normalizedBody
  , operators
  , pgFmtColumn
  , pgFmtIdent
  , pgFmtJoinCondition
  , pgFmtLogicTree
  , pgFmtOrderTerm
  , pgFmtSelectItem
  , responseHeadersF
  , responseStatusF
  , returningF
  , selectBody
  , sourceCTEName
  , unknownEncoder
  , intercalateSnippet
  ) where

import qualified Data.ByteString.Char8           as BS
import qualified Data.ByteString.Lazy            as BL
import qualified Data.HashMap.Strict             as HM
import qualified Data.Text                       as T
import qualified Hasql.DynamicStatements.Snippet as H
import qualified Hasql.Encoders                  as HE

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

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

import Protolude      hiding (cast, toS)
import Protolude.Conv (toS)


-- | 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 :: HM.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
HM.union ([(Text, SqlFragment)] -> HashMap Text SqlFragment
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.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 :: HM.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
HM.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
normalizedBody :: Maybe BL.ByteString -> H.Snippet
normalizedBody :: Maybe ByteString -> Snippet
normalizedBody Maybe ByteString
body =
  Snippet
"pgrst_payload AS (SELECT " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Maybe ByteString -> Snippet
jsonPlaceHolder Maybe ByteString
body 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
H.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)"])

-- | Equivalent to "$1::json"
-- | TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body
jsonPlaceHolder :: Maybe BL.ByteString -> H.Snippet
jsonPlaceHolder :: Maybe ByteString -> Snippet
jsonPlaceHolder Maybe ByteString
body =
  NullableOrNot Value (Maybe SqlFragment)
-> Maybe SqlFragment -> Snippet
forall param. NullableOrNot Value param -> param -> Snippet
H.encoderAndParam (Value SqlFragment -> NullableOrNot Value (Maybe SqlFragment)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
HE.nullable Value SqlFragment
HE.unknown) (ByteString -> SqlFragment
forall a b. StringConv a b => a -> b
toS (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"

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

pgFmtLit :: Text -> SqlFragment
pgFmtLit :: Text -> SqlFragment
pgFmtLit Text
x =
 let trimmed :: Text
trimmed = Text -> Text
trimNullChars Text
x
     escaped :: Text
escaped = Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text -> Text
T.replace Text
"'" Text
"''" Text
trimmed Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
     slashed :: Text
slashed = Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"\\\\" Text
escaped in
 Text -> SqlFragment
encodeUtf8 (Text -> SqlFragment) -> Text -> SqlFragment
forall a b. (a -> b) -> a -> b
$ if Text
"\\" Text -> Text -> Bool
`T.isInfixOf` Text
escaped
   then Text
"E" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
slashed
   else Text
slashed

-- 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 -> H.Snippet
pgFmtField :: QualifiedIdentifier -> Field -> Snippet
pgFmtField QualifiedIdentifier
table (Text
c, JsonPath
jp) = SqlFragment -> Snippet
H.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 -> H.Snippet
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Snippet
pgFmtSelectItem QualifiedIdentifier
table (f :: Field
f@(Text
fName, JsonPath
jp), Maybe Text
Nothing, Maybe Text
alias, Maybe Text
_) = QualifiedIdentifier -> Field -> Snippet
pgFmtField QualifiedIdentifier
table Field
f Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> SqlFragment -> Snippet
H.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
_) = 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
H.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
H.sql (Text -> JsonPath -> Maybe Text -> SqlFragment
pgFmtAs Text
fName JsonPath
jp Maybe Text
alias)

pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> H.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
H.sql ([SqlFragment] -> SqlFragment
BS.unwords [
    String -> SqlFragment
BS.pack (String -> SqlFragment) -> String -> SqlFragment
forall a b. (a -> b) -> a -> b
$ String
-> (OrderDirection -> String) -> Maybe OrderDirection -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
forall a. Monoid a => a
mempty OrderDirection -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (Maybe OrderDirection -> String) -> Maybe OrderDirection -> String
forall a b. (a -> b) -> a -> b
$ OrderTerm -> Maybe OrderDirection
otDirection OrderTerm
ot,
    String -> SqlFragment
BS.pack (String -> SqlFragment) -> String -> SqlFragment
forall a b. (a -> b) -> a -> b
$ String -> (OrderNulls -> String) -> Maybe OrderNulls -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
forall a. Monoid a => a
mempty OrderNulls -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (Maybe OrderNulls -> String) -> Maybe OrderNulls -> String
forall a b. (a -> b) -> a -> b
$ OrderTerm -> Maybe OrderNulls
otNullOrder OrderTerm
ot])

pgFmtFilter :: QualifiedIdentifier -> Filter -> H.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
"is"    -> Text -> Snippet
isAllowed Text
val
     Text
_       -> Text -> Snippet
unknownLiteral Text
val

   -- 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('{}') "
      -- Here we build the pg array, e.g '{"Hebdon, John","Other","Another"}', manually. We quote the values to prevent the "," being treated as an element separator.
      -- TODO: Ideally this would be done on Hasql with an encoder, but the "array unknown" is not working(Hasql doesn't pass any value).
      [Text]
_    -> Snippet
"= ANY (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
unknownLiteral (Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," ((\Text
x -> Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"") (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
"}") 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
H.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
HM.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
   -- 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 keywords. See: https://stackoverflow.com/questions/6133525/proper-way-to-set-preparedstatement-parameter-to-null-under-postgres.
   isAllowed :: Text -> H.Snippet
   isAllowed :: Text -> Snippet
isAllowed Text
v = SqlFragment -> Snippet
H.sql (SqlFragment -> Snippet) -> SqlFragment -> Snippet
forall a b. (a -> b) -> a -> b
$ SqlFragment -> (Text -> SqlFragment) -> Maybe Text -> SqlFragment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
     (Text -> SqlFragment
pgFmtLit Text
v SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
"::unknown") Text -> SqlFragment
encodeUtf8
     ((Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool) -> (Text -> Text) -> Text -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text -> Bool) -> Text -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text
v) [Text
"null",Text
"true",Text
"false"])

pgFmtJoinCondition :: JoinCondition -> H.Snippet
pgFmtJoinCondition :: JoinCondition -> Snippet
pgFmtJoinCondition (JoinCondition (QualifiedIdentifier
qi1, Text
col1) (QualifiedIdentifier
qi2, Text
col2)) =
  SqlFragment -> Snippet
H.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 -> H.Snippet
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> Snippet
pgFmtLogicTree QualifiedIdentifier
qi (Expr Bool
hasNot LogicOperator
op [LogicTree]
forest) = SqlFragment -> Snippet
H.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 (SqlFragment
" " SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> String -> SqlFragment
BS.pack (LogicOperator -> String
forall a b. (Show a, ConvertText String b) => a -> b
show LogicOperator
op) SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
" ") (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
pgFmtLogicTree QualifiedIdentifier
qi (Stmnt Filter
flt) = QualifiedIdentifier -> Filter -> Snippet
pgFmtFilter QualifiedIdentifier
qi Filter
flt

pgFmtJsonPath :: JsonPath -> H.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 :: H.Snippet -> Bool -> (H.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 -> H.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 :: PgVersion -> SqlFragment
responseHeadersF :: PgVersion -> SqlFragment
responseHeadersF PgVersion
pgVer =
  if PgVersion
pgVer PgVersion -> PgVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= PgVersion
pgVersion96
    then Text -> SqlFragment
currentSettingF Text
"response.headers"
    else SqlFragment
"null"

responseStatusF :: PgVersion -> SqlFragment
responseStatusF :: PgVersion -> SqlFragment
responseStatusF PgVersion
pgVer =
  if PgVersion
pgVer PgVersion -> PgVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= PgVersion
pgVersion96
    then Text -> SqlFragment
currentSettingF Text
"response.status"
    else SqlFragment
"null"

currentSettingF :: Text -> SqlFragment
currentSettingF :: Text -> SqlFragment
currentSettingF Text
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
<> Text -> SqlFragment
pgFmtLit Text
setting SqlFragment -> SqlFragment -> SqlFragment
forall a. Semigroup a => a -> a -> a
<> SqlFragment
", true), '')"

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

unknownLiteral :: Text -> H.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 -> [H.Snippet] -> H.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
H.sql SqlFragment
frag Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
b) [Snippet]
snippets