module Hasql.LibPq14
  ( module Base,

    -- * Updated and new types
    Mappings.ExecStatus (..),
    Mappings.PipelineStatus (..),

    -- * Updated and new procedures
    resultStatus,
    pipelineStatus,
    enterPipelineMode,
    exitPipelineMode,
    pipelineSync,
    sendFlushRequest,
  )
where

import Database.PostgreSQL.LibPQ as Base hiding (ExecStatus (..), PipelineStatus (..), enterPipelineMode, exitPipelineMode, pipelineStatus, pipelineSync, resultStatus, sendFlushRequest)
import Database.PostgreSQL.LibPQ.Internal qualified as BaseInternal
import Hasql.LibPq14.Ffi qualified as Ffi
import Hasql.LibPq14.Mappings qualified as Mappings
import Hasql.Prelude

resultStatus :: Result -> IO Mappings.ExecStatus
resultStatus :: Result -> IO ExecStatus
resultStatus Result
result = do
  -- Unsafe-coercing because the constructor is not exposed by the lib,
  -- but it's implemented as a newtype over ForeignPtr.
  -- Since internal changes in the \"postgresql-lipbq\" may break this,
  -- it requires us to avoid using an open dependency range on it.
  CInt
ffiStatus <- ForeignPtr () -> (Ptr () -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Result -> ForeignPtr ()
forall a b. a -> b
unsafeCoerce Result
result) Ptr () -> IO CInt
Ffi.resultStatus
  String -> (CInt -> Maybe ExecStatus) -> CInt -> IO ExecStatus
forall a b. Show a => String -> (a -> Maybe b) -> a -> IO b
decodeProcedureResult String
"resultStatus" CInt -> Maybe ExecStatus
Mappings.decodeExecStatus CInt
ffiStatus

pipelineStatus ::
  Connection ->
  IO Mappings.PipelineStatus
pipelineStatus :: Connection -> IO PipelineStatus
pipelineStatus =
  String
-> (Ptr PGconn -> IO CInt)
-> (CInt -> Maybe PipelineStatus)
-> Connection
-> IO PipelineStatus
forall a b.
Show a =>
String
-> (Ptr PGconn -> IO a) -> (a -> Maybe b) -> Connection -> IO b
parameterlessProcedure String
"pipelineStatus" Ptr PGconn -> IO CInt
Ffi.pipelineStatus CInt -> Maybe PipelineStatus
Mappings.decodePipelineStatus

enterPipelineMode ::
  Connection ->
  IO Bool
enterPipelineMode :: Connection -> IO Bool
enterPipelineMode =
  String
-> (Ptr PGconn -> IO CInt)
-> (CInt -> Maybe Bool)
-> Connection
-> IO Bool
forall a b.
Show a =>
String
-> (Ptr PGconn -> IO a) -> (a -> Maybe b) -> Connection -> IO b
parameterlessProcedure String
"enterPipelineMode" Ptr PGconn -> IO CInt
Ffi.enterPipelineMode CInt -> Maybe Bool
Mappings.decodeBool

exitPipelineMode ::
  Connection ->
  IO Bool
exitPipelineMode :: Connection -> IO Bool
exitPipelineMode =
  String
-> (Ptr PGconn -> IO CInt)
-> (CInt -> Maybe Bool)
-> Connection
-> IO Bool
forall a b.
Show a =>
String
-> (Ptr PGconn -> IO a) -> (a -> Maybe b) -> Connection -> IO b
parameterlessProcedure String
"exitPipelineMode" Ptr PGconn -> IO CInt
Ffi.exitPipelineMode CInt -> Maybe Bool
Mappings.decodeBool

pipelineSync ::
  Connection ->
  IO Bool
pipelineSync :: Connection -> IO Bool
pipelineSync =
  String
-> (Ptr PGconn -> IO CInt)
-> (CInt -> Maybe Bool)
-> Connection
-> IO Bool
forall a b.
Show a =>
String
-> (Ptr PGconn -> IO a) -> (a -> Maybe b) -> Connection -> IO b
parameterlessProcedure String
"pipelineSync" Ptr PGconn -> IO CInt
Ffi.pipelineSync CInt -> Maybe Bool
Mappings.decodeBool

sendFlushRequest ::
  Connection ->
  IO Bool
sendFlushRequest :: Connection -> IO Bool
sendFlushRequest =
  String
-> (Ptr PGconn -> IO CInt)
-> (CInt -> Maybe Bool)
-> Connection
-> IO Bool
forall a b.
Show a =>
String
-> (Ptr PGconn -> IO a) -> (a -> Maybe b) -> Connection -> IO b
parameterlessProcedure String
"sendFlushRequest" Ptr PGconn -> IO CInt
Ffi.sendFlushRequest CInt -> Maybe Bool
Mappings.decodeBool

parameterlessProcedure ::
  (Show a) =>
  String ->
  (Ptr BaseInternal.PGconn -> IO a) ->
  (a -> Maybe b) ->
  Connection ->
  IO b
parameterlessProcedure :: forall a b.
Show a =>
String
-> (Ptr PGconn -> IO a) -> (a -> Maybe b) -> Connection -> IO b
parameterlessProcedure String
label Ptr PGconn -> IO a
procedure a -> Maybe b
decoder Connection
connection = do
  a
ffiResult <- Connection -> (Ptr PGconn -> IO a) -> IO a
forall b. Connection -> (Ptr PGconn -> IO b) -> IO b
BaseInternal.withConn Connection
connection Ptr PGconn -> IO a
procedure
  String -> (a -> Maybe b) -> a -> IO b
forall a b. Show a => String -> (a -> Maybe b) -> a -> IO b
decodeProcedureResult String
label a -> Maybe b
decoder a
ffiResult

decodeProcedureResult ::
  (Show a) =>
  String ->
  (a -> Maybe b) ->
  a ->
  IO b
decodeProcedureResult :: forall a b. Show a => String -> (a -> Maybe b) -> a -> IO b
decodeProcedureResult String
label a -> Maybe b
decoder a
ffiResult =
  case a -> Maybe b
decoder a
ffiResult of
    Just b
res -> b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
res
    Maybe b
Nothing -> String -> IO b
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Failed to decode result of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
label String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" from: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
ffiResult)