{-|
Module      : PostgREST.Query.Statements
Description : PostgREST single SQL statements.

This module constructs single SQL statements that can be parametrized and prepared.

- It consumes the SqlQuery types generated by the QueryBuilder module.
- It generates the body format and some headers of the final HTTP response.

TODO: Currently, createReadStatement is not using prepared statements. See https://github.com/PostgREST/postgrest/issues/718.
-}
module PostgREST.Query.Statements
  ( createWriteStatement
  , createReadStatement
  , callProcStatement
  , createExplainStatement
  ) where

import qualified Data.Aeson                        as JSON
import qualified Data.Aeson.Lens                   as L
import qualified Data.ByteString.Char8             as BS
import qualified Hasql.Decoders                    as HD
import qualified Hasql.DynamicStatements.Snippet   as H
import qualified Hasql.DynamicStatements.Statement as H
import qualified Hasql.Statement                   as H

import Control.Lens              ((^?))
import Data.Maybe                (fromJust)
import Data.Text.Read            (decimal)
import Network.HTTP.Types.Status (Status)

import PostgREST.Config.PgVersion (PgVersion)
import PostgREST.Error            (Error (..))
import PostgREST.GucHeader        (GucHeader)

import PostgREST.DbStructure.Identifiers (FieldName)
import PostgREST.Query.SqlFragment
import PostgREST.Request.Preferences

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

{-| The generic query result format used by API responses. The location header
    is represented as a list of strings containing variable bindings like
    @"k1=eq.42"@, or the empty list if there is no location header.
-}
type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Error [GucHeader], Either Error (Maybe Status))

createWriteStatement :: H.Snippet -> H.Snippet -> Bool -> Bool -> Bool ->
                        PreferRepresentation -> [Text] -> PgVersion -> Bool ->
                        H.Statement () ResultsWithCount
createWriteStatement :: Snippet
-> Snippet
-> Bool
-> Bool
-> Bool
-> PreferRepresentation
-> [Text]
-> PgVersion
-> Bool
-> Statement () ResultsWithCount
createWriteStatement Snippet
selectQuery Snippet
mutateQuery Bool
wantSingle Bool
isInsert Bool
asCsv PreferRepresentation
rep [Text]
pKeys PgVersion
pgVer =
  Snippet
-> Result ResultsWithCount -> Bool -> Statement () ResultsWithCount
forall result.
Snippet -> Result result -> Bool -> Statement () result
H.dynamicallyParameterized Snippet
snippet Result ResultsWithCount
decodeStandard
 where
  snippet :: Snippet
snippet =
    Snippet
"WITH " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
H.sql ByteString
sourceCTEName Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" AS (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
mutateQuery 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
"SELECT " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      ByteString
"'' AS total_result_set, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      ByteString
"pg_catalog.count(_postgrest_t) AS page_total, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      ByteString
locF ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS header, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      ByteString
bodyF ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS body, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      PgVersion -> ByteString
responseHeadersF PgVersion
pgVer ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS response_headers, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      PgVersion -> ByteString
responseStatusF PgVersion
pgVer  ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS response_status "
    ) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
    Snippet
"FROM (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
selectF Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
") _postgrest_t"

  locF :: ByteString
locF =
    if Bool
isInsert Bool -> Bool -> Bool
&& PreferRepresentation
rep PreferRepresentation -> [PreferRepresentation] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PreferRepresentation
Full, PreferRepresentation
HeadersOnly]
      then [ByteString] -> ByteString
BS.unwords [
        ByteString
"CASE WHEN pg_catalog.count(_postgrest_t) = 1",
          ByteString
"THEN coalesce(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Text] -> ByteString
locationF [Text]
pKeys ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
", " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
noLocationF ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")",
          ByteString
"ELSE " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
noLocationF,
        ByteString
"END"]
      else ByteString
noLocationF

  bodyF :: ByteString
bodyF
    | PreferRepresentation
rep PreferRepresentation -> [PreferRepresentation] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PreferRepresentation
None, PreferRepresentation
HeadersOnly] = ByteString
"''"
    | Bool
asCsv = ByteString
asCsvF
    | Bool
wantSingle = Bool -> ByteString
asJsonSingleF Bool
False
    | Bool
otherwise = Bool -> ByteString
asJsonF Bool
False

  selectF :: Snippet
selectF
    -- prevent using any of the column names in ?select= when no response is returned from the CTE
    | PreferRepresentation
rep PreferRepresentation -> [PreferRepresentation] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PreferRepresentation
None, PreferRepresentation
HeadersOnly] = ByteString -> Snippet
H.sql (ByteString
"SELECT * FROM " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sourceCTEName)
    | Bool
otherwise                      = Snippet
selectQuery

  decodeStandard :: HD.Result ResultsWithCount
  decodeStandard :: Result ResultsWithCount
decodeStandard =
   ResultsWithCount -> Maybe ResultsWithCount -> ResultsWithCount
forall a. a -> Maybe a -> a
fromMaybe (Maybe Int64
forall a. Maybe a
Nothing, Int64
0, [], ByteString
forall a. Monoid a => a
mempty, [GucHeader] -> Either Error [GucHeader]
forall a b. b -> Either a b
Right [], Maybe Status -> Either Error (Maybe Status)
forall a b. b -> Either a b
Right Maybe Status
forall a. Maybe a
Nothing) (Maybe ResultsWithCount -> ResultsWithCount)
-> Result (Maybe ResultsWithCount) -> Result ResultsWithCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row ResultsWithCount -> Result (Maybe ResultsWithCount)
forall a. Row a -> Result (Maybe a)
HD.rowMaybe Row ResultsWithCount
standardRow

createReadStatement :: H.Snippet -> H.Snippet -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool ->
                       H.Statement () ResultsWithCount
createReadStatement :: Snippet
-> Snippet
-> Bool
-> Bool
-> Bool
-> Maybe Text
-> PgVersion
-> Bool
-> Statement () ResultsWithCount
createReadStatement Snippet
selectQuery Snippet
countQuery Bool
isSingle Bool
countTotal Bool
asCsv Maybe Text
binaryField PgVersion
pgVer =
  Snippet
-> Result ResultsWithCount -> Bool -> Statement () ResultsWithCount
forall result.
Snippet -> Result result -> Bool -> Statement () result
H.dynamicallyParameterized Snippet
snippet Result ResultsWithCount
decodeStandard
 where
  snippet :: Snippet
snippet =
    Snippet
"WITH " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
    ByteString -> Snippet
H.sql ByteString
sourceCTEName Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" AS ( " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
selectQuery Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" ) " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
    Snippet
countCTEF 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
"SELECT " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      ByteString
countResultF ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS total_result_set, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      ByteString
"pg_catalog.count(_postgrest_t) AS page_total, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      ByteString
noLocationF ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS header, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      ByteString
bodyF ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS body, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      PgVersion -> ByteString
responseHeadersF PgVersion
pgVer ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS response_headers, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      PgVersion -> ByteString
responseStatusF PgVersion
pgVer ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS response_status " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
    ByteString
"FROM ( SELECT * FROM " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sourceCTEName ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" ) _postgrest_t")

  (Snippet
countCTEF, ByteString
countResultF) = Snippet -> Bool -> (Snippet, ByteString)
countF Snippet
countQuery Bool
countTotal

  bodyF :: ByteString
bodyF
    | Bool
asCsv = ByteString
asCsvF
    | Bool
isSingle = Bool -> ByteString
asJsonSingleF Bool
False
    | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
binaryField = Text -> ByteString
asBinaryF (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
binaryField
    | Bool
otherwise = Bool -> ByteString
asJsonF Bool
False

  decodeStandard :: HD.Result ResultsWithCount
  decodeStandard :: Result ResultsWithCount
decodeStandard =
    Row ResultsWithCount -> Result ResultsWithCount
forall a. Row a -> Result a
HD.singleRow Row ResultsWithCount
standardRow

{-| Read and Write api requests use a similar response format which includes
    various record counts and possible location header. This is the decoder
    for that common type of query.
-}
standardRow :: HD.Row ResultsWithCount
standardRow :: Row ResultsWithCount
standardRow = (,,,,,) (Maybe Int64
 -> Int64
 -> [ByteString]
 -> ByteString
 -> Either Error [GucHeader]
 -> Either Error (Maybe Status)
 -> ResultsWithCount)
-> Row (Maybe Int64)
-> Row
     (Int64
      -> [ByteString]
      -> ByteString
      -> Either Error [GucHeader]
      -> Either Error (Maybe Status)
      -> ResultsWithCount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Int64 -> Row (Maybe Int64)
forall a. Value a -> Row (Maybe a)
nullableColumn Value Int64
HD.int8 Row
  (Int64
   -> [ByteString]
   -> ByteString
   -> Either Error [GucHeader]
   -> Either Error (Maybe Status)
   -> ResultsWithCount)
-> Row Int64
-> Row
     ([ByteString]
      -> ByteString
      -> Either Error [GucHeader]
      -> Either Error (Maybe Status)
      -> ResultsWithCount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Int64 -> Row Int64
forall a. Value a -> Row a
column Value Int64
HD.int8
                      Row
  ([ByteString]
   -> ByteString
   -> Either Error [GucHeader]
   -> Either Error (Maybe Status)
   -> ResultsWithCount)
-> Row [ByteString]
-> Row
     (ByteString
      -> Either Error [GucHeader]
      -> Either Error (Maybe Status)
      -> ResultsWithCount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value ByteString -> Row [ByteString]
forall a. Value a -> Row [a]
arrayColumn Value ByteString
HD.bytea Row
  (ByteString
   -> Either Error [GucHeader]
   -> Either Error (Maybe Status)
   -> ResultsWithCount)
-> Row ByteString
-> Row
     (Either Error [GucHeader]
      -> Either Error (Maybe Status) -> ResultsWithCount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value ByteString -> Row ByteString
forall a. Value a -> Row a
column Value ByteString
HD.bytea
                      Row
  (Either Error [GucHeader]
   -> Either Error (Maybe Status) -> ResultsWithCount)
-> Row (Either Error [GucHeader])
-> Row (Either Error (Maybe Status) -> ResultsWithCount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Either Error [GucHeader]
-> Maybe (Either Error [GucHeader]) -> Either Error [GucHeader]
forall a. a -> Maybe a -> a
fromMaybe ([GucHeader] -> Either Error [GucHeader]
forall a b. b -> Either a b
Right []) (Maybe (Either Error [GucHeader]) -> Either Error [GucHeader])
-> Row (Maybe (Either Error [GucHeader]))
-> Row (Either Error [GucHeader])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (Either Error [GucHeader])
-> Row (Maybe (Either Error [GucHeader]))
forall a. Value a -> Row (Maybe a)
nullableColumn Value (Either Error [GucHeader])
decodeGucHeaders)
                      Row (Either Error (Maybe Status) -> ResultsWithCount)
-> Row (Either Error (Maybe Status)) -> Row ResultsWithCount
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Either Error (Maybe Status)
-> Maybe (Either Error (Maybe Status))
-> Either Error (Maybe Status)
forall a. a -> Maybe a -> a
fromMaybe (Maybe Status -> Either Error (Maybe Status)
forall a b. b -> Either a b
Right Maybe Status
forall a. Maybe a
Nothing) (Maybe (Either Error (Maybe Status))
 -> Either Error (Maybe Status))
-> Row (Maybe (Either Error (Maybe Status)))
-> Row (Either Error (Maybe Status))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (Either Error (Maybe Status))
-> Row (Maybe (Either Error (Maybe Status)))
forall a. Value a -> Row (Maybe a)
nullableColumn Value (Either Error (Maybe Status))
decodeGucStatus)

type ProcResults = (Maybe Int64, Int64, ByteString, Either Error [GucHeader], Either Error (Maybe Status))

callProcStatement :: Bool -> Bool -> H.Snippet -> H.Snippet -> H.Snippet -> Bool ->
                     Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool ->
                     H.Statement () ProcResults
callProcStatement :: Bool
-> Bool
-> Snippet
-> Snippet
-> Snippet
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Text
-> PgVersion
-> Bool
-> Statement () ProcResults
callProcStatement Bool
returnsScalar Bool
returnsSingle Snippet
callProcQuery Snippet
selectQuery Snippet
countQuery Bool
countTotal Bool
asSingle Bool
asCsv Bool
multObjects Maybe Text
binaryField PgVersion
pgVer =
  Snippet -> Result ProcResults -> Bool -> Statement () ProcResults
forall result.
Snippet -> Result result -> Bool -> Statement () result
H.dynamicallyParameterized Snippet
snippet Result ProcResults
decodeProc
  where
    snippet :: Snippet
snippet =
      Snippet
"WITH " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> ByteString -> Snippet
H.sql ByteString
sourceCTEName Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
" AS (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
callProcQuery Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
") " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
      Snippet
countCTEF Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
      ByteString -> Snippet
H.sql (
      ByteString
"SELECT " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
        ByteString
countResultF ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS total_result_set, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
        ByteString
"pg_catalog.count(_postgrest_t) AS page_total, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
        ByteString
bodyF ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS body, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
        PgVersion -> ByteString
responseHeadersF PgVersion
pgVer ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS response_headers, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
        PgVersion -> ByteString
responseStatusF PgVersion
pgVer ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" AS response_status ") Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<>
      Snippet
"FROM (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
selectQuery Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
") _postgrest_t"

    (Snippet
countCTEF, ByteString
countResultF) = Snippet -> Bool -> (Snippet, ByteString)
countF Snippet
countQuery Bool
countTotal

    bodyF :: ByteString
bodyF
     | Bool
asSingle           = Bool -> ByteString
asJsonSingleF Bool
returnsScalar
     | Bool
asCsv              = ByteString
asCsvF
     | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
binaryField = Text -> ByteString
asBinaryF (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
binaryField
     | Bool
returnsSingle
       Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
multObjects = Bool -> ByteString
asJsonSingleF Bool
returnsScalar
     | Bool
otherwise          = Bool -> ByteString
asJsonF Bool
returnsScalar

    decodeProc :: HD.Result ProcResults
    decodeProc :: Result ProcResults
decodeProc =
      ProcResults -> Maybe ProcResults -> ProcResults
forall a. a -> Maybe a -> a
fromMaybe (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
0, Int64
0, ByteString
forall a. Monoid a => a
mempty, Either Error [GucHeader]
forall a a. Either a [a]
defGucHeaders, Either Error (Maybe Status)
forall a a. Either a (Maybe a)
defGucStatus) (Maybe ProcResults -> ProcResults)
-> Result (Maybe ProcResults) -> Result ProcResults
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row ProcResults -> Result (Maybe ProcResults)
forall a. Row a -> Result (Maybe a)
HD.rowMaybe Row ProcResults
procRow
      where
        defGucHeaders :: Either a [a]
defGucHeaders = [a] -> Either a [a]
forall a b. b -> Either a b
Right []
        defGucStatus :: Either a (Maybe a)
defGucStatus  = Maybe a -> Either a (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
        procRow :: Row ProcResults
procRow = (,,,,) (Maybe Int64
 -> Int64
 -> ByteString
 -> Either Error [GucHeader]
 -> Either Error (Maybe Status)
 -> ProcResults)
-> Row (Maybe Int64)
-> Row
     (Int64
      -> ByteString
      -> Either Error [GucHeader]
      -> Either Error (Maybe Status)
      -> ProcResults)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Int64 -> Row (Maybe Int64)
forall a. Value a -> Row (Maybe a)
nullableColumn Value Int64
HD.int8 Row
  (Int64
   -> ByteString
   -> Either Error [GucHeader]
   -> Either Error (Maybe Status)
   -> ProcResults)
-> Row Int64
-> Row
     (ByteString
      -> Either Error [GucHeader]
      -> Either Error (Maybe Status)
      -> ProcResults)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Int64 -> Row Int64
forall a. Value a -> Row a
column Value Int64
HD.int8
                         Row
  (ByteString
   -> Either Error [GucHeader]
   -> Either Error (Maybe Status)
   -> ProcResults)
-> Row ByteString
-> Row
     (Either Error [GucHeader]
      -> Either Error (Maybe Status) -> ProcResults)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value ByteString -> Row ByteString
forall a. Value a -> Row a
column Value ByteString
HD.bytea
                         Row
  (Either Error [GucHeader]
   -> Either Error (Maybe Status) -> ProcResults)
-> Row (Either Error [GucHeader])
-> Row (Either Error (Maybe Status) -> ProcResults)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Either Error [GucHeader]
-> Maybe (Either Error [GucHeader]) -> Either Error [GucHeader]
forall a. a -> Maybe a -> a
fromMaybe Either Error [GucHeader]
forall a a. Either a [a]
defGucHeaders (Maybe (Either Error [GucHeader]) -> Either Error [GucHeader])
-> Row (Maybe (Either Error [GucHeader]))
-> Row (Either Error [GucHeader])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (Either Error [GucHeader])
-> Row (Maybe (Either Error [GucHeader]))
forall a. Value a -> Row (Maybe a)
nullableColumn Value (Either Error [GucHeader])
decodeGucHeaders)
                         Row (Either Error (Maybe Status) -> ProcResults)
-> Row (Either Error (Maybe Status)) -> Row ProcResults
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Either Error (Maybe Status)
-> Maybe (Either Error (Maybe Status))
-> Either Error (Maybe Status)
forall a. a -> Maybe a -> a
fromMaybe Either Error (Maybe Status)
forall a a. Either a (Maybe a)
defGucStatus (Maybe (Either Error (Maybe Status))
 -> Either Error (Maybe Status))
-> Row (Maybe (Either Error (Maybe Status)))
-> Row (Either Error (Maybe Status))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (Either Error (Maybe Status))
-> Row (Maybe (Either Error (Maybe Status)))
forall a. Value a -> Row (Maybe a)
nullableColumn Value (Either Error (Maybe Status))
decodeGucStatus)

createExplainStatement :: H.Snippet -> Bool -> H.Statement () (Maybe Int64)
createExplainStatement :: Snippet -> Bool -> Statement () (Maybe Int64)
createExplainStatement Snippet
countQuery =
  Snippet
-> Result (Maybe Int64) -> Bool -> Statement () (Maybe Int64)
forall result.
Snippet -> Result result -> Bool -> Statement () result
H.dynamicallyParameterized Snippet
snippet Result (Maybe Int64)
decodeExplain
  where
    snippet :: Snippet
snippet = Snippet
"EXPLAIN (FORMAT JSON) " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
countQuery
    -- |
    -- An `EXPLAIN (FORMAT JSON) select * from items;` output looks like this:
    -- [{
    --   "Plan": {
    --     "Node Type": "Seq Scan", "Parallel Aware": false, "Relation Name": "items",
    --     "Alias": "items", "Startup Cost": 0.00, "Total Cost": 32.60,
    --     "Plan Rows": 2260,"Plan Width": 8} }]
    -- We only obtain the Plan Rows here.
    decodeExplain :: HD.Result (Maybe Int64)
    decodeExplain :: Result (Maybe Int64)
decodeExplain =
      let row :: Result ByteString
row = Row ByteString -> Result ByteString
forall a. Row a -> Result a
HD.singleRow (Row ByteString -> Result ByteString)
-> Row ByteString -> Result ByteString
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Row ByteString
forall a. Value a -> Row a
column Value ByteString
HD.bytea in
      (ByteString -> Getting (First Int64) ByteString Int64 -> Maybe Int64
forall s a. s -> Getting (First a) s a -> Maybe a
^? Int -> Traversal' ByteString Value
forall t. AsValue t => Int -> Traversal' t Value
L.nth Int
0 ((Value -> Const (First Int64) Value)
 -> ByteString -> Const (First Int64) ByteString)
-> ((Int64 -> Const (First Int64) Int64)
    -> Value -> Const (First Int64) Value)
-> Getting (First Int64) ByteString Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
L.key Text
"Plan" ((Value -> Const (First Int64) Value)
 -> Value -> Const (First Int64) Value)
-> ((Int64 -> Const (First Int64) Int64)
    -> Value -> Const (First Int64) Value)
-> (Int64 -> Const (First Int64) Int64)
-> Value
-> Const (First Int64) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
L.key Text
"Plan Rows" ((Value -> Const (First Int64) Value)
 -> Value -> Const (First Int64) Value)
-> ((Int64 -> Const (First Int64) Int64)
    -> Value -> Const (First Int64) Value)
-> (Int64 -> Const (First Int64) Int64)
-> Value
-> Const (First Int64) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Const (First Int64) Int64)
-> Value -> Const (First Int64) Value
forall t a. (AsNumber t, Integral a) => Prism' t a
L._Integral) (ByteString -> Maybe Int64)
-> Result ByteString -> Result (Maybe Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result ByteString
row

decodeGucHeaders :: HD.Value (Either Error [GucHeader])
decodeGucHeaders :: Value (Either Error [GucHeader])
decodeGucHeaders = (String -> Error)
-> Either String [GucHeader] -> Either Error [GucHeader]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Error -> String -> Error
forall a b. a -> b -> a
const Error
GucHeadersError) (Either String [GucHeader] -> Either Error [GucHeader])
-> (ByteString -> Either String [GucHeader])
-> ByteString
-> Either Error [GucHeader]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String [GucHeader]
forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecode (ByteString -> Either String [GucHeader])
-> (ByteString -> ByteString)
-> ByteString
-> Either String [GucHeader]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a b. StringConv a b => a -> b
toS (ByteString -> Either Error [GucHeader])
-> Value ByteString -> Value (Either Error [GucHeader])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value ByteString
HD.bytea

decodeGucStatus :: HD.Value (Either Error (Maybe Status))
decodeGucStatus :: Value (Either Error (Maybe Status))
decodeGucStatus = (String -> Error)
-> Either String (Maybe Status) -> Either Error (Maybe Status)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Error -> String -> Error
forall a b. a -> b -> a
const Error
GucStatusError) (Either String (Maybe Status) -> Either Error (Maybe Status))
-> (Text -> Either String (Maybe Status))
-> Text
-> Either Error (Maybe Status)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Text) -> Maybe Status)
-> Either String (Int, Text) -> Either String (Maybe Status)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Status -> Maybe Status
forall a. a -> Maybe a
Just (Status -> Maybe Status)
-> ((Int, Text) -> Status) -> (Int, Text) -> Maybe Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Status
forall a. Enum a => Int -> a
toEnum (Int -> Status) -> ((Int, Text) -> Int) -> (Int, Text) -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Int
forall a b. (a, b) -> a
fst) (Either String (Int, Text) -> Either String (Maybe Status))
-> (Text -> Either String (Int, Text))
-> Text
-> Either String (Maybe Status)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Int, Text)
forall a. Integral a => Reader a
decimal (Text -> Either Error (Maybe Status))
-> Value Text -> Value (Either Error (Maybe Status))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Text
HD.text

column :: HD.Value a -> HD.Row a
column :: Value a -> Row a
column = NullableOrNot Value a -> Row a
forall a. NullableOrNot Value a -> Row a
HD.column (NullableOrNot Value a -> Row a)
-> (Value a -> NullableOrNot Value a) -> Value a -> Row a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> NullableOrNot Value a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
HD.nonNullable

nullableColumn :: HD.Value a -> HD.Row (Maybe a)
nullableColumn :: Value a -> Row (Maybe a)
nullableColumn = NullableOrNot Value (Maybe a) -> Row (Maybe a)
forall a. NullableOrNot Value a -> Row a
HD.column (NullableOrNot Value (Maybe a) -> Row (Maybe a))
-> (Value a -> NullableOrNot Value (Maybe a))
-> Value a
-> Row (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> NullableOrNot Value (Maybe a)
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
HD.nullable

arrayColumn :: HD.Value a -> HD.Row [a]
arrayColumn :: Value a -> Row [a]
arrayColumn = Value [a] -> Row [a]
forall a. Value a -> Row a
column (Value [a] -> Row [a])
-> (Value a -> Value [a]) -> Value a -> Row [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NullableOrNot Value a -> Value [a]
forall element. NullableOrNot Value element -> Value [element]
HD.listArray (NullableOrNot Value a -> Value [a])
-> (Value a -> NullableOrNot Value a) -> Value a -> Value [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> NullableOrNot Value a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
HD.nonNullable