module Hasql.Comms.Send where

import Hasql.Platform.Prelude
import Hasql.Pq qualified as Pq

data Result context
  = Ok
  | Error context (Maybe ByteString)
  deriving stock (Result context -> Result context -> Bool
(Result context -> Result context -> Bool)
-> (Result context -> Result context -> Bool)
-> Eq (Result context)
forall context.
Eq context =>
Result context -> Result context -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall context.
Eq context =>
Result context -> Result context -> Bool
== :: Result context -> Result context -> Bool
$c/= :: forall context.
Eq context =>
Result context -> Result context -> Bool
/= :: Result context -> Result context -> Bool
Eq, Int -> Result context -> ShowS
[Result context] -> ShowS
Result context -> String
(Int -> Result context -> ShowS)
-> (Result context -> String)
-> ([Result context] -> ShowS)
-> Show (Result context)
forall context. Show context => Int -> Result context -> ShowS
forall context. Show context => [Result context] -> ShowS
forall context. Show context => Result context -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall context. Show context => Int -> Result context -> ShowS
showsPrec :: Int -> Result context -> ShowS
$cshow :: forall context. Show context => Result context -> String
show :: Result context -> String
$cshowList :: forall context. Show context => [Result context] -> ShowS
showList :: [Result context] -> ShowS
Show, (forall a b. (a -> b) -> Result a -> Result b)
-> (forall a b. a -> Result b -> Result a) -> Functor Result
forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
fmap :: forall a b. (a -> b) -> Result a -> Result b
$c<$ :: forall a b. a -> Result b -> Result a
<$ :: forall a b. a -> Result b -> Result a
Functor)

newtype Send context
  = Send (Pq.Connection -> IO (Result context))
  deriving stock ((forall a b. (a -> b) -> Send a -> Send b)
-> (forall a b. a -> Send b -> Send a) -> Functor Send
forall a b. a -> Send b -> Send a
forall a b. (a -> b) -> Send a -> Send b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Send a -> Send b
fmap :: forall a b. (a -> b) -> Send a -> Send b
$c<$ :: forall a b. a -> Send b -> Send a
<$ :: forall a b. a -> Send b -> Send a
Functor)

instance Semigroup (Send context) where
  {-# INLINE (<>) #-}
  Send Connection -> IO (Result context)
send1 <> :: Send context -> Send context -> Send context
<> Send Connection -> IO (Result context)
send2 = (Connection -> IO (Result context)) -> Send context
forall context. (Connection -> IO (Result context)) -> Send context
Send \Connection
cs -> do
    Result context
result <- Connection -> IO (Result context)
send1 Connection
cs
    case Result context
result of
      Error context
context Maybe ByteString
details -> Result context -> IO (Result context)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (context -> Maybe ByteString -> Result context
forall context. context -> Maybe ByteString -> Result context
Error context
context Maybe ByteString
details)
      Result context
Ok -> do
        Result context
result2 <- Connection -> IO (Result context)
send2 Connection
cs
        pure Result context
result2

instance Monoid (Send context) where
  {-# INLINE mempty #-}
  mempty :: Send context
mempty = (Connection -> IO (Result context)) -> Send context
forall context. (Connection -> IO (Result context)) -> Send context
Send \Connection
_ -> Result context -> IO (Result context)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result context
forall context. Result context
Ok

toHandler :: Send context -> Pq.Connection -> IO (Result context)
toHandler :: forall context. Send context -> Connection -> IO (Result context)
toHandler (Send Connection -> IO (Result context)
send) = Connection -> IO (Result context)
send

liftPqSend :: context -> (Pq.Connection -> IO Bool) -> Send context
liftPqSend :: forall context. context -> (Connection -> IO Bool) -> Send context
liftPqSend context
context Connection -> IO Bool
pqSend = (Connection -> IO (Result context)) -> Send context
forall context. (Connection -> IO (Result context)) -> Send context
Send \Connection
connection -> do
  Bool
success <- Connection -> IO Bool
pqSend Connection
connection
  if Bool
success
    then Result context -> IO (Result context)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result context
forall context. Result context
Ok
    else do
      Maybe ByteString
errorMessage <- Connection -> IO (Maybe ByteString)
Pq.errorMessage Connection
connection
      pure (context -> Maybe ByteString -> Result context
forall context. context -> Maybe ByteString -> Result context
Error context
context Maybe ByteString
errorMessage)

prepare :: context -> ByteString -> ByteString -> Maybe [Pq.Oid] -> Send context
prepare :: forall context.
context -> ByteString -> ByteString -> Maybe [Oid] -> Send context
prepare context
context ByteString
statementName ByteString
sql Maybe [Oid]
oidList =
  context -> (Connection -> IO Bool) -> Send context
forall context. context -> (Connection -> IO Bool) -> Send context
liftPqSend context
context \Connection
connection -> Connection -> ByteString -> ByteString -> Maybe [Oid] -> IO Bool
Pq.sendPrepare Connection
connection ByteString
statementName ByteString
sql Maybe [Oid]
oidList

query :: context -> ByteString -> Send context
query :: forall context. context -> ByteString -> Send context
query context
context ByteString
sql =
  context -> (Connection -> IO Bool) -> Send context
forall context. context -> (Connection -> IO Bool) -> Send context
liftPqSend context
context \Connection
connection -> Connection -> ByteString -> IO Bool
Pq.sendQuery Connection
connection ByteString
sql

queryPrepared :: context -> ByteString -> [Maybe (ByteString, Pq.Format)] -> Pq.Format -> Send context
queryPrepared :: forall context.
context
-> ByteString
-> [Maybe (ByteString, Format)]
-> Format
-> Send context
queryPrepared context
context ByteString
statementName [Maybe (ByteString, Format)]
params Format
resultFormat =
  context -> (Connection -> IO Bool) -> Send context
forall context. context -> (Connection -> IO Bool) -> Send context
liftPqSend context
context \Connection
connection -> Connection
-> ByteString -> [Maybe (ByteString, Format)] -> Format -> IO Bool
Pq.sendQueryPrepared Connection
connection ByteString
statementName [Maybe (ByteString, Format)]
params Format
resultFormat

queryParams :: context -> ByteString -> [Maybe (Pq.Oid, ByteString, Pq.Format)] -> Pq.Format -> Send context
queryParams :: forall context.
context
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> Send context
queryParams context
context ByteString
sql [Maybe (Oid, ByteString, Format)]
params Format
resultFormat =
  context -> (Connection -> IO Bool) -> Send context
forall context. context -> (Connection -> IO Bool) -> Send context
liftPqSend context
context \Connection
connection -> Connection
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> IO Bool
Pq.sendQueryParams Connection
connection ByteString
sql [Maybe (Oid, ByteString, Format)]
params Format
resultFormat

pipelineSync :: context -> Send context
pipelineSync :: forall context. context -> Send context
pipelineSync context
context =
  context -> (Connection -> IO Bool) -> Send context
forall context. context -> (Connection -> IO Bool) -> Send context
liftPqSend context
context \Connection
connection -> Connection -> IO Bool
Pq.pipelineSync Connection
connection

enterPipelineMode :: context -> Send context
enterPipelineMode :: forall context. context -> Send context
enterPipelineMode context
context =
  context -> (Connection -> IO Bool) -> Send context
forall context. context -> (Connection -> IO Bool) -> Send context
liftPqSend context
context \Connection
connection -> Connection -> IO Bool
Pq.enterPipelineMode Connection
connection

exitPipelineMode :: context -> Send context
exitPipelineMode :: forall context. context -> Send context
exitPipelineMode context
context =
  context -> (Connection -> IO Bool) -> Send context
forall context. context -> (Connection -> IO Bool) -> Send context
liftPqSend context
context \Connection
connection -> Connection -> IO Bool
Pq.exitPipelineMode Connection
connection