LTS 13.29 (#1364)

* Update resolver to lts-13.29 and add lock file to repository * Upgrade stack version * Save cache after building dependencies only to have faster feedback loop when tests fail * Move private functions from QueryBuilder to a separate Private module * Move more functions over to private trying to make compilation consume less memory * Split private in 4 modules * Remove unused LambdaCase pragma * Add profile to memory-tests.sh so it can find postgrest executable * Move save dependencies before building and running tests for faster feedback loop
2019-07-29 17:14:06 +00:00
parent c37a9f5ec3
commit 291de5bc1c
10 changed files with 552 additions and 394 deletions
@@ -0,0 +1,85 @@
+module PostgREST.QueryBuilder.Procedure where
+
+import           Data.Maybe
+import           Data.Text                      (intercalate, unwords)
+import qualified Hasql.Decoders                 as HD
+import qualified Hasql.Encoders                 as HE
+import qualified Hasql.Statement                as H
+import           PostgREST.QueryBuilder.Private
+import           PostgREST.Types
+import           Protolude                      hiding (cast,
+                                                 intercalate, replace)
+import           Text.InterpolatedString.Perl6  (qc)
+
+type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)
+callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->
+            Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
+            H.Statement ByteString (Maybe ProcResults)
+callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField pgVer =
+  unicodeStatement sql (param HE.unknown) decodeProc True
+  where
+    sql =[qc|
+      WITH
+      {argsRecord},
+      {sourceCTEName} AS (
+        {sourceBody}
+      )
+      SELECT
+        {countResultF} AS total_result_set,
+        pg_catalog.count(_postgrest_t) AS page_total,
+        {bodyF} AS body,
+        {responseHeaders} AS response_headers
+      FROM ({selectQuery}) _postgrest_t;|]
+
+    (argsRecord, args)
+      | paramsAsSingleObject = ("_args_record AS (SELECT NULL)", "$1::json")
+      | null pgArgs = (ignoredBody, "")
+      | otherwise = (
+          unwords [
+            normalizedBody <> ",",
+            "_args_record AS (",
+              "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <>
+                intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " " <> pgaType a) <$> pgArgs) <> ")",
+            ")"]
+         , intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " := _args_record." <> pgFmtIdent (pgaName a)) <$> pgArgs))
+
+    sourceBody :: SqlFragment
+    sourceBody
+      | paramsAsSingleObject || null pgArgs =
+          if returnsScalar
+            then [qc| SELECT {fromQi qi}({args}) |]
+            else [qc| SELECT * FROM {fromQi qi}({args}) |]
+      | otherwise =
+          if returnsScalar
+            then [qc| SELECT {fromQi qi}({args}) FROM _args_record |]
+            else [qc| SELECT _.*
+                      FROM _args_record,
+                      LATERAL ( SELECT * FROM {fromQi qi}({args}) ) _ |]
+
+    bodyF
+     | returnsScalar = scalarBodyF
+     | isSingle = asJsonSingleF
+     | asCsv = asCsvF
+     | isJust binaryField = asBinaryF $ fromJust binaryField
+     | otherwise = asJsonF
+
+    scalarBodyF
+     | asBinary = asBinaryF _procName
+     | otherwise = unwords [
+        "CASE",
+          "WHEN pg_catalog.count(_postgrest_t) = 1",
+            "THEN (json_agg(_postgrest_t." <> pgFmtIdent _procName <> ")->0)::character varying",
+            "ELSE (json_agg(_postgrest_t." <> pgFmtIdent _procName <> "))::character varying",
+        "END"]
+
+    countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
+    _procName = qiName qi
+    responseHeaders =
+      if pgVer >= pgVersion96
+        then "coalesce(nullif(current_setting('response.headers', true), ''), '[]')" :: Text -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
+        else "'[]'" :: Text
+
+    decodeProc = HD.rowMaybe procRow
+    procRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
+                    <*> column HD.bytea <*> column HD.bytea
+