{-# 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 H

import Data.Tree (Tree (..))

import PostgREST.DbStructure.Identifiers  (FieldName,
                                           QualifiedIdentifier (..))
import PostgREST.DbStructure.Proc         (PgArg (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
                                           Relationship (..))
import PostgREST.DbStructure.Table        (Table (..))
import PostgREST.Request.ApiRequest       (PayloadJSON (..))
import PostgREST.Request.Preferences      (PreferParameters (..),
                                           PreferResolution (..))

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

import Protolude

readRequestToQuery :: ReadRequest -> H.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,
 Depth)
_) Forest
  (ReadQuery,
   (NodeName, Maybe Relationship, Maybe NodeName, Maybe NodeName,
    Depth))
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
H.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])
-> Forest
     (ReadQuery,
      (NodeName, Maybe Relationship, Maybe NodeName, Maybe NodeName,
       Depth))
-> ([Snippet], [Snippet])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ReadRequest -> ([Snippet], [Snippet]) -> ([Snippet], [Snippet])
getJoinsSelects ([],[]) Forest
  (ReadQuery,
   (NodeName, Maybe Relationship, Maybe NodeName, Maybe NodeName,
    Depth))
forest

getJoinsSelects :: ReadRequest -> ([H.Snippet], [H.Snippet]) -> ([H.Snippet], [H.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
_, Depth
_)) Forest
  (ReadQuery,
   (NodeName, Maybe Relationship, Maybe NodeName, Maybe NodeName,
    Depth))
_) ([Snippet]
j,[Snippet]
s) =
  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
H.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 = Snippet
" LEFT 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
H.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]
j,Snippet
selSnippet -> [Snippet] -> [Snippet]
forall a. a -> [a] -> [a]
:[Snippet]
s)
    Cardinality
_ ->
      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
H.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
H.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
H.sql (NodeName -> ByteString
pgFmtIdent (NodeName -> Maybe NodeName -> NodeName
forall a. a -> Maybe a -> a
fromMaybe NodeName
name Maybe NodeName
alias)) in
      ([Snippet]
j,Snippet
selSnippet -> [Snippet] -> [Snippet]
forall a. a -> [a] -> [a]
:[Snippet]
s)
getJoinsSelects (Node (ReadQuery
_, (NodeName
_, Maybe Relationship
Nothing, Maybe NodeName
_, Maybe NodeName
_, Depth
_)) Forest
  (ReadQuery,
   (NodeName, Maybe Relationship, Maybe NodeName, Maybe NodeName,
    Depth))
_) ([Snippet], [Snippet])
_ = ([], [])

mutateRequestToQuery :: MutateRequest -> H.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
H.sql (QualifiedIdentifier -> ByteString
fromQi QualifiedIdentifier
mainQi) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
H.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
H.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
H.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
H.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
H.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
H.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
H.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
H.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
H.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
H.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
H.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
H.sql (QualifiedIdentifier -> [NodeName] -> ByteString
returningF QualifiedIdentifier
mainQi [NodeName]
returnings)

requestToCallProcQuery :: QualifiedIdentifier -> [PgArg] -> Maybe PayloadJSON -> Bool -> Maybe PreferParameters -> [FieldName] -> H.Snippet
requestToCallProcQuery :: QualifiedIdentifier
-> [PgArg]
-> Maybe PayloadJSON
-> Bool
-> Maybe PreferParameters
-> [NodeName]
-> Snippet
requestToCallProcQuery QualifiedIdentifier
qi [PgArg]
pgArgs Maybe PayloadJSON
pj Bool
returnsScalar Maybe PreferParameters
preferParams [NodeName]
returnings =
  Snippet
argsCTE Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
sourceBody
  where
    body :: Maybe ByteString
body = PayloadJSON -> ByteString
pjRaw (PayloadJSON -> ByteString)
-> Maybe PayloadJSON -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PayloadJSON
pj
    paramsAsSingleObject :: Bool
paramsAsSingleObject    = Maybe PreferParameters
preferParams Maybe PreferParameters -> Maybe PreferParameters -> Bool
forall a. Eq a => a -> a -> Bool
== PreferParameters -> Maybe PreferParameters
forall a. a -> Maybe a
Just PreferParameters
SingleObject
    paramsAsMultipleObjects :: Bool
paramsAsMultipleObjects = Maybe PreferParameters
preferParams Maybe PreferParameters -> Maybe PreferParameters -> Bool
forall a. Eq a => a -> a -> Bool
== PreferParameters -> Maybe PreferParameters
forall a. a -> Maybe a
Just PreferParameters
MultipleObjects

    (Snippet
argsCTE, Snippet
args)
      | [PgArg] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PgArg]
pgArgs = (Snippet
forall a. Monoid a => a
mempty, Snippet
forall a. Monoid a => a
mempty)
      | Bool
paramsAsSingleObject = (Snippet
"WITH pgrst_args AS (SELECT NULL)", Maybe ByteString -> Snippet
jsonPlaceHolder Maybe ByteString
body)
      | Bool
otherwise = (
          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
<>
          ByteString -> Snippet
H.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
<> (PgArg -> ByteString) -> (PgArg -> ByteString) -> ByteString
fmtArgs (ByteString -> PgArg -> ByteString
forall a b. a -> b -> a
const ByteString
forall a. Monoid a => a
mempty) (\PgArg
a -> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
encodeUtf8 (PgArg -> NodeName
pgaType PgArg
a)) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")",
            ByteString
")"])
         , ByteString -> Snippet
H.sql (ByteString -> Snippet) -> ByteString -> Snippet
forall a b. (a -> b) -> a -> b
$ if Bool
paramsAsMultipleObjects
             then (PgArg -> ByteString) -> (PgArg -> ByteString) -> ByteString
fmtArgs PgArg -> ByteString
varadicPrefix (\PgArg
a -> ByteString
" := pgrst_args." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
pgFmtIdent (PgArg -> NodeName
pgaName PgArg
a))
             else (PgArg -> ByteString) -> (PgArg -> ByteString) -> ByteString
fmtArgs PgArg -> ByteString
varadicPrefix (\PgArg
a -> ByteString
" := (SELECT " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
pgFmtIdent (PgArg -> NodeName
pgaName PgArg
a) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" FROM pgrst_args LIMIT 1)")
        )

    fmtArgs :: (PgArg -> SqlFragment) -> (PgArg -> SqlFragment) -> SqlFragment
    fmtArgs :: (PgArg -> ByteString) -> (PgArg -> ByteString) -> ByteString
fmtArgs PgArg -> ByteString
argFragPre PgArg -> ByteString
argFragSuf = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
", " ((\PgArg
a -> PgArg -> ByteString
argFragPre PgArg
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> NodeName -> ByteString
pgFmtIdent (PgArg -> NodeName
pgaName PgArg
a) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> PgArg -> ByteString
argFragSuf PgArg
a) (PgArg -> ByteString) -> [PgArg] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PgArg]
pgArgs)

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

    sourceBody :: H.Snippet
    sourceBody :: Snippet
sourceBody
      | Bool
paramsAsMultipleObjects =
          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 :: H.Snippet
    callIt :: Snippet
callIt = ByteString -> Snippet
H.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
args Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
")"

    returnedColumns :: H.Snippet
    returnedColumns :: Snippet
returnedColumns
      | [NodeName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NodeName]
returnings = Snippet
"*"
      | Bool
otherwise       = ByteString -> Snippet
H.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.
readRequestToCountQuery :: ReadRequest -> H.Snippet
readRequestToCountQuery :: ReadRequest -> Snippet
readRequestToCountQuery (Node (Select{$sel:from:Select :: ReadQuery -> QualifiedIdentifier
from=QualifiedIdentifier
qi, $sel:where_:Select :: ReadQuery -> [LogicTree]
where_=[LogicTree]
logicForest}, (NodeName, Maybe Relationship, Maybe NodeName, Maybe NodeName,
 Depth)
_) Forest
  (ReadQuery,
   (NodeName, Maybe Relationship, Maybe NodeName, Maybe NodeName,
    Depth))
_) =
 Snippet
"SELECT 1 " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
"FROM " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
H.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
<>
 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
qi) [LogicTree]
logicForest)

limitedQuery :: H.Snippet -> Maybe Integer -> H.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
H.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)