module Hasql.Engine.Contexts.Pipeline
  ( Pipeline,
    run,
    statement,
  )
where

import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as HashSet
import Hasql.Codecs.Encoders.Params qualified as Params
import Hasql.Codecs.RequestingOid qualified as RequestingOid
import Hasql.Comms.Recv qualified as Comms.Recv
import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip
import Hasql.Engine.Decoders.Result qualified as Decoders.Result
import Hasql.Engine.Errors qualified as Errors
import Hasql.Engine.PqProcedures.SelectTypeInfo qualified as PqProcedures.SelectTypeInfo
import Hasql.Engine.Structures.OidCache qualified as OidCache
import Hasql.Engine.Structures.StatementCache qualified as StatementCache
import Hasql.Platform.Prelude
import Hasql.Pq qualified as Pq

run ::
  Pipeline a ->
  Bool ->
  Pq.Connection ->
  OidCache.OidCache ->
  StatementCache.StatementCache ->
  IO
    ( Either Errors.SessionError a,
      OidCache.OidCache,
      StatementCache.StatementCache
    )
run :: forall a.
Pipeline a
-> Bool
-> Connection
-> OidCache
-> StatementCache
-> IO (Either SessionError a, OidCache, StatementCache)
run (Pipeline Int
totalStatements HashSet (Maybe Text, Text)
unknownTypes Int
-> Bool
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> StatementCache
-> (Roundtrip Context a, StatementCache)
runPipeline) Bool
usePreparedStatements Connection
connection OidCache
oidCache StatementCache
statementCache = do
  let missingTypes :: HashSet (Maybe Text, Text)
missingTypes = HashSet (Maybe Text, Text)
-> OidCache -> HashSet (Maybe Text, Text)
OidCache.selectUnknownNames HashSet (Maybe Text, Text)
unknownTypes OidCache
oidCache
  Either SessionError (HashMap (Maybe Text, Text) (Word32, Word32))
oidCacheUpdates <- Connection
-> SelectTypeInfo
-> IO
     (Either SessionError (HashMap (Maybe Text, Text) (Word32, Word32)))
PqProcedures.SelectTypeInfo.run Connection
connection (HashSet (Maybe Text, Text) -> SelectTypeInfo
PqProcedures.SelectTypeInfo.SelectTypeInfo HashSet (Maybe Text, Text)
missingTypes)
  case Either SessionError (HashMap (Maybe Text, Text) (Word32, Word32))
oidCacheUpdates of
    Left SessionError
err -> (Either SessionError a, OidCache, StatementCache)
-> IO (Either SessionError a, OidCache, StatementCache)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SessionError -> Either SessionError a
forall a b. a -> Either a b
Left SessionError
err, OidCache
oidCache, StatementCache
statementCache)
    Right HashMap (Maybe Text, Text) (Word32, Word32)
oidCacheUpdates -> do
      -- Validate that all requested types were found
      let foundTypes :: HashSet (Maybe Text, Text)
foundTypes = HashMap (Maybe Text, Text) (Word32, Word32)
-> HashSet (Maybe Text, Text)
forall k a. HashMap k a -> HashSet k
HashMap.keysSet HashMap (Maybe Text, Text) (Word32, Word32)
oidCacheUpdates
          notFoundTypes :: HashSet (Maybe Text, Text)
notFoundTypes = HashSet (Maybe Text, Text)
-> HashSet (Maybe Text, Text) -> HashSet (Maybe Text, Text)
forall a. Hashable a => HashSet a -> HashSet a -> HashSet a
HashSet.difference HashSet (Maybe Text, Text)
missingTypes HashSet (Maybe Text, Text)
foundTypes
      if Bool -> Bool
not (HashSet (Maybe Text, Text) -> Bool
forall a. HashSet a -> Bool
HashSet.null HashSet (Maybe Text, Text)
notFoundTypes)
        then (Either SessionError a, OidCache, StatementCache)
-> IO (Either SessionError a, OidCache, StatementCache)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SessionError -> Either SessionError a
forall a b. a -> Either a b
Left (HashSet (Maybe Text, Text) -> SessionError
Errors.MissingTypesSessionError HashSet (Maybe Text, Text)
notFoundTypes), OidCache
oidCache, StatementCache
statementCache)
        else do
          let newOidCache :: OidCache
newOidCache = OidCache
oidCache OidCache -> OidCache -> OidCache
forall a. Semigroup a => a -> a -> a
<> HashMap (Maybe Text, Text) (Word32, Word32) -> OidCache
OidCache.fromHashMap HashMap (Maybe Text, Text) (Word32, Word32)
oidCacheUpdates
              (Roundtrip Context a
roundtrip, StatementCache
newStatementCache) =
                Int
-> Bool
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> StatementCache
-> (Roundtrip Context a, StatementCache)
runPipeline Int
0 Bool
usePreparedStatements (OidCache -> HashMap (Maybe Text, Text) (Word32, Word32)
OidCache.toHashMap OidCache
newOidCache) StatementCache
statementCache
              contextualRoundtrip :: Roundtrip (Maybe Context) a
contextualRoundtrip = (Context -> Maybe Context)
-> Roundtrip Context a -> Roundtrip (Maybe Context) a
forall a b c. (a -> b) -> Roundtrip a c -> Roundtrip b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Context -> Maybe Context
forall a. a -> Maybe a
Just Roundtrip Context a
roundtrip

          Either (Error (Maybe Context)) a
executionResult <- Roundtrip (Maybe Context) a
-> Maybe Context
-> Connection
-> IO (Either (Error (Maybe Context)) a)
forall context a.
Roundtrip context a
-> context -> Connection -> IO (Either (Error context) a)
Comms.Roundtrip.toPipelineIO Roundtrip (Maybe Context) a
contextualRoundtrip Maybe Context
forall a. Maybe a
Nothing Connection
connection

          let result :: Either SessionError a
result =
                (Error (Maybe Context) -> SessionError)
-> Either (Error (Maybe Context)) a -> Either SessionError a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
                  ( \case
                      Comms.Roundtrip.ClientError Maybe Context
_context Maybe ByteString
details ->
                        Text -> SessionError
Errors.ConnectionSessionError (Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ByteString -> Text
decodeUtf8Lenient Maybe ByteString
details)
                      Comms.Roundtrip.ServerError Error (Maybe Context)
recvError ->
                        Error (Maybe (Int, Int, ByteString, [Text], Bool)) -> SessionError
Errors.fromRecvError ((Maybe Context -> Maybe (Int, Int, ByteString, [Text], Bool))
-> Error (Maybe Context)
-> Error (Maybe (Int, Int, ByteString, [Text], Bool))
forall a b. (a -> b) -> Error a -> Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Context -> (Int, Int, ByteString, [Text], Bool))
-> Maybe Context -> Maybe (Int, Int, ByteString, [Text], Bool)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Context Int
index ByteString
sql [Text]
params Bool
prepared StatementCache
_) -> (Int
totalStatements, Int
index, ByteString
sql, [Text]
params, Bool
prepared))) Error (Maybe Context)
recvError)
                  )
                  Either (Error (Maybe Context)) a
executionResult
              finalStatementCache :: StatementCache
finalStatementCache =
                case Either (Error (Maybe Context)) a
executionResult of
                  Right a
_ -> StatementCache
newStatementCache
                  Left Error (Maybe Context)
executionError ->
                    StatementCache
-> (Context -> StatementCache) -> Maybe Context -> StatementCache
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                      StatementCache
statementCache
                      (\(Context Int
_ ByteString
_ [Text]
_ Bool
_ StatementCache
statementCache) -> StatementCache
statementCache)
                      (Error (Maybe Context) -> Maybe Context
forall a. Error a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Error (Maybe Context)
executionError)

          (Either SessionError a, OidCache, StatementCache)
-> IO (Either SessionError a, OidCache, StatementCache)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SessionError a
result, OidCache
newOidCache, StatementCache
finalStatementCache)

-- |
-- Composable abstraction over the execution of queries in [the pipeline mode](https://www.postgresql.org/docs/current/libpq-pipeline-mode.html).
--
-- It allows you to issue multiple queries to the server in much fewer network transactions.
-- If the amounts of sent and received data do not surpass the buffer sizes in the driver and on the server it will be just a single roundtrip.
-- Typically the buffer size is 8KB.
--
-- This execution mode is much more efficient than running queries directly from 'Hasql.Session.Session', because in session every statement execution involves a dedicated network roundtrip.
--
-- An obvious question rises then: why not execute all queries like that?
-- In situations where the parameters depend on the result of another query it is impossible to execute them in parallel, because the client needs to receive the results of one query before sending the request to execute the next.
-- This reasoning is essentially the same as the one for the difference between 'Applicative' and 'Monad'.
-- That's why 'Pipeline' does not have the 'Monad' instance.
--
-- To execute 'Pipeline' lift it into 'Hasql.Session.Session' via 'Hasql.Session.pipeline'.
--
-- == Examples
--
-- === Insert-Many or Batch-Insert
--
-- You can use pipeline to turn a single-row insert query into an efficient multi-row insertion session.
-- In effect this should be comparable in performance to issuing a single multi-row insert statement.
--
-- Given the following definition in a Statements module:
--
-- @
-- insertOrder :: 'Hasql.Statement.Statement' OrderDetails OrderId
-- @
--
-- You can lift it into the following session
--
-- @
-- insertOrders :: [OrderDetails] -> 'Hasql.Session.Session' [OrderId]
-- insertOrders orders =
--   'Hasql.Session.pipeline' $
--     for orders $ \order ->
--       'Hasql.Pipeline.statement' order Statements.insertOrder
-- @
--
-- === Combining Queries
--
-- Given the following definitions in a Statements module:
--
-- @
-- selectOrderDetails :: 'Hasql.Statement.Statement' OrderId (Maybe OrderDetails)
-- selectOrderProducts :: 'Hasql.Statement.Statement' OrderId [OrderProduct]
-- selectOrderFinancialTransactions :: 'Hasql.Statement.Statement' OrderId [FinancialTransaction]
-- @
--
-- You can combine them into a session using the `ApplicativeDo` extension as follows:
--
-- @
-- selectEverythingAboutOrder :: OrderId -> 'Hasql.Session.Session' (Maybe OrderDetails, [OrderProduct], [FinancialTransaction])
-- selectEverythingAboutOrder orderId =
--   'Hasql.Session.pipeline' $ do
--     details <- 'Hasql.Pipeline.statement' orderId Statements.selectOrderDetails
--     products <- 'Hasql.Pipeline.statement' orderId Statements.selectOrderProducts
--     transactions <- 'Hasql.Pipeline.statement' orderId Statements.selectOrderFinancialTransactions
--     pure (details, products, transactions)
-- @
data Pipeline a
  = Pipeline
      -- | Amount of statements in this pipeline.
      Int
      -- | Names of types that are used in this pipeline.
      --
      -- They will be used to pre-resolve type OIDs before running the pipeline providing them in OidCache.
      -- It can be assumed in the execution function that these types are always present in the cache.
      -- To achieve that property we will be validating the presence of all requested types in the database or failing before running the pipeline.
      -- In the execution function we will be defaulting to 'Pq.Oid 0' for unknown types as a fallback in case of bugs.
      (HashSet (Maybe Text, Text))
      -- | Function that runs the pipeline.
      --
      -- The integer parameter indicates the current offset of the statement in the pipeline (0-based).
      --
      -- The boolean parameter indicates whether preparable statements should be prepared.
      --
      -- OidCache is provided in which the names of types used in this pipeline are already resolved.
      --
      -- The function takes the current statement cache and returns a tuple of:
      -- 1. The actual roundtrip action to be executed in the pipeline.
      -- 2. The updated statement cache after composing this part of the pipeline.
      --
      -- The resulting cache is optimistic: on failure we recover the last known
      -- committed cache from statement contexts carried by roundtrip errors.
      ( Int ->
        Bool ->
        HashMap (Maybe Text, Text) (Word32, Word32) ->
        StatementCache.StatementCache ->
        (Comms.Roundtrip.Roundtrip Context a, StatementCache.StatementCache)
      )

data Context
  = Context
      -- | Offset of the statement in the pipeline (0-based).
      Int
      -- | SQL.
      ByteString
      -- | Parameters in a human-readable form.
      [Text]
      -- | Whether the statement is prepared.
      Bool
      -- | The so far successfully updated statement cache.
      StatementCache.StatementCache
  deriving stock (Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Context -> ShowS
showsPrec :: Int -> Context -> ShowS
$cshow :: Context -> String
show :: Context -> String
$cshowList :: [Context] -> ShowS
showList :: [Context] -> ShowS
Show, Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
/= :: Context -> Context -> Bool
Eq)

-- * Instances

instance Functor Pipeline where
  fmap :: forall a b. (a -> b) -> Pipeline a -> Pipeline b
fmap a -> b
f (Pipeline Int
count HashSet (Maybe Text, Text)
unknownTypes Int
-> Bool
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> StatementCache
-> (Roundtrip Context a, StatementCache)
run) = Int
-> HashSet (Maybe Text, Text)
-> (Int
    -> Bool
    -> HashMap (Maybe Text, Text) (Word32, Word32)
    -> StatementCache
    -> (Roundtrip Context b, StatementCache))
-> Pipeline b
forall a.
Int
-> HashSet (Maybe Text, Text)
-> (Int
    -> Bool
    -> HashMap (Maybe Text, Text) (Word32, Word32)
    -> StatementCache
    -> (Roundtrip Context a, StatementCache))
-> Pipeline a
Pipeline Int
count HashSet (Maybe Text, Text)
unknownTypes \Int
offset Bool
usePreparedStatements HashMap (Maybe Text, Text) (Word32, Word32)
oidCache StatementCache
cache ->
    let (Roundtrip Context a
roundtrip, StatementCache
newStatementCache) = Int
-> Bool
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> StatementCache
-> (Roundtrip Context a, StatementCache)
run Int
offset Bool
usePreparedStatements HashMap (Maybe Text, Text) (Word32, Word32)
oidCache StatementCache
cache
     in ((a -> b) -> Roundtrip Context a -> Roundtrip Context b
forall a b. (a -> b) -> Roundtrip Context a -> Roundtrip Context b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Roundtrip Context a
roundtrip, StatementCache
newStatementCache)

instance Applicative Pipeline where
  pure :: forall a. a -> Pipeline a
pure a
a =
    Int
-> HashSet (Maybe Text, Text)
-> (Int
    -> Bool
    -> HashMap (Maybe Text, Text) (Word32, Word32)
    -> StatementCache
    -> (Roundtrip Context a, StatementCache))
-> Pipeline a
forall a.
Int
-> HashSet (Maybe Text, Text)
-> (Int
    -> Bool
    -> HashMap (Maybe Text, Text) (Word32, Word32)
    -> StatementCache
    -> (Roundtrip Context a, StatementCache))
-> Pipeline a
Pipeline Int
0 HashSet (Maybe Text, Text)
forall a. Monoid a => a
mempty (\Int
_ Bool
_ HashMap (Maybe Text, Text) (Word32, Word32)
_ StatementCache
cache -> (a -> Roundtrip Context a
forall a. a -> Roundtrip Context a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a, StatementCache
cache))

  Pipeline Int
lCount HashSet (Maybe Text, Text)
leftUnknownTypes Int
-> Bool
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> StatementCache
-> (Roundtrip Context (a -> b), StatementCache)
lRun <*> :: forall a b. Pipeline (a -> b) -> Pipeline a -> Pipeline b
<*> Pipeline Int
rCount HashSet (Maybe Text, Text)
rightUnknownTypes Int
-> Bool
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> StatementCache
-> (Roundtrip Context a, StatementCache)
rRun =
    let unknownTypes :: HashSet (Maybe Text, Text)
unknownTypes = HashSet (Maybe Text, Text)
leftUnknownTypes HashSet (Maybe Text, Text)
-> HashSet (Maybe Text, Text) -> HashSet (Maybe Text, Text)
forall a. Semigroup a => a -> a -> a
<> HashSet (Maybe Text, Text)
rightUnknownTypes
     in Int
-> HashSet (Maybe Text, Text)
-> (Int
    -> Bool
    -> HashMap (Maybe Text, Text) (Word32, Word32)
    -> StatementCache
    -> (Roundtrip Context b, StatementCache))
-> Pipeline b
forall a.
Int
-> HashSet (Maybe Text, Text)
-> (Int
    -> Bool
    -> HashMap (Maybe Text, Text) (Word32, Word32)
    -> StatementCache
    -> (Roundtrip Context a, StatementCache))
-> Pipeline a
Pipeline (Int
lCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rCount) HashSet (Maybe Text, Text)
unknownTypes \Int
offset Bool
usePreparedStatements HashMap (Maybe Text, Text) (Word32, Word32)
oidCache StatementCache
statementCache ->
          let (Roundtrip Context (a -> b)
lRoundtrip, StatementCache
statementCache1) = Int
-> Bool
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> StatementCache
-> (Roundtrip Context (a -> b), StatementCache)
lRun Int
offset Bool
usePreparedStatements HashMap (Maybe Text, Text) (Word32, Word32)
oidCache StatementCache
statementCache
              offset1 :: Int
offset1 = Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lCount
              (Roundtrip Context a
rRoundtrip, StatementCache
statementCache2) = Int
-> Bool
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> StatementCache
-> (Roundtrip Context a, StatementCache)
rRun Int
offset1 Bool
usePreparedStatements HashMap (Maybe Text, Text) (Word32, Word32)
oidCache StatementCache
statementCache1
           in (Roundtrip Context (a -> b)
lRoundtrip Roundtrip Context (a -> b)
-> Roundtrip Context a -> Roundtrip Context b
forall a b.
Roundtrip Context (a -> b)
-> Roundtrip Context a -> Roundtrip Context b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Roundtrip Context a
rRoundtrip, StatementCache
statementCache2)

-- * Construction

-- |
-- Execute a statement in pipelining mode.
statement ::
  ByteString ->
  Params.Params params ->
  Decoders.Result.Result result ->
  Bool ->
  params ->
  Pipeline result
statement :: forall params result.
ByteString
-> Params params
-> Result result
-> Bool
-> params
-> Pipeline result
statement ByteString
sql Params params
encoder (Result result -> RequestingOid (ResultDecoder result)
forall a. Result a -> RequestingOid (ResultDecoder a)
Decoders.Result.unwrap -> RequestingOid (ResultDecoder result)
decoder) Bool
preparable params
params =
  Int
-> HashSet (Maybe Text, Text)
-> (Int
    -> Bool
    -> HashMap (Maybe Text, Text) (Word32, Word32)
    -> StatementCache
    -> (Roundtrip Context result, StatementCache))
-> Pipeline result
forall a.
Int
-> HashSet (Maybe Text, Text)
-> (Int
    -> Bool
    -> HashMap (Maybe Text, Text) (Word32, Word32)
    -> StatementCache
    -> (Roundtrip Context a, StatementCache))
-> Pipeline a
Pipeline Int
1 HashSet (Maybe Text, Text)
unknownTypes Int
-> Bool
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> StatementCache
-> (Roundtrip Context result, StatementCache)
run
  where
    unknownTypes :: HashSet (Maybe Text, Text)
unknownTypes =
      Params params -> HashSet (Maybe Text, Text)
forall a. Params a -> HashSet (Maybe Text, Text)
Params.toUnknownTypes Params params
encoder
        HashSet (Maybe Text, Text)
-> HashSet (Maybe Text, Text) -> HashSet (Maybe Text, Text)
forall a. Semigroup a => a -> a -> a
<> RequestingOid (ResultDecoder result) -> HashSet (Maybe Text, Text)
forall a. RequestingOid a -> HashSet (Maybe Text, Text)
RequestingOid.toUnknownTypes RequestingOid (ResultDecoder result)
decoder
    run :: Int
-> Bool
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> StatementCache
-> (Roundtrip Context result, StatementCache)
run Int
offset Bool
usePreparedStatements HashMap (Maybe Text, Text) (Word32, Word32)
oidCache =
      if Bool
prepare
        then StatementCache -> (Roundtrip Context result, StatementCache)
runPrepared
        else StatementCache -> (Roundtrip Context result, StatementCache)
runUnprepared
      where
        ([Word32]
oidList, [Maybe (ByteString, Bool)]
valueAndFormatList) =
          Params params
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> params
-> ([Word32], [Maybe (ByteString, Bool)])
forall a.
Params a
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> a
-> ([Word32], [Maybe (ByteString, Bool)])
Params.compilePreparedStatementData Params params
encoder HashMap (Maybe Text, Text) (Word32, Word32)
oidCache params
params

        pqOidList :: [Oid]
pqOidList =
          (Word32 -> Oid) -> [Word32] -> [Oid]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CUInt -> Oid
Pq.Oid (CUInt -> Oid) -> (Word32 -> CUInt) -> Word32 -> Oid
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Word32]
oidList

        prepare :: Bool
prepare =
          Bool
usePreparedStatements Bool -> Bool -> Bool
&& Bool
preparable

        context :: StatementCache -> Context
context StatementCache
soFarStatementCache =
          Int -> ByteString -> [Text] -> Bool -> StatementCache -> Context
Context
            Int
offset
            ByteString
sql
            (Params params -> params -> [Text]
forall a. Params a -> a -> [Text]
Params.renderReadable Params params
encoder params
params)
            Bool
prepare
            StatementCache
soFarStatementCache

        runPrepared :: StatementCache -> (Roundtrip Context result, StatementCache)
runPrepared StatementCache
statementCache =
          (Roundtrip Context result
roundtrip, StatementCache
newStatementCache)
          where
            (Bool
isNew, ByteString
remoteKey, StatementCache
newStatementCache) =
              case ByteString -> [Oid] -> StatementCache -> Maybe ByteString
StatementCache.lookup ByteString
sql [Oid]
pqOidList StatementCache
statementCache of
                Just ByteString
remoteKey -> (Bool
False, ByteString
remoteKey, StatementCache
statementCache)
                Maybe ByteString
Nothing ->
                  let (ByteString
remoteKey, StatementCache
newStatementCache) = ByteString
-> [Oid] -> StatementCache -> (ByteString, StatementCache)
StatementCache.insert ByteString
sql [Oid]
pqOidList StatementCache
statementCache
                   in (Bool
True, ByteString
remoteKey, StatementCache
newStatementCache)

            roundtrip :: Roundtrip Context result
roundtrip =
              Bool -> Roundtrip Context () -> Roundtrip Context ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
                Bool
isNew
                (Context
-> ByteString -> ByteString -> [Oid] -> Roundtrip Context ()
forall context.
context
-> ByteString -> ByteString -> [Oid] -> Roundtrip context ()
Comms.Roundtrip.prepare (StatementCache -> Context
context StatementCache
statementCache) ByteString
remoteKey ByteString
sql [Oid]
pqOidList)
                Roundtrip Context ()
-> Roundtrip Context result -> Roundtrip Context result
forall a b.
Roundtrip Context a -> Roundtrip Context b -> Roundtrip Context b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Context
-> ByteString
-> [Maybe (ByteString, Format)]
-> Format
-> ResultDecoder result
-> Roundtrip Context result
forall context a.
context
-> ByteString
-> [Maybe (ByteString, Format)]
-> Format
-> ResultDecoder a
-> Roundtrip context a
Comms.Roundtrip.queryPrepared (StatementCache -> Context
context StatementCache
newStatementCache) ByteString
remoteKey [Maybe (ByteString, Format)]
encodedParams Format
Pq.Binary ResultDecoder result
decoder'
              where
                encodedParams :: [Maybe (ByteString, Format)]
encodedParams =
                  [Maybe (ByteString, Bool)]
valueAndFormatList
                    [Maybe (ByteString, Bool)]
-> ([Maybe (ByteString, Bool)] -> [Maybe (ByteString, Format)])
-> [Maybe (ByteString, Format)]
forall a b. a -> (a -> b) -> b
& (Maybe (ByteString, Bool) -> Maybe (ByteString, Format))
-> [Maybe (ByteString, Bool)] -> [Maybe (ByteString, Format)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((ByteString, Bool) -> (ByteString, Format))
-> Maybe (ByteString, Bool) -> Maybe (ByteString, Format)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ByteString
bytes, Bool
format) -> (ByteString
bytes, Format -> Format -> Bool -> Format
forall a. a -> a -> Bool -> a
bool Format
Pq.Binary Format
Pq.Text Bool
format)))

        runUnprepared :: StatementCache -> (Roundtrip Context result, StatementCache)
runUnprepared StatementCache
statementCache =
          (Roundtrip Context result
roundtrip, StatementCache
statementCache)
          where
            roundtrip :: Roundtrip Context result
roundtrip =
              Context
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> ResultDecoder result
-> Roundtrip Context result
forall context a.
context
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> ResultDecoder a
-> Roundtrip context a
Comms.Roundtrip.queryParams (StatementCache -> Context
context StatementCache
statementCache) ByteString
sql [Maybe (Oid, ByteString, Format)]
encodedParams Format
Pq.Binary ResultDecoder result
decoder'
              where
                encodedParams :: [Maybe (Oid, ByteString, Format)]
encodedParams =
                  params
params
                    params
-> (params -> [Maybe (Word32, ByteString, Bool)])
-> [Maybe (Word32, ByteString, Bool)]
forall a b. a -> (a -> b) -> b
& Params params
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> params
-> [Maybe (Word32, ByteString, Bool)]
forall a.
Params a
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> a
-> [Maybe (Word32, ByteString, Bool)]
Params.compileUnpreparedStatementData Params params
encoder HashMap (Maybe Text, Text) (Word32, Word32)
oidCache
                    [Maybe (Word32, ByteString, Bool)]
-> ([Maybe (Word32, ByteString, Bool)]
    -> [Maybe (Oid, ByteString, Format)])
-> [Maybe (Oid, ByteString, Format)]
forall a b. a -> (a -> b) -> b
& (Maybe (Word32, ByteString, Bool)
 -> Maybe (Oid, ByteString, Format))
-> [Maybe (Word32, ByteString, Bool)]
-> [Maybe (Oid, ByteString, Format)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Word32, ByteString, Bool) -> (Oid, ByteString, Format))
-> Maybe (Word32, ByteString, Bool)
-> Maybe (Oid, ByteString, Format)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Word32
oid, ByteString
bytes, Bool
format) -> (CUInt -> Oid
Pq.Oid (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
oid), ByteString
bytes, Format -> Format -> Bool -> Format
forall a. a -> a -> Bool -> a
bool Format
Pq.Binary Format
Pq.Text Bool
format)))

        decoder' :: ResultDecoder result
decoder' =
          RequestingOid (ResultDecoder result)
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> ResultDecoder result
forall a.
RequestingOid a -> HashMap (Maybe Text, Text) (Word32, Word32) -> a
RequestingOid.toBase RequestingOid (ResultDecoder result)
decoder HashMap (Maybe Text, Text) (Word32, Word32)
oidCache