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 (..), resultStatus)
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)