{-# LANGUAGE DuplicateRecordFields #-}
{-|
Module      : PostgREST.Query.QueryBuilder
Description : PostgREST SQL queries generating functions.

This module provides functions to consume data types that
represent database queries (e.g. ReadRequest, MutateRequest) and SqlFragment
to produce SqlQuery type outputs.
-}
module PostgREST.Query.QueryBuilder
  ( readRequestToQuery
  , mutateRequestToQuery
  , readRequestToCountQuery
  , requestToCallProcQuery
  , limitedQuery
  ) where

import qualified Data.ByteString.Char8           as BS
import qualified Data.Set                        as S
import qualified Hasql.DynamicStatements.Snippet as SQL

import Data.Tree (Tree (..))

import PostgREST.DbStructure.Identifiers  (QualifiedIdentifier (..))
import PostgREST.DbStructure.Proc         (ProcParam (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
                                           Relationship (..))
import PostgREST.DbStructure.Table        (Table (..))
import PostgREST.Request.Preferences      (PreferResolution (..))

import PostgREST.Query.SqlFragment
import PostgREST.Request.Types

import Protolude

readRequestToQuery :: ReadRequest -> SQL.Snippet
readRequestToQuery :: ReadRequest -> Snippet
readRequestToQuery (Node (Select [SelectItem]
colSelects QualifiedIdentifier
mainQi Maybe NodeName
tblAlias [QualifiedIdentifier]
implJoins [LogicTree]
logicForest [JoinCondition]
joinConditions_ [OrderTerm]
ordts NonnegRange
range, (NodeName, Maybe Relationship, Maybe NodeName, Maybe NodeName,
 Maybe JoinType, Depth)
_) [ReadRequest]
forest) =
  Snippet
"SELECT " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> [Snippet] -> Snippet
intercalateSnippet ByteString
", " ((QualifiedIdentifier -> SelectItem -> Snippet
pgFmtSelectItem QualifiedIdentifier
qi (SelectItem -> Snippet) -> [SelectItem] -> [Snippet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SelectItem]
colSelects) [Snippet] -> [Snippet] -> [Snippet]
forall a. [a] -> [a] -> [a]
++ [Snippet]
selects) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  Snippet
"FROM " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql (ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
", " (ByteString
tabl ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
implJs)) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> [Snippet] -> Snippet
intercalateSnippet ByteString
" " [Snippet]
joins Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  (if [LogicTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogicTree]
logicForest Bool -> Bool -> Bool
&& [JoinCondition] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [JoinCondition]
joinConditions_ then Snippet
forall a. Monoid a => a
mempty else Snippet
"WHERE " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Snippet] -> Snippet
intercalateSnippet ByteString
" AND " ((LogicTree -> Snippet) -> [LogicTree] -> [Snippet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (QualifiedIdentifier -> LogicTree -> Snippet
pgFmtLogicTree QualifiedIdentifier
qi) [LogicTree]
logicForest [Snippet] -> [Snippet] -> [Snippet]
forall a. [a] -> [a] -> [a]
++ (JoinCondition -> Snippet) -> [JoinCondition] -> [Snippet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map JoinCondition -> Snippet
pgFmtJoinCondition [JoinCondition]
joinConditions_))
  Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  (if [OrderTerm] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OrderTerm]
ordts then Snippet
forall a. Monoid a => a
mempty else Snippet
"ORDER BY " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Snippet] -> Snippet
intercalateSnippet ByteString
", " ((OrderTerm -> Snippet) -> [OrderTerm] -> [Snippet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (QualifiedIdentifier -> OrderTerm -> Snippet
pgFmtOrderTerm QualifiedIdentifier
qi) [OrderTerm]
ordts)) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  NonnegRange -> Snippet
limitOffsetF NonnegRange
range
  where
    implJs :: [ByteString]
implJs = QualifiedIdentifier -> ByteString
fromQi (QualifiedIdentifier -> ByteString)
-> [QualifiedIdentifier] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [QualifiedIdentifier]
implJoins
    tabl :: ByteString
tabl = QualifiedIdentifier -> ByteString
fromQi QualifiedIdentifier
mainQi ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
-> (NodeName -> ByteString) -> Maybe NodeName -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
forall a. Monoid a => a
mempty (\NodeName
a -> ByteString
" AS " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
pgFmtIdent NodeName
a) Maybe NodeName
tblAlias
    qi :: QualifiedIdentifier
qi = QualifiedIdentifier
-> (NodeName -> QualifiedIdentifier)
-> Maybe NodeName
-> QualifiedIdentifier
forall b a. b -> (a -> b) -> Maybe a -> b
maybe QualifiedIdentifier
mainQi (NodeName -> NodeName -> QualifiedIdentifier
QualifiedIdentifier NodeName
forall a. Monoid a => a
mempty) Maybe NodeName
tblAlias
    ([Snippet]
joins, [Snippet]
selects) = (ReadRequest -> ([Snippet], [Snippet]) -> ([Snippet], [Snippet]))
-> ([Snippet], [Snippet])
-> [ReadRequest]
-> ([Snippet], [Snippet])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ReadRequest -> ([Snippet], [Snippet]) -> ([Snippet], [Snippet])
getJoinsSelects ([],[]) [ReadRequest]
forest

getJoinsSelects :: ReadRequest -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet])
getJoinsSelects :: ReadRequest -> ([Snippet], [Snippet]) -> ([Snippet], [Snippet])
getJoinsSelects rr :: ReadRequest
rr@(Node (ReadQuery
_, (NodeName
name, Just Relationship{relCardinality :: Relationship -> Cardinality
relCardinality=Cardinality
card,relTable :: Relationship -> Table
relTable=Table{tableName :: Table -> NodeName
tableName=NodeName
table}}, Maybe NodeName
alias, Maybe NodeName
_, Maybe JoinType
joinType, Depth
_)) [ReadRequest]
_) ([Snippet]
joins,[Snippet]
selects) =
  let subquery :: Snippet
subquery = ReadRequest -> Snippet
readRequestToQuery ReadRequest
rr in
  case Cardinality
card of
    M2O NodeName
_ ->
      let aliasOrName :: NodeName
aliasOrName = NodeName -> Maybe NodeName -> NodeName
forall a. a -> Maybe a -> a
fromMaybe NodeName
name Maybe NodeName
alias
          localTableName :: ByteString
localTableName = NodeName -> ByteString
pgFmtIdent (NodeName -> ByteString) -> NodeName -> ByteString
forall a b. (a -> b) -> a -> b
$ NodeName
table NodeName -> NodeName -> NodeName
forall a. Semigroup a => a -> a -> a
<> NodeName
"_" NodeName -> NodeName -> NodeName
forall a. Semigroup a => a -> a -> a
<> NodeName
aliasOrName
          sel :: Snippet
sel = ByteString -> Snippet
SQL.sql (ByteString
"row_to_json(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
localTableName ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".*) AS " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
pgFmtIdent NodeName
aliasOrName)
          joi :: Snippet
joi = (if Maybe JoinType
joinType Maybe JoinType -> Maybe JoinType -> Bool
forall a. Eq a => a -> a -> Bool
== JoinType -> Maybe JoinType
forall a. a -> Maybe a
Just JoinType
JTInner then Snippet
" INNER" else Snippet
" LEFT")
            Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" JOIN LATERAL( " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
subquery Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" ) AS " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql ByteString
localTableName Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" ON TRUE " in
      (Snippet
joiSnippet -> [Snippet] -> [Snippet]
forall a. a -> [a] -> [a]
:[Snippet]
joins,Snippet
selSnippet -> [Snippet] -> [Snippet]
forall a. a -> [a] -> [a]
:[Snippet]
selects)
    Cardinality
_ -> case Maybe JoinType
joinType of
      Just JoinType
JTInner ->
        let aliasOrName :: NodeName
aliasOrName = NodeName -> Maybe NodeName -> NodeName
forall a. a -> Maybe a -> a
fromMaybe NodeName
name Maybe NodeName
alias
            locTblName :: NodeName
locTblName = NodeName
table NodeName -> NodeName -> NodeName
forall a. Semigroup a => a -> a -> a
<> NodeName
"_" NodeName -> NodeName -> NodeName
forall a. Semigroup a => a -> a -> a
<> NodeName
aliasOrName
            localTableName :: ByteString
localTableName = NodeName -> ByteString
pgFmtIdent NodeName
locTblName
            internalTableName :: ByteString
internalTableName = NodeName -> ByteString
pgFmtIdent (NodeName -> ByteString) -> NodeName -> ByteString
forall a b. (a -> b) -> a -> b
$ NodeName
"_" NodeName -> NodeName -> NodeName
forall a. Semigroup a => a -> a -> a
<> NodeName
locTblName
            sel :: Snippet
sel = ByteString -> Snippet
SQL.sql (ByteString -> Snippet) -> ByteString -> Snippet
forall a b. (a -> b) -> a -> b
$ ByteString
localTableName ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
internalTableName ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
pgFmtIdent NodeName
aliasOrName
            joi :: Snippet
joi = Snippet
"INNER JOIN LATERAL(" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
                    Snippet
"SELECT json_agg(" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql ByteString
internalTableName Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
") AS " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql ByteString
internalTableName Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
                    Snippet
"FROM (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
subquery Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" ) AS " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql ByteString
internalTableName Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
                  Snippet
") AS " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql ByteString
localTableName Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" ON " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql ByteString
localTableName Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
"IS NOT NULL" in
        (Snippet
joiSnippet -> [Snippet] -> [Snippet]
forall a. a -> [a] -> [a]
:[Snippet]
joins,Snippet
selSnippet -> [Snippet] -> [Snippet]
forall a. a -> [a] -> [a]
:[Snippet]
selects)
      Maybe JoinType
_ ->
        let sel :: Snippet
sel = Snippet
"COALESCE (("
               Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
"SELECT json_agg(" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql (NodeName -> ByteString
pgFmtIdent NodeName
table) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
".*) "
               Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
"FROM (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
subquery Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
") " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql (NodeName -> ByteString
pgFmtIdent NodeName
table) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" "
               Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
"), '[]') AS " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql (NodeName -> ByteString
pgFmtIdent (NodeName -> Maybe NodeName -> NodeName
forall a. a -> Maybe a -> a
fromMaybe NodeName
name Maybe NodeName
alias)) in
        ([Snippet]
joins,Snippet
selSnippet -> [Snippet] -> [Snippet]
forall a. a -> [a] -> [a]
:[Snippet]
selects)
getJoinsSelects (Node (ReadQuery
_, (NodeName
_, Maybe Relationship
Nothing, Maybe NodeName
_, Maybe NodeName
_, Maybe JoinType
_, Depth
_)) [ReadRequest]
_) ([Snippet], [Snippet])
_ = ([], [])

mutateRequestToQuery :: MutateRequest -> SQL.Snippet
mutateRequestToQuery :: MutateRequest -> Snippet
mutateRequestToQuery (Insert QualifiedIdentifier
mainQi Set NodeName
iCols Maybe ByteString
body Maybe (PreferResolution, [NodeName])
onConflct [LogicTree]
putConditions [NodeName]
returnings) =
  Snippet
"WITH " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Maybe ByteString -> Snippet
normalizedBody Maybe ByteString
body Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  Snippet
"INSERT INTO " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql (QualifiedIdentifier -> ByteString
fromQi QualifiedIdentifier
mainQi) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql (if Set NodeName -> Bool
forall a. Set a -> Bool
S.null Set NodeName
iCols then ByteString
" " else ByteString
"(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
cols ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
") ") Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  Snippet
"SELECT " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql ByteString
cols Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> Snippet
SQL.sql (ByteString
"FROM json_populate_recordset (null::" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> QualifiedIdentifier -> ByteString
fromQi QualifiedIdentifier
mainQi ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
", " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
selectBody ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
") _ ") Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  -- Only used for PUT
  (if [LogicTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogicTree]
putConditions then Snippet
forall a. Monoid a => a
mempty else Snippet
"WHERE " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Snippet] -> Snippet
intercalateSnippet ByteString
" AND " (QualifiedIdentifier -> LogicTree -> Snippet
pgFmtLogicTree (NodeName -> NodeName -> QualifiedIdentifier
QualifiedIdentifier NodeName
forall a. Monoid a => a
mempty NodeName
"_") (LogicTree -> Snippet) -> [LogicTree] -> [Snippet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LogicTree]
putConditions)) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> Snippet
SQL.sql ([ByteString] -> ByteString
BS.unwords [
    ByteString
-> ((PreferResolution, [NodeName]) -> ByteString)
-> Maybe (PreferResolution, [NodeName])
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (\(PreferResolution
oncDo, [NodeName]
oncCols) ->
      if [NodeName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NodeName]
oncCols then
        ByteString
forall a. Monoid a => a
mempty
      else
        ByteString
"ON CONFLICT(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
", " (NodeName -> ByteString
pgFmtIdent (NodeName -> ByteString) -> [NodeName] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NodeName]
oncCols) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
") " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> case PreferResolution
oncDo of
        PreferResolution
IgnoreDuplicates ->
          ByteString
"DO NOTHING"
        PreferResolution
MergeDuplicates  ->
          if Set NodeName -> Bool
forall a. Set a -> Bool
S.null Set NodeName
iCols
             then ByteString
"DO NOTHING"
             else ByteString
"DO UPDATE SET " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
", " (NodeName -> ByteString
pgFmtIdent (NodeName -> ByteString)
-> (NodeName -> ByteString) -> NodeName -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> NodeName -> ByteString
forall a b. a -> b -> a
const ByteString
" = EXCLUDED." (NodeName -> ByteString)
-> (NodeName -> ByteString) -> NodeName -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
pgFmtIdent (NodeName -> ByteString) -> [NodeName] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set NodeName -> [NodeName]
forall a. Set a -> [a]
S.toList Set NodeName
iCols)
      ) Maybe (PreferResolution, [NodeName])
onConflct,
    QualifiedIdentifier -> [NodeName] -> ByteString
returningF QualifiedIdentifier
mainQi [NodeName]
returnings
    ])
  where
    cols :: ByteString
cols = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
", " ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ NodeName -> ByteString
pgFmtIdent (NodeName -> ByteString) -> [NodeName] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set NodeName -> [NodeName]
forall a. Set a -> [a]
S.toList Set NodeName
iCols
mutateRequestToQuery (Update QualifiedIdentifier
mainQi Set NodeName
uCols Maybe ByteString
body [LogicTree]
logicForest [NodeName]
returnings) =
  if Set NodeName -> Bool
forall a. Set a -> Bool
S.null Set NodeName
uCols
    -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
    -- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select=
    -- the select has to be based on "returnings" to make computed overloaded functions not throw
    then ByteString -> Snippet
SQL.sql (ByteString
"SELECT " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
emptyBodyReturnedColumns ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" FROM " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> QualifiedIdentifier -> ByteString
fromQi QualifiedIdentifier
mainQi ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" WHERE false")
    else
      Snippet
"WITH " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Maybe ByteString -> Snippet
normalizedBody Maybe ByteString
body Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
      Snippet
"UPDATE " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql (QualifiedIdentifier -> ByteString
fromQi QualifiedIdentifier
mainQi) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" SET " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql ByteString
cols Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
      Snippet
"FROM (SELECT * FROM json_populate_recordset (null::" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql (QualifiedIdentifier -> ByteString
fromQi QualifiedIdentifier
mainQi) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" , " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql ByteString
selectBody Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" )) _ " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
      (if [LogicTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogicTree]
logicForest then Snippet
forall a. Monoid a => a
mempty else Snippet
"WHERE " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Snippet] -> Snippet
intercalateSnippet ByteString
" AND " (QualifiedIdentifier -> LogicTree -> Snippet
pgFmtLogicTree QualifiedIdentifier
mainQi (LogicTree -> Snippet) -> [LogicTree] -> [Snippet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LogicTree]
logicForest)) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
      ByteString -> Snippet
SQL.sql (QualifiedIdentifier -> [NodeName] -> ByteString
returningF QualifiedIdentifier
mainQi [NodeName]
returnings)
  where
    cols :: ByteString
cols = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
", " (NodeName -> ByteString
pgFmtIdent (NodeName -> ByteString)
-> (NodeName -> ByteString) -> NodeName -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> NodeName -> ByteString
forall a b. a -> b -> a
const ByteString
" = _." (NodeName -> ByteString)
-> (NodeName -> ByteString) -> NodeName -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
pgFmtIdent (NodeName -> ByteString) -> [NodeName] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set NodeName -> [NodeName]
forall a. Set a -> [a]
S.toList Set NodeName
uCols)
    emptyBodyReturnedColumns :: SqlFragment
    emptyBodyReturnedColumns :: ByteString
emptyBodyReturnedColumns
      | [NodeName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NodeName]
returnings = ByteString
"NULL"
      | Bool
otherwise       = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
", " (QualifiedIdentifier -> NodeName -> ByteString
pgFmtColumn (NodeName -> NodeName -> QualifiedIdentifier
QualifiedIdentifier NodeName
forall a. Monoid a => a
mempty (NodeName -> QualifiedIdentifier)
-> NodeName -> QualifiedIdentifier
forall a b. (a -> b) -> a -> b
$ QualifiedIdentifier -> NodeName
qiName QualifiedIdentifier
mainQi) (NodeName -> ByteString) -> [NodeName] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NodeName]
returnings)
mutateRequestToQuery (Delete QualifiedIdentifier
mainQi [LogicTree]
logicForest [NodeName]
returnings) =
  Snippet
"DELETE FROM " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql (QualifiedIdentifier -> ByteString
fromQi QualifiedIdentifier
mainQi) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  (if [LogicTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogicTree]
logicForest then Snippet
forall a. Monoid a => a
mempty else Snippet
"WHERE " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Snippet] -> Snippet
intercalateSnippet ByteString
" AND " ((LogicTree -> Snippet) -> [LogicTree] -> [Snippet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (QualifiedIdentifier -> LogicTree -> Snippet
pgFmtLogicTree QualifiedIdentifier
mainQi) [LogicTree]
logicForest)) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> Snippet
SQL.sql (QualifiedIdentifier -> [NodeName] -> ByteString
returningF QualifiedIdentifier
mainQi [NodeName]
returnings)

requestToCallProcQuery :: CallRequest -> SQL.Snippet
requestToCallProcQuery :: CallRequest -> Snippet
requestToCallProcQuery (FunctionCall QualifiedIdentifier
qi CallParams
params Maybe ByteString
args Bool
returnsScalar Bool
multipleCall [NodeName]
returnings) =
  Snippet
prmsCTE Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
argsBody
  where
    (Snippet
prmsCTE, Snippet
argFrag) = case CallParams
params of
      OnePosParam ProcParam
prm -> (Snippet
"WITH pgrst_args AS (SELECT NULL)", Maybe ByteString -> ByteString -> Snippet
singleParameter Maybe ByteString
args (NodeName -> ByteString
encodeUtf8 (NodeName -> ByteString) -> NodeName -> ByteString
forall a b. (a -> b) -> a -> b
$ ProcParam -> NodeName
ppType ProcParam
prm))
      KeyParams []    -> (Snippet
forall a. Monoid a => a
mempty, Snippet
forall a. Monoid a => a
mempty)
      KeyParams [ProcParam]
prms  -> (
          Snippet
"WITH " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Maybe ByteString -> Snippet
normalizedBody Maybe ByteString
args Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
", " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
          ByteString -> Snippet
SQL.sql (
            [ByteString] -> ByteString
BS.unwords [
            ByteString
"pgrst_args AS (",
              ByteString
"SELECT * FROM json_to_recordset(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
selectBody ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
") AS _(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [ProcParam]
-> (ProcParam -> ByteString)
-> (ProcParam -> ByteString)
-> ByteString
fmtParams [ProcParam]
prms (ByteString -> ProcParam -> ByteString
forall a b. a -> b -> a
const ByteString
forall a. Monoid a => a
mempty) (\ProcParam
a -> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
encodeUtf8 (ProcParam -> NodeName
ppType ProcParam
a)) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")",
            ByteString
")"])
         , ByteString -> Snippet
SQL.sql (ByteString -> Snippet) -> ByteString -> Snippet
forall a b. (a -> b) -> a -> b
$ if Bool
multipleCall
             then [ProcParam]
-> (ProcParam -> ByteString)
-> (ProcParam -> ByteString)
-> ByteString
fmtParams [ProcParam]
prms ProcParam -> ByteString
varadicPrefix (\ProcParam
a -> ByteString
" := pgrst_args." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
pgFmtIdent (ProcParam -> NodeName
ppName ProcParam
a))
             else [ProcParam]
-> (ProcParam -> ByteString)
-> (ProcParam -> ByteString)
-> ByteString
fmtParams [ProcParam]
prms ProcParam -> ByteString
varadicPrefix (\ProcParam
a -> ByteString
" := (SELECT " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
pgFmtIdent (ProcParam -> NodeName
ppName ProcParam
a) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" FROM pgrst_args LIMIT 1)")
        )

    fmtParams :: [ProcParam] -> (ProcParam -> SqlFragment) -> (ProcParam -> SqlFragment) -> SqlFragment
    fmtParams :: [ProcParam]
-> (ProcParam -> ByteString)
-> (ProcParam -> ByteString)
-> ByteString
fmtParams [ProcParam]
prms ProcParam -> ByteString
prmFragPre ProcParam -> ByteString
prmFragSuf = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
", "
      ((\ProcParam
a -> ProcParam -> ByteString
prmFragPre ProcParam
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
pgFmtIdent (ProcParam -> NodeName
ppName ProcParam
a) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ProcParam -> ByteString
prmFragSuf ProcParam
a) (ProcParam -> ByteString) -> [ProcParam] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ProcParam]
prms)

    varadicPrefix :: ProcParam -> SqlFragment
    varadicPrefix :: ProcParam -> ByteString
varadicPrefix ProcParam
a = if ProcParam -> Bool
ppVar ProcParam
a then ByteString
"VARIADIC " else ByteString
forall a. Monoid a => a
mempty

    argsBody :: SQL.Snippet
    argsBody :: Snippet
argsBody
      | Bool
multipleCall =
          if Bool
returnsScalar
            then Snippet
"SELECT " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
callIt Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" AS pgrst_scalar FROM pgrst_args"
            else Snippet
"SELECT pgrst_lat_args.* FROM pgrst_args, " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
                 Snippet
"LATERAL ( SELECT " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
returnedColumns Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" FROM " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
callIt Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" ) pgrst_lat_args"
      | Bool
otherwise =
          if Bool
returnsScalar
            then Snippet
"SELECT " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
callIt Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" AS pgrst_scalar"
            else Snippet
"SELECT " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
returnedColumns Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" FROM " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
callIt

    callIt :: SQL.Snippet
    callIt :: Snippet
callIt = ByteString -> Snippet
SQL.sql (QualifiedIdentifier -> ByteString
fromQi QualifiedIdentifier
qi) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
"(" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
argFrag Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
")"

    returnedColumns :: SQL.Snippet
    returnedColumns :: Snippet
returnedColumns
      | [NodeName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NodeName]
returnings = Snippet
"*"
      | Bool
otherwise       = ByteString -> Snippet
SQL.sql (ByteString -> Snippet) -> ByteString -> Snippet
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
", " (QualifiedIdentifier -> NodeName -> ByteString
pgFmtColumn (NodeName -> NodeName -> QualifiedIdentifier
QualifiedIdentifier NodeName
forall a. Monoid a => a
mempty (NodeName -> QualifiedIdentifier)
-> NodeName -> QualifiedIdentifier
forall a b. (a -> b) -> a -> b
$ QualifiedIdentifier -> NodeName
qiName QualifiedIdentifier
qi) (NodeName -> ByteString) -> [NodeName] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NodeName]
returnings)


-- | SQL query meant for COUNTing the root node of the Tree.
-- It only takes WHERE into account and doesn't include LIMIT/OFFSET because it would reduce the COUNT.
-- SELECT 1 is done instead of SELECT * to prevent doing expensive operations(like functions based on the columns)
-- inside the FROM target.
-- If the request contains INNER JOINs, then the COUNT of the root node will change.
-- For this case, we use a WHERE EXISTS instead of an INNER JOIN on the count query.
-- See https://github.com/PostgREST/postgrest/issues/2009#issuecomment-977473031
-- Only for the nodes that have an INNER JOIN linked to the root level.
readRequestToCountQuery :: ReadRequest -> SQL.Snippet
readRequestToCountQuery :: ReadRequest -> Snippet
readRequestToCountQuery (Node (Select{$sel:from:Select :: ReadQuery -> QualifiedIdentifier
from=QualifiedIdentifier
qi, $sel:implicitJoins:Select :: ReadQuery -> [QualifiedIdentifier]
implicitJoins=[QualifiedIdentifier]
implJoins, $sel:where_:Select :: ReadQuery -> [LogicTree]
where_=[LogicTree]
logicForest, $sel:joinConditions:Select :: ReadQuery -> [JoinCondition]
joinConditions=[JoinCondition]
joinConditions_}, (NodeName, Maybe Relationship, Maybe NodeName, Maybe NodeName,
 Maybe JoinType, Depth)
_) [ReadRequest]
forest) =
  Snippet
"SELECT 1 FROM " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql (ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
", " (QualifiedIdentifier -> ByteString
fromQi QualifiedIdentifier
qiByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:(QualifiedIdentifier -> ByteString
fromQi (QualifiedIdentifier -> ByteString)
-> [QualifiedIdentifier] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [QualifiedIdentifier]
implJoins))) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  (if [LogicTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogicTree]
logicForest Bool -> Bool -> Bool
&& [JoinCondition] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [JoinCondition]
joinConditions_ Bool -> Bool -> Bool
&& [Snippet] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Snippet]
subQueries
    then Snippet
forall a. Monoid a => a
mempty
    else Snippet
" WHERE " ) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> [Snippet] -> Snippet
intercalateSnippet ByteString
" AND " (
    (LogicTree -> Snippet) -> [LogicTree] -> [Snippet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (QualifiedIdentifier -> LogicTree -> Snippet
pgFmtLogicTree QualifiedIdentifier
qi) [LogicTree]
logicForest [Snippet] -> [Snippet] -> [Snippet]
forall a. [a] -> [a] -> [a]
++
    (JoinCondition -> Snippet) -> [JoinCondition] -> [Snippet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map JoinCondition -> Snippet
pgFmtJoinCondition [JoinCondition]
joinConditions_ [Snippet] -> [Snippet] -> [Snippet]
forall a. [a] -> [a] -> [a]
++
    [Snippet]
subQueries
  )
  where
    subQueries :: [Snippet]
subQueries = (ReadRequest -> [Snippet] -> [Snippet])
-> [Snippet] -> [ReadRequest] -> [Snippet]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ReadRequest -> [Snippet] -> [Snippet]
existsSubquery [] [ReadRequest]
forest
    existsSubquery :: ReadRequest -> [SQL.Snippet] -> [SQL.Snippet]
    existsSubquery :: ReadRequest -> [Snippet] -> [Snippet]
existsSubquery readReq :: ReadRequest
readReq@(Node (ReadQuery
_, (NodeName
_, Maybe Relationship
_, Maybe NodeName
_, Maybe NodeName
_, Maybe JoinType
joinType, Depth
_)) [ReadRequest]
_) [Snippet]
rest =
      if Maybe JoinType
joinType Maybe JoinType -> Maybe JoinType -> Bool
forall a. Eq a => a -> a -> Bool
== JoinType -> Maybe JoinType
forall a. a -> Maybe a
Just JoinType
JTInner
        then (Snippet
"EXISTS (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ReadRequest -> Snippet
readRequestToCountQuery ReadRequest
readReq Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" )")Snippet -> [Snippet] -> [Snippet]
forall a. a -> [a] -> [a]
:[Snippet]
rest
        else [Snippet]
forall a. Monoid a => a
mempty

limitedQuery :: SQL.Snippet -> Maybe Integer -> SQL.Snippet
limitedQuery :: Snippet -> Maybe Depth -> Snippet
limitedQuery Snippet
query Maybe Depth
maxRows = Snippet
query Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
SQL.sql (ByteString -> (Depth -> ByteString) -> Maybe Depth -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
forall a. Monoid a => a
mempty (\Depth
x -> ByteString
" LIMIT " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BS.pack (Depth -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Depth
x)) Maybe Depth
maxRows)