{-|
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
  , TypeInType
  , TypeOperators
  , UndecidableInstances
#-}

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

import Control.Applicative
import Control.Category
import Control.Monad.Base (MonadBase(..))
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Morph
import Control.Monad.Reader
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 { 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 :: (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) = (K Connection db0 -> m (K b db1)) -> PQ db0 db1 m b
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db0 -> m (K b db1)) -> PQ db0 db1 m b)
-> (K Connection db0 -> m (K b db1)) -> PQ db0 db1 m b
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
    K b db1 -> m (K b db1)
forall (m :: * -> *) a. Monad m => a -> m a
return (K b db1 -> m (K b db1)) -> K b db1 -> m (K b db1)
forall a b. (a -> b) -> a -> b
$ b -> K b db1
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 :: 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 -> (K x db1 -> x
forall k a (b :: k). K a b -> a
unK K x db1
x, Connection -> K Connection db1
forall k a (b :: k). a -> K a b
K (K Connection db0 -> Connection
forall k a (b :: k). K a b -> a
unK K Connection db0
conn))) (K x db1 -> (x, K Connection db1))
-> m (K x db1) -> m (x, K Connection db1)
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 :: 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 = (x -> Connection) -> K x db1 -> K Connection db1
forall k1 k2 a b (c :: k1) (d :: k2). (a -> b) -> K a c -> K b d
mapKK (\ x
_ -> K Connection db0 -> Connection
forall k a (b :: k). K a b -> a
unK K Connection db0
conn) (K x db1 -> K Connection db1)
-> m (K x db1) -> m (K Connection db1)
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 :: PQ db0 db1 m x -> K Connection db0 -> m x
evalPQ (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) -> m (K x db1) -> m x
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 :: 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) = (K Connection i -> m (K y k)) -> PQ i k m y
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection i -> m (K y k)) -> PQ i k m y)
-> (K Connection i -> m (K y k)) -> PQ i k m y
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 (Connection -> K Connection j
forall k a (b :: k). a -> K a b
K (K Connection i -> Connection
forall k a (b :: k). K a b -> a
unK K Connection i
conn))
    K y k -> m (K y k)
forall (m :: * -> *) a. Monad m => a -> m a
return (K y k -> m (K y k)) -> K y k -> m (K y k)
forall a b. (a -> b) -> a -> b
$ y -> K y k
forall k a (b :: k). a -> K a b
K (x -> y
f' x
x')

  pqBind :: (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) = (K Connection i -> m (K y k)) -> PQ i k m y
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection i -> m (K y k)) -> PQ i k m y)
-> (K Connection i -> m (K y k)) -> PQ i k m y
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
    PQ j k m y -> K Connection j -> m (K y k)
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') (Connection -> K Connection j
forall k a (b :: k). a -> K a b
K (K Connection i -> Connection
forall k a (b :: k). K a b -> a
unK K Connection i
conn))

instance IndexedMonadTransPQ PQ where

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

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

  executeParams :: 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 =
    (K Connection db -> io (K (Result y) db1))
-> PQ db db1 io (Result y)
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db -> io (K (Result y) db1))
 -> PQ db db1 io (Result y))
-> (K Connection db -> io (K (Result y) db1))
-> PQ db db1 io (Result y)
forall a b. (a -> b) -> a -> b
$ \ kconn :: K Connection db
kconn@(K Connection
conn) -> IO (K (Result y) db1) -> io (K (Result y) db1)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (K (Result y) db1) -> io (K (Result y) db1))
-> IO (K (Result y) db1) -> io (K (Result y) db1)
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 :: K (Maybe Encoding) param
-> IO (K (Maybe (Oid, ByteString, Format)) param)
formatParam (K Maybe Encoding
maybeEncoding) = do
          Oid
oid <- ReaderT (K Connection db) IO Oid -> K Connection db -> IO Oid
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (OidOfNull db param => ReaderT (K Connection db) IO Oid
forall (db :: SchemasType) (ty :: NullType).
OidOfNull db ty =>
ReaderT (K Connection db) IO Oid
oidOfNull @db @param) K Connection db
kconn
          K (Maybe (Oid, ByteString, Format)) param
-> IO (K (Maybe (Oid, ByteString, Format)) param)
forall (m :: * -> *) a. Monad m => a -> m a
return (K (Maybe (Oid, ByteString, Format)) param
 -> IO (K (Maybe (Oid, ByteString, Format)) param))
-> (Maybe (Oid, ByteString, Format)
    -> K (Maybe (Oid, ByteString, Format)) param)
-> Maybe (Oid, ByteString, Format)
-> IO (K (Maybe (Oid, ByteString, Format)) param)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe (Oid, ByteString, Format)
-> K (Maybe (Oid, ByteString, Format)) param
forall k a (b :: k). a -> K a b
K (Maybe (Oid, ByteString, Format)
 -> IO (K (Maybe (Oid, ByteString, Format)) param))
-> Maybe (Oid, ByteString, Format)
-> IO (K (Maybe (Oid, ByteString, Format)) param)
forall a b. (a -> b) -> a -> b
$ Maybe Encoding
maybeEncoding Maybe Encoding
-> (Encoding -> (Oid, ByteString, Format))
-> Maybe (Oid, ByteString, Format)
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 <- ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params)
-> K Connection db -> IO (NP (K (Maybe Encoding)) params)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (EncodeParams db params x
-> x
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params)
forall (db :: SchemasType) k (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 db
kconn
      [Maybe (Oid, ByteString, Format)]
formattedParams <- NP (K (Maybe (Oid, ByteString, Format))) params
-> [Maybe (Oid, ByteString, Format)]
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 (Oid, ByteString, Format))) params
 -> [Maybe (Oid, ByteString, Format)])
-> IO (NP (K (Maybe (Oid, ByteString, Format))) params)
-> IO [Maybe (Oid, ByteString, Format)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Proxy (OidOfNull db)
-> (forall (a :: NullType).
    OidOfNull db a =>
    K (Maybe Encoding) a -> IO (K (Maybe (Oid, ByteString, Format)) a))
-> NP (K (Maybe Encoding)) params
-> IO (NP (K (Maybe (Oid, ByteString, Format))) params)
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' (Proxy (OidOfNull db)
forall k (t :: k). Proxy t
Proxy @(OidOfNull db)) forall (a :: NullType).
OidOfNull db a =>
K (Maybe Encoding) a -> IO (K (Maybe (Oid, ByteString, Format)) a)
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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";") [Maybe (Oid, ByteString, Format)]
formattedParams Format
LibPQ.Binary
      case Maybe Result
resultMaybe of
        Maybe Result
Nothing -> SquealException -> IO (K (Result y) db1)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO (K (Result y) db1))
-> SquealException -> IO (K (Result y) db1)
forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.execParams"
        Just Result
result -> do
          Result -> IO ()
forall (io :: * -> *). MonadIO io => Result -> io ()
okResult_ Result
result
          K (Result y) db1 -> IO (K (Result y) db1)
forall (m :: * -> *) a. Monad m => a -> m a
return (K (Result y) db1 -> IO (K (Result y) db1))
-> K (Result y) db1 -> IO (K (Result y) db1)
forall a b. (a -> b) -> a -> b
$ Result y -> K (Result y) db1
forall k a (b :: k). a -> K a b
K (DecodeRow row y -> Result -> Result y
forall (row :: RowType) y.
SListI row =>
DecodeRow row 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 =
    Statement db x y -> x -> PQ db0 db1 io (Result y)
forall (db :: SchemasType) (pq :: * -> *) x y.
MonadPQ db pq =>
Statement db x y -> x -> pq (Result y)
executeParams (EncodeParams db params x
-> DecodeRow row y
-> Manipulation '[] db params row
-> Statement db x y
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 (Query '[] '[] db params row -> Manipulation '[] db params row
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 :: 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 = String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ case Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
forall a. Hashable a => a -> Int
hash ByteString
q) of
        Char
'-':String
num -> String
"negative_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
num
        String
num -> String
num

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

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

      deallocate' :: PQ db db1 io ()
deallocate' = Manipulation '[] db '[] '[] -> PQ db db io ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ (Manipulation '[] db '[] '[] -> PQ db db io ())
-> (ByteString -> Manipulation '[] db '[] '[])
-> ByteString
-> PQ db db io ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Manipulation '[] db '[] '[]
forall (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (columns :: RowType).
ByteString -> Manipulation with db params columns
UnsafeManipulation (ByteString -> PQ db db1 io ()) -> ByteString -> PQ db db1 io ()
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 = (K Connection db -> io (K (Result y) db1))
-> PQ db db1 io (Result y)
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db -> io (K (Result y) db1))
 -> PQ db db1 io (Result y))
-> (K Connection db -> io (K (Result y) db1))
-> PQ db db1 io (Result y)
forall a b. (a -> b) -> a -> b
$ \ kconn :: K Connection db
kconn@(K Connection
conn) -> IO (K (Result y) db1) -> io (K (Result y) db1)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (K (Result y) db1) -> io (K (Result y) db1))
-> IO (K (Result y) db1) -> io (K (Result y) db1)
forall a b. (a -> b) -> a -> b
$ do
        NP (K (Maybe Encoding)) params
encodedParams <- ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params)
-> K Connection db -> IO (NP (K (Maybe Encoding)) params)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (EncodeParams db params x
-> x
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params)
forall (db :: SchemasType) k (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 (Encoding -> (ByteString, Format))
-> Maybe Encoding -> Maybe (ByteString, Format)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Encoding
maybeParam
            | Maybe Encoding
maybeParam <- NP (K (Maybe Encoding)) params -> CollapseTo NP (Maybe Encoding)
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 -> SquealException -> IO (K (Result y) db1)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO (K (Result y) db1))
-> SquealException -> IO (K (Result y) db1)
forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.runPrepared"
          Just Result
result -> do
            Result -> IO ()
forall (io :: * -> *). MonadIO io => Result -> io ()
okResult_ Result
result
            K (Result y) db -> IO (K (Result y) db)
forall (m :: * -> *) a. Monad m => a -> m a
return (K (Result y) db -> IO (K (Result y) db))
-> (Result y -> K (Result y) db)
-> Result y
-> IO (K (Result y) db)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Result y -> K (Result y) db
forall k a (b :: k). a -> K a b
K (Result y -> IO (K (Result y) db1))
-> Result y -> IO (K (Result y) db1)
forall a b. (a -> b) -> a -> b
$ DecodeRow row y -> Result -> Result y
forall (row :: RowType) y.
SListI row =>
DecodeRow row y -> Result -> Result y
Result DecodeRow row y
decode Result
result

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

  prepare (Query EncodeParams db params x
encode DecodeRow row y
decode Query '[] '[] db params row
q) = Statement db x y
-> PQ db0 db1 io (Prepared (PQ db0 db1 io) x (Result y))
forall (db :: SchemasType) (pq :: * -> *) x y.
MonadPQ db pq =>
Statement db x y -> pq (Prepared pq x (Result y))
prepare (EncodeParams db params x
-> DecodeRow row y
-> Manipulation '[] db params row
-> Statement db x y
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 (Query '[] '[] db params row -> Manipulation '[] db params row
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 :: a -> PQ db0 db1 m a
pure a
x = (K Connection db0 -> m (K a db1)) -> PQ db0 db1 m a
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db0 -> m (K a db1)) -> PQ db0 db1 m a)
-> (K Connection db0 -> m (K a db1)) -> PQ db0 db1 m a
forall a b. (a -> b) -> a -> b
$ \ K Connection db0
_conn -> K a db1 -> m (K a db1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> K a db1
forall k a (b :: k). a -> K a b
K a
x)
  <*> :: PQ db0 db1 m (a -> b) -> PQ db0 db1 m a -> PQ db0 db1 m 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 :: a -> PQ db0 db1 m a
return = a -> PQ db0 db1 m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >>= :: PQ db0 db1 m a -> (a -> PQ db0 db1 m b) -> PQ db0 db1 m b
(>>=) = ((a -> PQ db0 db1 m b) -> PQ db0 db0 m a -> PQ db0 db1 m b)
-> PQ db0 db0 m a -> (a -> PQ db0 db1 m b) -> PQ db0 db1 m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> PQ db0 db1 m b) -> PQ db0 db0 m a -> PQ db0 db1 m b
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 :: String -> PQ db0 db1 m a
fail = String -> PQ db0 db1 m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail

instance db0 ~ db1 => MFunctor (PQ db0 db1) where
  hoist :: (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) = (K Connection db0 -> n (K b db1)) -> PQ db0 db1 n b
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ (m (K b db1) -> n (K b db1)
forall a. m a -> n a
f (m (K b db1) -> n (K b db1))
-> (K Connection db1 -> m (K b db1))
-> K Connection db1
-> n (K b db1)
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)
K Connection db1 -> m (K b db1)
pq)

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

instance db0 ~ db1 => MMonad (PQ db0 db1) where
  embed :: (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) = (K Connection db0 -> n (K b db1)) -> PQ db0 db1 n b
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db0 -> n (K b db1)) -> PQ db0 db1 n b)
-> (K Connection db0 -> n (K b db1)) -> PQ db0 db1 n b
forall a b. (a -> b) -> a -> b
$ \ K Connection db0
conn -> do
    PQ db0 db1 n (K b db1) -> K Connection db0 -> n (K b db1)
forall (m :: * -> *) (db0 :: SchemasType) (db1 :: SchemasType) x.
Functor m =>
PQ db0 db1 m x -> K Connection db0 -> m x
evalPQ (m (K b db1) -> PQ db0 db1 n (K b db1)
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 :: IO a -> PQ schema0 schema1 m a
liftIO = m a -> PQ schema1 schema1 m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> PQ schema1 schema1 m a)
-> (IO a -> m a) -> IO a -> PQ schema1 schema1 m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO a -> m a
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 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 = (K Connection db0 -> m (K b schema1)) -> PQ db0 schema1 m b
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db0 -> m (K b schema1)) -> PQ db0 schema1 m b)
-> (K Connection db0 -> m (K b schema1)) -> PQ db0 schema1 m b
forall a b. (a -> b) -> a -> b
$ \K Connection db0
conn ->
    ((forall a. m a -> IO a) -> IO (K b schema1)) -> m (K b schema1)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (K b schema1)) -> m (K b schema1))
-> ((forall a. m a -> IO a) -> IO (K b schema1)) -> m (K b schema1)
forall a b. (a -> b) -> a -> b
$ \(run :: (forall x . m x -> IO x)) ->
      b -> K b schema1
forall k a (b :: k). a -> K a b
K (b -> K b schema1) -> IO b -> IO (K b schema1)
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 -> m a -> IO a
forall a. m a -> IO a
run (m a -> IO a) -> m a -> IO a
forall a b. (a -> b) -> a -> b
$ K a schema1 -> a
forall k a (b :: k). K a b -> a
unK (K a schema1 -> a) -> m (K a schema1) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PQ db0 schema1 m a -> K Connection db0 -> m (K a schema1)
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 :: b α -> PQ schema schema m α
liftBase = m α -> PQ schema schema m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> PQ schema schema m α)
-> (b α -> m α) -> b α -> PQ schema schema m α
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b α -> m α
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 :: (Run (PQ db0 db1) -> m a) -> PQ db0 db1 m a
liftWith Run (PQ db0 db1) -> m a
f = (K Connection db0 -> m (K a db1)) -> PQ db0 db1 m a
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db0 -> m (K a db1)) -> PQ db0 db1 m a)
-> (K Connection db0 -> m (K a db1)) -> PQ db0 db1 m a
forall a b. (a -> b) -> a -> b
$ \K Connection db0
conn -> a -> K a db1
forall k a (b :: k). a -> K a b
K (a -> K a db1) -> m a -> m (K a db1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Run (PQ db0 db1) -> m a
f (Run (PQ db0 db1) -> m a) -> Run (PQ db0 db1) -> m a
forall a b. (a -> b) -> a -> b
$ \PQ db0 db1 n b
pq -> K b db1 -> b
forall k a (b :: k). K a b -> a
unK (K b db1 -> b) -> n (K b db1) -> n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PQ db0 db1 n b -> K Connection db0 -> n (K b db1)
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 :: m (StT (PQ db0 db1) a) -> PQ db0 db1 m a
restoreT m (StT (PQ db0 db1) a)
ma = (K Connection db1 -> m (K a db1)) -> PQ db1 db1 m a
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db1 -> m (K a db1)) -> PQ db1 db1 m a)
-> (m (K a db1) -> K Connection db1 -> m (K a db1))
-> m (K a db1)
-> PQ db1 db1 m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m (K a db1) -> K Connection db1 -> m (K a db1)
forall a b. a -> b -> a
const (m (K a db1) -> PQ db0 db1 m a) -> m (K a db1) -> PQ db0 db1 m a
forall a b. (a -> b) -> a -> b
$ a -> K a db1
forall k a (b :: k). a -> K a b
K (a -> K a db1) -> m a -> m (K a db1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
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 :: StM (PQ schema0 schema1 m) a -> PQ schema0 schema1 m a
restoreM = (K Connection schema1 -> m (K a schema1)) -> PQ schema1 schema1 m a
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection schema1 -> m (K a schema1))
 -> PQ schema1 schema1 m a)
-> (StM m (K a schema1) -> K Connection schema1 -> m (K a schema1))
-> StM m (K a schema1)
-> PQ schema1 schema1 m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m (K a schema1) -> K Connection schema1 -> m (K a schema1)
forall a b. a -> b -> a
const (m (K a schema1) -> K Connection schema1 -> m (K a schema1))
-> (StM m (K a schema1) -> m (K a schema1))
-> StM m (K a schema1)
-> K Connection schema1
-> m (K a schema1)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. StM m (K a schema1) -> m (K a schema1)
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
  liftBaseWith :: (RunInBase (PQ schema0 schema1 m) b -> b a)
-> PQ schema0 schema1 m a
liftBaseWith RunInBase (PQ schema0 schema1 m) b -> b a
f =
    (PQRun schema0 -> m a) -> PQ schema0 schema0 m a
forall (schema :: SchemasType) a.
Functor m =>
(PQRun schema -> m a) -> PQ schema schema m a
pqliftWith ((PQRun schema0 -> m a) -> PQ schema0 schema0 m a)
-> (PQRun schema0 -> m a) -> PQ schema0 schema0 m a
forall a b. (a -> b) -> a -> b
$ \ PQRun schema0
run -> (RunInBase m b -> b a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m b -> b a) -> m a) -> (RunInBase m b -> b a) -> m a
forall a b. (a -> b) -> a -> b
$ \ RunInBase m b
runInBase -> RunInBase (PQ schema0 schema1 m) b -> b a
f (RunInBase (PQ schema0 schema1 m) b -> b a)
-> RunInBase (PQ schema0 schema1 m) b -> b a
forall a b. (a -> b) -> a -> b
$ m (K a schema1) -> b (StM m (K a schema1))
RunInBase m b
runInBase (m (K a schema1) -> b (StM m (K a schema1)))
-> (PQ schema1 schema1 m a -> m (K a schema1))
-> PQ schema1 schema1 m a
-> b (StM m (K a schema1))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PQ schema1 schema1 m a -> m (K a schema1)
PQRun schema0
run
    where
      pqliftWith :: Functor m => (PQRun schema -> m a) -> PQ schema schema m a
      pqliftWith :: (PQRun schema -> m a) -> PQ schema schema m a
pqliftWith PQRun schema -> m a
g = (K Connection schema -> m (K a schema)) -> PQ schema schema m a
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection schema -> m (K a schema)) -> PQ schema schema m a)
-> (K Connection schema -> m (K a schema)) -> PQ schema schema m a
forall a b. (a -> b) -> a -> b
$ \ K Connection schema
conn ->
        (a -> K a schema) -> m a -> m (K a schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K a schema
forall k a (b :: k). a -> K a b
K (PQRun schema -> m a
g (PQRun schema -> m a) -> PQRun schema -> m a
forall a b. (a -> b) -> a -> b
$ \ PQ schema schema m x
pq -> PQ schema schema m x -> K Connection schema -> m (K x schema)
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 :: e -> PQ db0 db1 m a
throwM = m a -> PQ db1 db1 m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> PQ db1 db1 m a) -> (e -> m a) -> e -> PQ db1 db1 m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance (MonadCatch m, db0 ~ db1)
  => MonadCatch (PQ db0 db1 m) where
  catch :: 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 = (K Connection db0 -> m (K a db1)) -> PQ db0 db1 m a
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db0 -> m (K a db1)) -> PQ db0 db1 m a)
-> (K Connection db0 -> m (K a db1)) -> PQ db0 db1 m a
forall a b. (a -> b) -> a -> b
$ \K Connection db0
k -> K Connection db0 -> m (K a db1)
m K Connection db0
k m (K a db1) -> (e -> m (K a db1)) -> m (K a db1)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> PQ db0 db1 m a -> K Connection db0 -> m (K a db1)
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 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 = (K Connection db0 -> m (K b db1)) -> PQ db0 db1 m b
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db0 -> m (K b db1)) -> PQ db0 db1 m b)
-> (K Connection db0 -> m (K b db1)) -> PQ db0 db1 m b
forall a b. (a -> b) -> a -> b
$ \K Connection db0
e -> ((forall a. m a -> m a) -> m (K b db1)) -> m (K b db1)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (K b db1)) -> m (K b db1))
-> ((forall a. m a -> m a) -> m (K b db1)) -> m (K b db1)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> PQ db0 db1 m b -> K Connection db0 -> m (K b db1)
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. PQ db0 db1 m a -> PQ db0 db1 m a) -> PQ db0 db1 m b)
-> (forall a. PQ db0 db1 m a -> PQ db0 db1 m a) -> PQ db0 db1 m b
forall a b. (a -> b) -> a -> b
$ (m (K a db1) -> m (K a db1)) -> PQ db0 db1 m a -> PQ db0 db1 m a
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 m (K a db1) -> m (K a db1)
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) = (K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
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 (m (K x db1) -> m (K x db1))
-> (K Connection db0 -> m (K x db1))
-> K Connection db0
-> m (K x db1)
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 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 =
    (K Connection db0 -> m (K b db1)) -> PQ db0 db1 m b
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db0 -> m (K b db1)) -> PQ db0 db1 m b)
-> (K Connection db0 -> m (K b db1)) -> PQ db0 db1 m b
forall a b. (a -> b) -> a -> b
$ \K Connection db0
k -> ((forall a. m a -> m a) -> m (K b db1)) -> m (K b db1)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a. m a -> m a) -> m (K b db1)) -> m (K b db1))
-> ((forall a. m a -> m a) -> m (K b db1)) -> m (K b db1)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> PQ db0 db1 m b -> K Connection db0 -> m (K b db1)
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. PQ db0 db1 m a -> PQ db0 db1 m a) -> PQ db0 db1 m b)
-> (forall a. PQ db0 db1 m a -> PQ db0 db1 m a) -> PQ db0 db1 m b
forall a b. (a -> b) -> a -> b
$ (m (K a db1) -> m (K a db1)) -> PQ db0 db1 m a -> PQ db0 db1 m a
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 m (K a db1) -> m (K a db1)
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) = (K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
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 (m (K x db1) -> m (K x db1))
-> (K Connection db0 -> m (K x db1))
-> K Connection db0
-> m (K x db1)
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 :: 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 = (K Connection db0 -> m (K (b, c) db1)) -> PQ db0 db1 m (b, c)
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db0 -> m (K (b, c) db1)) -> PQ db0 db1 m (b, c))
-> (K Connection db0 -> m (K (b, c) db1)) -> PQ db0 db1 m (b, c)
forall a b. (a -> b) -> a -> b
$ \K Connection db0
k ->
    (b, c) -> K (b, c) db1
forall k a (b :: k). a -> K a b
K ((b, c) -> K (b, c) db1) -> m (b, c) -> m (K (b, c) db1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (K a db1 -> a
forall k a (b :: k). K a b -> a
unK (K a db1 -> a) -> m (K a db1) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PQ db0 db1 m a -> K Connection db0 -> m (K a db1)
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 -> K c db1 -> c
forall k a (b :: k). K a b -> a
unK (K c db1 -> c) -> m (K c db1) -> m c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PQ db0 db1 m c -> K Connection db0 -> m (K c db1)
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 -> K b db1 -> b
forall k a (b :: k). K a b -> a
unK (K b db1 -> b) -> m (K b db1) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PQ db0 db1 m b -> K Connection db0 -> m (K b db1)
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 = PQ db0 db1 m (r -> r) -> PQ db1 db1 m r -> PQ db0 db1 m r
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 ((r -> r -> r) -> PQ db0 db1 m r -> PQ db0 db1 m (r -> r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> r -> r
forall a. Semigroup a => a -> a -> a
(<>) PQ db0 db1 m r
f) PQ db0 db1 m r
PQ db1 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 = r -> PQ db0 db1 m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
forall a. Monoid a => a
mempty

instance MonadFix m => MonadFix (PQ db db m) where
  mfix :: (a -> PQ db db m a) -> PQ db db m a
mfix a -> PQ db db m a
f = (K Connection db -> m (K a db)) -> PQ db db m a
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db -> m (K a db)) -> PQ db db m a)
-> (K Connection db -> m (K a db)) -> PQ db db m a
forall a b. (a -> b) -> a -> b
$ \K Connection db
conn -> (K a db -> m (K a db)) -> m (K a db)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((K a db -> m (K a db)) -> m (K a db))
-> (K a db -> m (K a db)) -> m (K a db)
forall a b. (a -> b) -> a -> b
$ \ (K a
a) -> a -> K a db
forall k a (b :: k). a -> K a b
K (a -> K a db) -> m a -> m (K a db)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PQ db db m a -> K Connection db -> m a
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 :: PQ db0 db1 m a
empty = m a -> PQ db0 db1 m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall (f :: * -> *) a. Alternative f => f a
empty
    PQ db0 db1 m a
altL <|> :: PQ db0 db1 m a -> PQ db0 db1 m a -> PQ db0 db1 m a
<|> PQ db0 db1 m a
altR = (K Connection db0 -> m (K a db1)) -> PQ db0 db1 m a
forall (db0 :: SchemasType) (db1 :: SchemasType) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ ((K Connection db0 -> m (K a db1)) -> PQ db0 db1 m a)
-> (K Connection db0 -> m (K a db1)) -> PQ db0 db1 m a
forall a b. (a -> b) -> a -> b
$ \ K Connection db0
conn -> (a -> K a db1) -> m a -> m (K a db1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K a db1
forall k a (b :: k). a -> K a b
K (m a -> m (K a db1)) -> m a -> m (K a db1)
forall a b. (a -> b) -> a -> b
$
      PQ db0 db1 m a -> K Connection db0 -> m 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
altL K Connection db0
conn m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PQ db0 db1 m a -> K Connection db0 -> m 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 :: ByteString -> PQ db0 db1 io x -> io x
withConnection ByteString
connString PQ db0 db1 io x
action =
  K x db1 -> x
forall k a (b :: k). K a b -> a
unK (K x db1 -> x) -> io (K x db1) -> io x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> io (K Connection db0)
-> (K Connection db0 -> io ())
-> (K Connection db0 -> io (K x db1))
-> io (K x db1)
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (ByteString -> io (K Connection db0)
forall (db :: SchemasType) (io :: * -> *).
MonadIO io =>
ByteString -> io (K Connection db)
connectdb ByteString
connString) K Connection db0 -> io ()
forall k (io :: * -> *) (db :: k).
MonadIO io =>
K Connection db -> io ()
finish (PQ db0 db1 io x -> K Connection db0 -> io (K x db1)
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_ :: Result -> io ()
okResult_ Result
result = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  ExecStatus
status <- Result -> IO ExecStatus
LibPQ.resultStatus Result
result
  case ExecStatus
status of
    ExecStatus
LibPQ.CommandOk -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ExecStatus
LibPQ.TuplesOk -> () -> IO ()
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 -> SquealException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO ()) -> SquealException -> IO ()
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 -> SquealException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO ()) -> SquealException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.resultErrorMessage"
            Just ByteString
msg -> SquealException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO ())
-> (SQLState -> SquealException) -> SQLState -> IO ()
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 (SQLState -> IO ()) -> SQLState -> IO ()
forall a b. (a -> b) -> a -> b
$ ExecStatus -> ByteString -> ByteString -> SQLState
SQLState ExecStatus
status ByteString
stateCode ByteString
msg