{-|
Module: Squeal.PostgreSQL.Session
Description: sessions
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

Using Squeal in your application will come down to defining
the @DB :: @`SchemasType` of your database and including @PQ DB DB@ in your
application's monad transformer stack, giving it an instance of `MonadPQ` @DB@.
-}

{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# LANGUAGE
    DefaultSignatures
  , FunctionalDependencies
  , FlexibleContexts
  , FlexibleInstances
  , InstanceSigs
  , OverloadedStrings
  , PolyKinds
  , QuantifiedConstraints
  , RankNTypes
  , ScopedTypeVariables
  , TypeApplications
  , TypeFamilies
  , DataKinds
  , PolyKinds
  , TypeOperators
  , UndecidableInstances
#-}

module Squeal.PostgreSQL.Session
  ( PQ (PQ, unPQ)
  , runPQ
  , execPQ
  , evalPQ
  , withConnection
  ) where

import Control.Applicative
import Control.Category
import Control.Monad (MonadPlus(..))
import Control.Monad.Base (MonadBase(..))
import Control.Monad.Fix (MonadFix(..))
import Control.Monad.Catch
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Morph
import Control.Monad.Reader (ReaderT(..))
import Control.Monad.Trans.Control (MonadBaseControl(..), MonadTransControl(..))
import UnliftIO (MonadUnliftIO(..))
import Data.ByteString (ByteString)
import Data.Functor ((<&>))
import Data.Hashable
import Data.Kind
import Data.String
import Generics.SOP
import PostgreSQL.Binary.Encoding (encodingBytes)
import Prelude hiding (id, (.))

import qualified Control.Monad.Fail as Fail
import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified PostgreSQL.Binary.Encoding as Encoding

import Squeal.PostgreSQL.Definition
import Squeal.PostgreSQL.Manipulation
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Session.Connection
import Squeal.PostgreSQL.Session.Encode
import Squeal.PostgreSQL.Session.Exception
import Squeal.PostgreSQL.Session.Indexed
import Squeal.PostgreSQL.Session.Oid
import Squeal.PostgreSQL.Session.Monad
import Squeal.PostgreSQL.Session.Result
import Squeal.PostgreSQL.Session.Statement
import Squeal.PostgreSQL.Type.Schema

-- | We keep track of the schema via an Atkey indexed state monad transformer,
-- `PQ`.
newtype PQ
  (db0 :: SchemasType)
  (db1 :: SchemasType)
  (m :: Type -> Type)
  (x :: Type) =
    PQ { forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
PQ db0 db1 m x -> K Connection db0 -> m (K x db1)
unPQ :: K LibPQ.Connection db0 -> m (K x db1) }

instance Monad m => Functor (PQ db0 db1 m) where
  fmap :: forall a b. (a -> b) -> PQ db0 db1 m a -> PQ db0 db1 m b
fmap a -> b
f (PQ K Connection db0 -> m (K a db1)
pq) = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \ K Connection db0
conn -> do
    K a
x <- K Connection db0 -> m (K a db1)
pq K Connection db0
conn
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a (b :: k). a -> K a b
K (a -> b
f a
x)

-- | Run a `PQ` and keep the result and the `LibPQ.Connection`.
runPQ
  :: Functor m
  => PQ db0 db1 m x
  -> K LibPQ.Connection db0
  -> m (x, K LibPQ.Connection db1)
runPQ :: forall (m :: * -> *) (db0 :: SchemasType) (db1 :: SchemasType) x.
Functor m =>
PQ db0 db1 m x -> K Connection db0 -> m (x, K Connection db1)
runPQ (PQ K Connection db0 -> m (K x db1)
pq) K Connection db0
conn = (\ K x db1
x -> (forall {k} a (b :: k). K a b -> a
unK K x db1
x, forall k a (b :: k). a -> K a b
K (forall {k} a (b :: k). K a b -> a
unK K Connection db0
conn))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> K Connection db0 -> m (K x db1)
pq K Connection db0
conn
  -- K x <- pq conn
  -- return (x, K (unK conn))

-- | Execute a `PQ` and discard the result but keep the `LibPQ.Connection`.
execPQ
  :: Functor m
  => PQ db0 db1 m x
  -> K LibPQ.Connection db0
  -> m (K LibPQ.Connection db1)
execPQ :: forall (m :: * -> *) (db0 :: SchemasType) (db1 :: SchemasType) x.
Functor m =>
PQ db0 db1 m x -> K Connection db0 -> m (K Connection db1)
execPQ (PQ K Connection db0 -> m (K x db1)
pq) K Connection db0
conn = forall {k1} {k2} a b (c :: k1) (d :: k2).
(a -> b) -> K a c -> K b d
mapKK (\ x
_ -> forall {k} a (b :: k). K a b -> a
unK K Connection db0
conn) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> K Connection db0 -> m (K x db1)
pq K Connection db0
conn

-- | Evaluate a `PQ` and discard the `LibPQ.Connection` but keep the result.
evalPQ
  :: Functor m
  => PQ db0 db1 m x
  -> K LibPQ.Connection db0
  -> m x
evalPQ :: forall (m :: * -> *) (db0 :: SchemasType) (db1 :: SchemasType) x.
Functor m =>
PQ db0 db1 m x -> K Connection db0 -> m x
evalPQ (PQ K Connection db0 -> m (K x db1)
pq) K Connection db0
conn = forall {k} a (b :: k). K a b -> a
unK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> K Connection db0 -> m (K x db1)
pq K Connection db0
conn

instance IndexedMonadTrans PQ where

  pqAp :: forall (m :: * -> *) (i :: SchemasType) (j :: SchemasType) x y
       (k :: SchemasType).
Monad m =>
PQ i j m (x -> y) -> PQ j k m x -> PQ i k m y
pqAp (PQ K Connection i -> m (K (x -> y) j)
f) (PQ K Connection j -> m (K x k)
x) = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \ K Connection i
conn -> do
    K x -> y
f' <- K Connection i -> m (K (x -> y) j)
f K Connection i
conn
    K x
x' <- K Connection j -> m (K x k)
x (forall k a (b :: k). a -> K a b
K (forall {k} a (b :: k). K a b -> a
unK K Connection i
conn))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a (b :: k). a -> K a b
K (x -> y
f' x
x')

  pqBind :: forall (m :: * -> *) x (j :: SchemasType) (k :: SchemasType) y
       (i :: SchemasType).
Monad m =>
(x -> PQ j k m y) -> PQ i j m x -> PQ i k m y
pqBind x -> PQ j k m y
f (PQ K Connection i -> m (K x j)
x) = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \ K Connection i
conn -> do
    K x
x' <- K Connection i -> m (K x j)
x K Connection i
conn
    forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
PQ db0 db1 m x -> K Connection db0 -> m (K x db1)
unPQ (x -> PQ j k m y
f x
x') (forall k a (b :: k). a -> K a b
K (forall {k} a (b :: k). K a b -> a
unK K Connection i
conn))

instance IndexedMonadTransPQ PQ where

  define :: forall (io :: * -> *) (db0 :: SchemasType) (db1 :: SchemasType).
MonadIO io =>
Definition db0 db1 -> PQ db0 db1 io ()
define (UnsafeDefinition ByteString
q) = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \ (K Connection
conn) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Maybe Result
resultMaybe <-  Connection -> ByteString -> IO (Maybe Result)
LibPQ.exec Connection
conn ByteString
q
    case Maybe Result
resultMaybe of
      Maybe Result
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.exec"
      Just Result
result -> forall k a (b :: k). a -> K a b
K forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (io :: * -> *). MonadIO io => Result -> io ()
okResult_ Result
result

instance (MonadIO io, db0 ~ db, db1 ~ db) => MonadPQ db (PQ db0 db1 io) where

  executeParams :: forall x y. Statement db x y -> x -> PQ db0 db1 io (Result y)
executeParams (Manipulation EncodeParams db params x
encode DecodeRow row y
decode (UnsafeManipulation ByteString
q)) x
x =
    forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \ kconn :: K Connection db0
kconn@(K Connection
conn) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
      let
        formatParam
          :: forall param. OidOfNull db param
          => K (Maybe Encoding.Encoding) param
          -> IO (K (Maybe (LibPQ.Oid, ByteString, LibPQ.Format)) param)
        formatParam :: forall (param :: NullType).
OidOfNull db param =>
K (Maybe Encoding) param
-> IO (K (Maybe (Oid, ByteString, Format)) param)
formatParam (K Maybe Encoding
maybeEncoding) = do
          Oid
oid <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (db :: SchemasType) (ty :: NullType).
OidOfNull db ty =>
ReaderT (K Connection db) IO Oid
oidOfNull @db @param) K Connection db0
kconn
          forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k a (b :: k). a -> K a b
K forall a b. (a -> b) -> a -> b
$ Maybe Encoding
maybeEncoding forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Encoding
encoding ->
            (Oid
oid, Encoding -> ByteString
encodingBytes Encoding
encoding, Format
LibPQ.Binary)
      NP (K (Maybe Encoding)) params
encodedParams <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall k (db :: SchemasType) (tys :: [k]) x.
EncodeParams db tys x
-> x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
runEncodeParams EncodeParams db params x
encode x
x) K Connection db0
kconn
      [Maybe (Oid, ByteString, Format)]
formattedParams <- forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (g :: * -> *) (proxy :: (k -> Constraint) -> *)
       (f :: k -> *) (f' :: k -> *).
(HSequence h, AllN h c xs, Applicative g) =>
proxy c
-> (forall (a :: k). c a => f a -> g (f' a))
-> h f xs
-> g (h f' xs)
hctraverse' (forall {k} (t :: k). Proxy t
Proxy @(OidOfNull db)) forall (param :: NullType).
OidOfNull db param =>
K (Maybe Encoding) param
-> IO (K (Maybe (Oid, ByteString, Format)) param)
formatParam NP (K (Maybe Encoding)) params
encodedParams
      Maybe Result
resultMaybe <-
        Connection
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> IO (Maybe Result)
LibPQ.execParams Connection
conn (ByteString
q forall a. Semigroup a => a -> a -> a
<> ByteString
";") [Maybe (Oid, ByteString, Format)]
formattedParams Format
LibPQ.Binary
      case Maybe Result
resultMaybe of
        Maybe Result
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.execParams"
        Just Result
result -> do
          forall (io :: * -> *). MonadIO io => Result -> io ()
okResult_ Result
result
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a (b :: k). a -> K a b
K (forall (params :: RowType) y.
SListI params =>
DecodeRow params y -> Result -> Result y
Result DecodeRow row y
decode Result
result)
  executeParams (Query EncodeParams db params x
encode DecodeRow row y
decode Query '[] '[] db params row
q) x
x =
    forall (db :: SchemasType) (pq :: * -> *) x y.
MonadPQ db pq =>
Statement db x y -> x -> pq (Result y)
executeParams (forall (db :: SchemasType) (params :: [NullType]) (row :: RowType)
       x y.
(All (OidOfNull db) params, SListI row) =>
EncodeParams db params x
-> DecodeRow row y
-> Manipulation '[] db params row
-> Statement db x y
Manipulation EncodeParams db params x
encode DecodeRow row y
decode (forall (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (columns :: RowType).
Query '[] with db params columns
-> Manipulation with db params columns
queryStatement Query '[] '[] db params row
q)) x
x

  prepare :: forall x y.
Statement db x y
-> PQ db0 db1 io (Prepared (PQ db0 db1 io) x (Result y))
prepare (Manipulation EncodeParams db params x
encode DecodeRow row y
decode (UnsafeManipulation ByteString
q :: Manipulation '[] db params row)) = do
    let
      statementNum :: ByteString
statementNum = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ case forall a. Show a => a -> String
show (forall a. Hashable a => a -> Int
hash ByteString
q) of
        Char
'-':String
num -> String
"negative_" forall a. Semigroup a => a -> a -> a
<> String
num
        String
num -> String
num

      prepName :: ByteString
prepName = ByteString
"prepared_statement_" forall a. Semigroup a => a -> a -> a
<> ByteString
statementNum

      prepare' :: PQ db0 db1 io ()
prepare' = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \ kconn :: K Connection db0
kconn@(K Connection
conn) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        let
          oidOfParam :: forall p. OidOfNull db p => (IO :.: K LibPQ.Oid) p
          oidOfParam :: forall (p :: NullType). OidOfNull db p => (:.:) IO (K Oid) p
oidOfParam = forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp forall a b. (a -> b) -> a -> b
$ forall k a (b :: k). a -> K a b
K forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (db :: SchemasType) (ty :: NullType).
OidOfNull db ty =>
ReaderT (K Connection db) IO Oid
oidOfNull @db @p) K Connection db0
kconn
          oidsOfParams :: NP (IO :.: K LibPQ.Oid) params
          oidsOfParams :: NP (IO :.: K Oid) params
oidsOfParams = forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure (forall {k} (t :: k). Proxy t
Proxy @(OidOfNull db)) forall (p :: NullType). OidOfNull db p => (:.:) IO (K Oid) p
oidOfParam
        [Oid]
oids <- forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
       (g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
hsequence' NP (IO :.: K Oid) params
oidsOfParams
        Maybe Result
prepResultMaybe <- Connection
-> ByteString -> ByteString -> Maybe [Oid] -> IO (Maybe Result)
LibPQ.prepare Connection
conn ByteString
prepName (ByteString
q forall a. Semigroup a => a -> a -> a
<> ByteString
";") (forall a. a -> Maybe a
Just [Oid]
oids)
        case Maybe Result
prepResultMaybe of
          Maybe Result
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.prepare"
          Just Result
prepResult -> forall k a (b :: k). a -> K a b
K forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (io :: * -> *). MonadIO io => Result -> io ()
okResult_ Result
prepResult

      deallocate' :: PQ db0 db1 io ()
deallocate' = forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (columns :: RowType).
ByteString -> Manipulation with db params columns
UnsafeManipulation forall a b. (a -> b) -> a -> b
$
        ByteString
"DEALLOCATE" ByteString -> ByteString -> ByteString
<+> ByteString
prepName

      runPrepared' :: x -> PQ db db1 io (Result y)
runPrepared' x
params = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \ kconn :: K Connection db
kconn@(K Connection
conn) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        NP (K (Maybe Encoding)) params
encodedParams <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall k (db :: SchemasType) (tys :: [k]) x.
EncodeParams db tys x
-> x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
runEncodeParams EncodeParams db params x
encode x
params) K Connection db
kconn
        let
          formatParam :: Encoding -> (ByteString, Format)
formatParam Encoding
encoding = (Encoding -> ByteString
encodingBytes Encoding
encoding, Format
LibPQ.Binary)
          formattedParams :: [Maybe (ByteString, Format)]
formattedParams =
            [ Encoding -> (ByteString, Format)
formatParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Encoding
maybeParam
            | Maybe Encoding
maybeParam <- forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse NP (K (Maybe Encoding)) params
encodedParams
            ]
        Maybe Result
resultMaybe <-
          Connection
-> ByteString
-> [Maybe (ByteString, Format)]
-> Format
-> IO (Maybe Result)
LibPQ.execPrepared Connection
conn ByteString
prepName [Maybe (ByteString, Format)]
formattedParams Format
LibPQ.Binary
        case Maybe Result
resultMaybe of
          Maybe Result
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.runPrepared"
          Just Result
result -> do
            forall (io :: * -> *). MonadIO io => Result -> io ()
okResult_ Result
result
            forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k a (b :: k). a -> K a b
K forall a b. (a -> b) -> a -> b
$ forall (params :: RowType) y.
SListI params =>
DecodeRow params y -> Result -> Result y
Result DecodeRow row y
decode Result
result

    PQ db0 db1 io ()
prepare'
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared x -> PQ db db1 io (Result y)
runPrepared' PQ db0 db1 io ()
deallocate'

  prepare (Query EncodeParams db params x
encode DecodeRow row y
decode Query '[] '[] db params row
q) = forall (db :: SchemasType) (pq :: * -> *) x y.
MonadPQ db pq =>
Statement db x y -> pq (Prepared pq x (Result y))
prepare (forall (db :: SchemasType) (params :: [NullType]) (row :: RowType)
       x y.
(All (OidOfNull db) params, SListI row) =>
EncodeParams db params x
-> DecodeRow row y
-> Manipulation '[] db params row
-> Statement db x y
Manipulation EncodeParams db params x
encode DecodeRow row y
decode (forall (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (columns :: RowType).
Query '[] with db params columns
-> Manipulation with db params columns
queryStatement Query '[] '[] db params row
q))

instance (Monad m, db0 ~ db1)
  => Applicative (PQ db0 db1 m) where
  pure :: forall a. a -> PQ db0 db1 m a
pure a
x = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \ K Connection db0
_conn -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a (b :: k). a -> K a b
K a
x)
  <*> :: forall a b.
PQ db0 db1 m (a -> b) -> PQ db0 db1 m a -> PQ db0 db1 m b
(<*>) = forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *)
       (i :: k) (j :: k) x y (k :: k).
(IndexedMonadTrans t, Monad m) =>
t i j m (x -> y) -> t j k m x -> t i k m y
pqAp

instance (Monad m, db0 ~ db1)
  => Monad (PQ db0 db1 m) where
  return :: forall a. a -> PQ db0 db1 m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >>= :: forall a b.
PQ db0 db1 m a -> (a -> PQ db0 db1 m b) -> PQ db0 db1 m b
(>>=) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *) x
       (j :: k) (k :: k) y (i :: k).
(IndexedMonadTrans t, Monad m) =>
(x -> t j k m y) -> t i j m x -> t i k m y
pqBind

instance (Monad m, db0 ~ db1)
  => Fail.MonadFail (PQ db0 db1 m) where
  fail :: forall a. String -> PQ db0 db1 m a
fail = forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail

instance db0 ~ db1 => MFunctor (PQ db0 db1) where
  hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> PQ db0 db1 m b -> PQ db0 db1 n b
hoist forall a. m a -> n a
f (PQ K Connection db0 -> m (K b db1)
pq) = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ (forall a. m a -> n a
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. K Connection db0 -> m (K b db1)
pq)

instance db0 ~ db1 => MonadTrans (PQ db0 db1) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> PQ db0 db1 m a
lift m a
m = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \ K Connection db0
_conn -> do
    a
x <- m a
m
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a (b :: k). a -> K a b
K a
x)

instance db0 ~ db1 => MMonad (PQ db0 db1) where
  embed :: forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> PQ db0 db1 n a)
-> PQ db0 db1 m b -> PQ db0 db1 n b
embed forall a. m a -> PQ db0 db1 n a
f (PQ K Connection db0 -> m (K b db1)
pq) = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \ K Connection db0
conn -> do
    forall (m :: * -> *) (db0 :: SchemasType) (db1 :: SchemasType) x.
Functor m =>
PQ db0 db1 m x -> K Connection db0 -> m x
evalPQ (forall a. m a -> PQ db0 db1 n a
f (K Connection db0 -> m (K b db1)
pq K Connection db0
conn)) K Connection db0
conn

instance (MonadIO m, schema0 ~ schema1)
  => MonadIO (PQ schema0 schema1 m) where
  liftIO :: forall a. IO a -> PQ schema0 schema1 m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance (MonadUnliftIO m, db0 ~ db1)
  => MonadUnliftIO (PQ db0 db1 m) where
  withRunInIO
      :: ((forall a . PQ db0 schema1 m a -> IO a) -> IO b)
      -> PQ db0 schema1 m b
  withRunInIO :: forall (schema1 :: SchemasType) b.
((forall a. PQ db0 schema1 m a -> IO a) -> IO b)
-> PQ db0 schema1 m b
withRunInIO (forall a. PQ db0 schema1 m a -> IO a) -> IO b
inner = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \K Connection db0
conn ->
    forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \(forall a. m a -> IO a
run :: (forall x . m x -> IO x)) ->
      forall k a (b :: k). a -> K a b
K forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. PQ db0 schema1 m a -> IO a) -> IO b
inner (\PQ db0 schema1 m a
pq -> forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). K a b -> a
unK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
PQ db0 db1 m x -> K Connection db0 -> m (K x db1)
unPQ PQ db0 schema1 m a
pq K Connection db0
conn)

instance (MonadBase b m)
  => MonadBase b (PQ schema schema m) where
  liftBase :: forall α. b α -> PQ schema schema m α
liftBase = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance db0 ~ db1 => MonadTransControl (PQ db0 db1) where
  type StT (PQ db0 db1) a = a
  liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (PQ db0 db1) -> m a) -> PQ db0 db1 m a
liftWith Run (PQ db0 db1) -> m a
f = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \K Connection db0
conn -> forall k a (b :: k). a -> K a b
K forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Run (PQ db0 db1) -> m a
f forall a b. (a -> b) -> a -> b
$ \PQ db0 db1 n b
pq -> forall {k} a (b :: k). K a b -> a
unK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
PQ db0 db1 m x -> K Connection db0 -> m (K x db1)
unPQ PQ db0 db1 n b
pq K Connection db0
conn)
  restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (PQ db0 db1) a) -> PQ db0 db1 m a
restoreT m (StT (PQ db0 db1) a)
ma = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall k a (b :: k). a -> K a b
K forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (StT (PQ db0 db1) a)
ma

-- | A snapshot of the state of a `PQ` computation, used in MonadBaseControl Instance
type PQRun schema =
  forall m x. Monad m => PQ schema schema m x -> m (K x schema)

instance (MonadBaseControl b m, schema0 ~ schema1)
  => MonadBaseControl b (PQ schema0 schema1 m) where
  type StM (PQ schema0 schema1 m) x = StM m (K x schema0)
  restoreM :: forall a. StM (PQ schema0 schema1 m) a -> PQ schema0 schema1 m a
restoreM = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
  liftBaseWith :: forall a.
(RunInBase (PQ schema0 schema1 m) b -> b a)
-> PQ schema0 schema1 m a
liftBaseWith RunInBase (PQ schema0 schema1 m) b -> b a
f =
    forall (schema :: SchemasType) a.
Functor m =>
(PQRun schema -> m a) -> PQ schema schema m a
pqliftWith forall a b. (a -> b) -> a -> b
$ \ PQRun schema0
run -> forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith forall a b. (a -> b) -> a -> b
$ \ RunInBase m b
runInBase -> RunInBase (PQ schema0 schema1 m) b -> b a
f forall a b. (a -> b) -> a -> b
$ RunInBase m b
runInBase forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PQRun schema0
run
    where
      pqliftWith :: Functor m => (PQRun schema -> m a) -> PQ schema schema m a
      pqliftWith :: forall (schema :: SchemasType) a.
Functor m =>
(PQRun schema -> m a) -> PQ schema schema m a
pqliftWith PQRun schema -> m a
g = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \ K Connection schema
conn ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a (b :: k). a -> K a b
K (PQRun schema -> m a
g forall a b. (a -> b) -> a -> b
$ \ PQ schema schema m x
pq -> forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
PQ db0 db1 m x -> K Connection db0 -> m (K x db1)
unPQ PQ schema schema m x
pq K Connection schema
conn)

instance (MonadThrow m, db0 ~ db1)
  => MonadThrow (PQ db0 db1 m) where
  throwM :: forall e a. Exception e => e -> PQ db0 db1 m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance (MonadCatch m, db0 ~ db1)
  => MonadCatch (PQ db0 db1 m) where
  catch :: forall e a.
Exception e =>
PQ db0 db1 m a -> (e -> PQ db0 db1 m a) -> PQ db0 db1 m a
catch (PQ K Connection db0 -> m (K a db1)
m) e -> PQ db0 db1 m a
f = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \K Connection db0
k -> K Connection db0 -> m (K a db1)
m K Connection db0
k forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
PQ db0 db1 m x -> K Connection db0 -> m (K x db1)
unPQ (e -> PQ db0 db1 m a
f e
e) K Connection db0
k

instance (MonadMask m, db0 ~ db1)
  => MonadMask (PQ db0 db1 m) where
  mask :: forall b.
((forall a. PQ db0 db1 m a -> PQ db0 db1 m a) -> PQ db0 db1 m b)
-> PQ db0 db1 m b
mask (forall a. PQ db0 db1 m a -> PQ db0 db1 m a) -> PQ db0 db1 m b
a = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \K Connection db0
e -> forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
PQ db0 db1 m x -> K Connection db0 -> m (K x db1)
unPQ ((forall a. PQ db0 db1 m a -> PQ db0 db1 m a) -> PQ db0 db1 m b
a forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {x} {db1 :: SchemasType} {m :: * -> *} {x}
       {db1 :: SchemasType} {db0 :: SchemasType}.
(m (K x db1) -> m (K x db1)) -> PQ db0 db1 m x -> PQ db0 db1 m x
q forall a. m a -> m a
u) K Connection db0
e
    where q :: (m (K x db1) -> m (K x db1)) -> PQ db0 db1 m x -> PQ db0 db1 m x
q m (K x db1) -> m (K x db1)
u (PQ K Connection db0 -> m (K x db1)
b) = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ (m (K x db1) -> m (K x db1)
u forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. K Connection db0 -> m (K x db1)
b)

  uninterruptibleMask :: forall b.
((forall a. PQ db0 db1 m a -> PQ db0 db1 m a) -> PQ db0 db1 m b)
-> PQ db0 db1 m b
uninterruptibleMask (forall a. PQ db0 db1 m a -> PQ db0 db1 m a) -> PQ db0 db1 m b
a =
    forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \K Connection db0
k -> forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
PQ db0 db1 m x -> K Connection db0 -> m (K x db1)
unPQ ((forall a. PQ db0 db1 m a -> PQ db0 db1 m a) -> PQ db0 db1 m b
a forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {x} {db1 :: SchemasType} {m :: * -> *} {x}
       {db1 :: SchemasType} {db0 :: SchemasType}.
(m (K x db1) -> m (K x db1)) -> PQ db0 db1 m x -> PQ db0 db1 m x
q forall a. m a -> m a
u) K Connection db0
k
      where q :: (m (K x db1) -> m (K x db1)) -> PQ db0 db1 m x -> PQ db0 db1 m x
q m (K x db1) -> m (K x db1)
u (PQ K Connection db0 -> m (K x db1)
b) = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ (m (K x db1) -> m (K x db1)
u forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. K Connection db0 -> m (K x db1)
b)

  generalBracket :: forall a b c.
PQ db0 db1 m a
-> (a -> ExitCase b -> PQ db0 db1 m c)
-> (a -> PQ db0 db1 m b)
-> PQ db0 db1 m (b, c)
generalBracket PQ db0 db1 m a
acquire a -> ExitCase b -> PQ db0 db1 m c
release a -> PQ db0 db1 m b
use = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \K Connection db0
k ->
    forall k a (b :: k). a -> K a b
K forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (forall {k} a (b :: k). K a b -> a
unK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
PQ db0 db1 m x -> K Connection db0 -> m (K x db1)
unPQ PQ db0 db1 m a
acquire K Connection db0
k)
      (\a
resource ExitCase b
exitCase -> forall {k} a (b :: k). K a b -> a
unK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
PQ db0 db1 m x -> K Connection db0 -> m (K x db1)
unPQ (a -> ExitCase b -> PQ db0 db1 m c
release a
resource ExitCase b
exitCase) K Connection db0
k)
      (\a
resource -> forall {k} a (b :: k). K a b -> a
unK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
PQ db0 db1 m x -> K Connection db0 -> m (K x db1)
unPQ (a -> PQ db0 db1 m b
use a
resource) K Connection db0
k)

instance (Monad m, Semigroup r, db0 ~ db1) => Semigroup (PQ db0 db1 m r) where
  PQ db0 db1 m r
f <> :: PQ db0 db1 m r -> PQ db0 db1 m r -> PQ db0 db1 m r
<> PQ db0 db1 m r
g = forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *)
       (i :: k) (j :: k) x y (k :: k).
(IndexedMonadTrans t, Monad m) =>
t i j m (x -> y) -> t j k m x -> t i k m y
pqAp (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Semigroup a => a -> a -> a
(<>) PQ db0 db1 m r
f) PQ db0 db1 m r
g

instance (Monad m, Monoid r, db0 ~ db1) => Monoid (PQ db0 db1 m r) where
  mempty :: PQ db0 db1 m r
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

instance MonadFix m => MonadFix (PQ db db m) where
  mfix :: forall a. (a -> PQ db db m a) -> PQ db db m a
mfix a -> PQ db db m a
f = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \K Connection db
conn -> forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \ (K a
a) -> forall k a (b :: k). a -> K a b
K forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (db0 :: SchemasType) (db1 :: SchemasType) x.
Functor m =>
PQ db0 db1 m x -> K Connection db0 -> m x
evalPQ (a -> PQ db db m a
f a
a) K Connection db
conn

instance (Monad m, Alternative m, db0 ~ db1)
  => Alternative (PQ db0 db1 m) where
    empty :: forall a. PQ db0 db1 m a
empty = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (f :: * -> *) a. Alternative f => f a
empty
    PQ db0 db1 m a
altL <|> :: forall a. PQ db0 db1 m a -> PQ db0 db1 m a -> PQ db0 db1 m a
<|> PQ db0 db1 m a
altR = forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ \ K Connection db0
conn -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a (b :: k). a -> K a b
K forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) (db0 :: SchemasType) (db1 :: SchemasType) x.
Functor m =>
PQ db0 db1 m x -> K Connection db0 -> m x
evalPQ PQ db0 db1 m a
altL K Connection db0
conn forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) (db0 :: SchemasType) (db1 :: SchemasType) x.
Functor m =>
PQ db0 db1 m x -> K Connection db0 -> m x
evalPQ PQ db0 db1 m a
altR K Connection db0
conn

instance (MonadPlus m, db0 ~ db1) => MonadPlus (PQ db0 db1 m)

-- | Do `connectdb` and `finish` before and after a computation.
withConnection
  :: forall db0 db1 io x
   . (MonadIO io, MonadMask io)
  => ByteString
  -> PQ db0 db1 io x
  -> io x
withConnection :: forall (db0 :: SchemasType) (db1 :: SchemasType) (io :: * -> *) x.
(MonadIO io, MonadMask io) =>
ByteString -> PQ db0 db1 io x -> io x
withConnection ByteString
connString PQ db0 db1 io x
action =
  forall {k} a (b :: k). K a b -> a
unK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (forall (db :: SchemasType) (io :: * -> *).
MonadIO io =>
ByteString -> io (K Connection db)
connectdb ByteString
connString) forall {k} (io :: * -> *) (db :: k).
MonadIO io =>
K Connection db -> io ()
finish (forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
PQ db0 db1 m x -> K Connection db0 -> m (K x db1)
unPQ PQ db0 db1 io x
action)

okResult_ :: MonadIO io => LibPQ.Result -> io ()
okResult_ :: forall (io :: * -> *). MonadIO io => Result -> io ()
okResult_ Result
result = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  ExecStatus
status <- Result -> IO ExecStatus
LibPQ.resultStatus Result
result
  case ExecStatus
status of
    ExecStatus
LibPQ.CommandOk -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ExecStatus
LibPQ.TuplesOk -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ExecStatus
_ -> do
      Maybe ByteString
stateCodeMaybe <- Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagSqlstate
      case Maybe ByteString
stateCodeMaybe of
        Maybe ByteString
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.resultErrorField"
        Just ByteString
stateCode -> do
          Maybe ByteString
msgMaybe <- Result -> IO (Maybe ByteString)
LibPQ.resultErrorMessage Result
result
          case Maybe ByteString
msgMaybe of
            Maybe ByteString
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.resultErrorMessage"
            Just ByteString
msg -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SQLState -> SquealException
SQLException forall a b. (a -> b) -> a -> b
$ ExecStatus -> ByteString -> ByteString -> SQLState
SQLState ExecStatus
status ByteString
stateCode ByteString
msg