module Database.PostgreSQL.PQTypes.Internal.Connection
(
Connection(..)
, ConnectionData(..)
, withConnectionData
, ConnectionStats(..)
, ConnectionSettings(..)
, defaultConnectionSettings
, ConnectionSourceM(..)
, ConnectionSource(..)
, simpleSource
, poolSource
, connect
, disconnect
, runQueryIO
, QueryName(..)
, runPreparedQueryIO
) where
import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.Base
import Control.Monad.Catch
import Data.Bifunctor
import Data.IORef
import Data.Kind
import Data.Pool
import Data.String
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Ptr
import GHC.Conc (closeFdWith)
import qualified Control.Exception as E
import qualified Data.ByteString.Char8 as BS
import qualified Data.Foldable as F
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Database.PostgreSQL.PQTypes.Internal.C.Interface
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.Internal.Composite
import Database.PostgreSQL.PQTypes.Internal.Error
import Database.PostgreSQL.PQTypes.Internal.Error.Code
import Database.PostgreSQL.PQTypes.Internal.Exception
import Database.PostgreSQL.PQTypes.Internal.Utils
import Database.PostgreSQL.PQTypes.SQL.Class
import Database.PostgreSQL.PQTypes.SQL.Raw
import Database.PostgreSQL.PQTypes.ToSQL
data ConnectionSettings = ConnectionSettings
{
ConnectionSettings -> Text
csConnInfo :: !T.Text
, ConnectionSettings -> Maybe Text
csClientEncoding :: !(Maybe T.Text)
, ConnectionSettings -> Maybe (RawSQL ())
csRole :: !(Maybe (RawSQL ()))
, ConnectionSettings -> [Text]
csComposites :: ![T.Text]
} deriving (ConnectionSettings -> ConnectionSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionSettings -> ConnectionSettings -> Bool
$c/= :: ConnectionSettings -> ConnectionSettings -> Bool
== :: ConnectionSettings -> ConnectionSettings -> Bool
$c== :: ConnectionSettings -> ConnectionSettings -> Bool
Eq, Eq ConnectionSettings
ConnectionSettings -> ConnectionSettings -> Bool
ConnectionSettings -> ConnectionSettings -> Ordering
ConnectionSettings -> ConnectionSettings -> ConnectionSettings
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConnectionSettings -> ConnectionSettings -> ConnectionSettings
$cmin :: ConnectionSettings -> ConnectionSettings -> ConnectionSettings
max :: ConnectionSettings -> ConnectionSettings -> ConnectionSettings
$cmax :: ConnectionSettings -> ConnectionSettings -> ConnectionSettings
>= :: ConnectionSettings -> ConnectionSettings -> Bool
$c>= :: ConnectionSettings -> ConnectionSettings -> Bool
> :: ConnectionSettings -> ConnectionSettings -> Bool
$c> :: ConnectionSettings -> ConnectionSettings -> Bool
<= :: ConnectionSettings -> ConnectionSettings -> Bool
$c<= :: ConnectionSettings -> ConnectionSettings -> Bool
< :: ConnectionSettings -> ConnectionSettings -> Bool
$c< :: ConnectionSettings -> ConnectionSettings -> Bool
compare :: ConnectionSettings -> ConnectionSettings -> Ordering
$ccompare :: ConnectionSettings -> ConnectionSettings -> Ordering
Ord, Int -> ConnectionSettings -> ShowS
[ConnectionSettings] -> ShowS
ConnectionSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionSettings] -> ShowS
$cshowList :: [ConnectionSettings] -> ShowS
show :: ConnectionSettings -> String
$cshow :: ConnectionSettings -> String
showsPrec :: Int -> ConnectionSettings -> ShowS
$cshowsPrec :: Int -> ConnectionSettings -> ShowS
Show)
defaultConnectionSettings :: ConnectionSettings
defaultConnectionSettings :: ConnectionSettings
defaultConnectionSettings =
ConnectionSettings
{ csConnInfo :: Text
csConnInfo = Text
T.empty
, csClientEncoding :: Maybe Text
csClientEncoding = forall a. a -> Maybe a
Just Text
"UTF-8"
, csRole :: Maybe (RawSQL ())
csRole = forall a. Maybe a
Nothing
, csComposites :: [Text]
csComposites = []
}
data ConnectionStats = ConnectionStats
{
ConnectionStats -> Int
statsQueries :: !Int
, ConnectionStats -> Int
statsRows :: !Int
, ConnectionStats -> Int
statsValues :: !Int
, ConnectionStats -> Int
statsParams :: !Int
} deriving (ConnectionStats -> ConnectionStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionStats -> ConnectionStats -> Bool
$c/= :: ConnectionStats -> ConnectionStats -> Bool
== :: ConnectionStats -> ConnectionStats -> Bool
$c== :: ConnectionStats -> ConnectionStats -> Bool
Eq, Eq ConnectionStats
ConnectionStats -> ConnectionStats -> Bool
ConnectionStats -> ConnectionStats -> Ordering
ConnectionStats -> ConnectionStats -> ConnectionStats
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConnectionStats -> ConnectionStats -> ConnectionStats
$cmin :: ConnectionStats -> ConnectionStats -> ConnectionStats
max :: ConnectionStats -> ConnectionStats -> ConnectionStats
$cmax :: ConnectionStats -> ConnectionStats -> ConnectionStats
>= :: ConnectionStats -> ConnectionStats -> Bool
$c>= :: ConnectionStats -> ConnectionStats -> Bool
> :: ConnectionStats -> ConnectionStats -> Bool
$c> :: ConnectionStats -> ConnectionStats -> Bool
<= :: ConnectionStats -> ConnectionStats -> Bool
$c<= :: ConnectionStats -> ConnectionStats -> Bool
< :: ConnectionStats -> ConnectionStats -> Bool
$c< :: ConnectionStats -> ConnectionStats -> Bool
compare :: ConnectionStats -> ConnectionStats -> Ordering
$ccompare :: ConnectionStats -> ConnectionStats -> Ordering
Ord, Int -> ConnectionStats -> ShowS
[ConnectionStats] -> ShowS
ConnectionStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionStats] -> ShowS
$cshowList :: [ConnectionStats] -> ShowS
show :: ConnectionStats -> String
$cshow :: ConnectionStats -> String
showsPrec :: Int -> ConnectionStats -> ShowS
$cshowsPrec :: Int -> ConnectionStats -> ShowS
Show)
initialStats :: ConnectionStats
initialStats :: ConnectionStats
initialStats = ConnectionStats {
statsQueries :: Int
statsQueries = Int
0
, statsRows :: Int
statsRows = Int
0
, statsValues :: Int
statsValues = Int
0
, statsParams :: Int
statsParams = Int
0
}
data ConnectionData = ConnectionData
{ ConnectionData -> Ptr PGconn
cdPtr :: !(Ptr PGconn)
, ConnectionData -> ConnectionStats
cdStats :: !ConnectionStats
, ConnectionData -> IORef (Set Text)
cdPreparedQueries :: !(IORef (S.Set T.Text))
}
newtype Connection = Connection {
Connection -> MVar (Maybe ConnectionData)
unConnection :: MVar (Maybe ConnectionData)
}
withConnectionData
:: Connection
-> String
-> (ConnectionData -> IO (ConnectionData, r))
-> IO r
withConnectionData :: forall r.
Connection
-> String -> (ConnectionData -> IO (ConnectionData, r)) -> IO r
withConnectionData (Connection MVar (Maybe ConnectionData)
mvc) String
fname ConnectionData -> IO (ConnectionData, r)
f =
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Maybe ConnectionData)
mvc forall a b. (a -> b) -> a -> b
$ \Maybe ConnectionData
mc -> case Maybe ConnectionData
mc of
Maybe ConnectionData
Nothing -> forall a. String -> IO a
hpqTypesError forall a b. (a -> b) -> a -> b
$ String
fname forall a. [a] -> [a] -> [a]
++ String
": no connection"
Just ConnectionData
cd -> forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConnectionData -> IO (ConnectionData, r)
f ConnectionData
cd
newtype ConnectionSourceM m = ConnectionSourceM {
forall (m :: * -> *).
ConnectionSourceM m -> forall r. (Connection -> m r) -> m r
withConnection :: forall r. (Connection -> m r) -> m r
}
newtype ConnectionSource (cs :: [(Type -> Type) -> Constraint]) = ConnectionSource {
forall (cs :: [(* -> *) -> Constraint]).
ConnectionSource cs
-> forall (m :: * -> *). MkConstraint m cs => ConnectionSourceM m
unConnectionSource :: forall m. MkConstraint m cs => ConnectionSourceM m
}
simpleSource
:: ConnectionSettings
-> ConnectionSource [MonadBase IO, MonadMask]
simpleSource :: ConnectionSettings -> ConnectionSource '[MonadBase IO, MonadMask]
simpleSource ConnectionSettings
cs = forall (cs :: [(* -> *) -> Constraint]).
(forall (m :: * -> *). MkConstraint m cs => ConnectionSourceM m)
-> ConnectionSource cs
ConnectionSource forall a b. (a -> b) -> a -> b
$ ConnectionSourceM {
withConnection :: forall r. (Connection -> m r) -> m r
withConnection = forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ ConnectionSettings -> IO Connection
connect ConnectionSettings
cs) (forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IO ()
disconnect)
}
poolSource
:: ConnectionSettings
-> (IO Connection -> (Connection -> IO ()) -> PoolConfig Connection)
-> IO (ConnectionSource [MonadBase IO, MonadMask])
poolSource :: ConnectionSettings
-> (IO Connection
-> (Connection -> IO ()) -> PoolConfig Connection)
-> IO (ConnectionSource '[MonadBase IO, MonadMask])
poolSource ConnectionSettings
cs IO Connection -> (Connection -> IO ()) -> PoolConfig Connection
mkPoolConfig = do
Pool Connection
pool <- forall a. PoolConfig a -> IO (Pool a)
newPool forall a b. (a -> b) -> a -> b
$ IO Connection -> (Connection -> IO ()) -> PoolConfig Connection
mkPoolConfig (ConnectionSettings -> IO Connection
connect ConnectionSettings
cs) Connection -> IO ()
disconnect
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (cs :: [(* -> *) -> Constraint]).
(forall (m :: * -> *). MkConstraint m cs => ConnectionSourceM m)
-> ConnectionSource cs
ConnectionSource forall a b. (a -> b) -> a -> b
$ ConnectionSourceM {
withConnection :: forall r. (Connection -> m r) -> m r
withConnection = forall {f :: * -> *} {t} {b}.
(MonadMask f, MonadBase IO f) =>
Pool t -> (t -> f b) -> f b
doWithConnection Pool Connection
pool forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {m :: * -> *}. MonadBase IO m => Connection -> m Connection
clearStats forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>)
}
where
doWithConnection :: Pool t -> (t -> f b) -> f b
doWithConnection Pool t
pool t -> f b
m = forall a b. (a, b) -> a
fst 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 (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall a. Pool a -> IO (a, LocalPool a)
takeResource Pool t
pool)
(\(t
resource, LocalPool t
local) -> \case
ExitCaseSuccess b
_ -> forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall a. LocalPool a -> a -> IO ()
putResource LocalPool t
local t
resource
ExitCase b
_ -> forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall a. Pool a -> LocalPool a -> a -> IO ()
destroyResource Pool t
pool LocalPool t
local t
resource
)
(\(t
resource, LocalPool t
_) -> t -> f b
m t
resource)
clearStats :: Connection -> m Connection
clearStats conn :: Connection
conn@(Connection MVar (Maybe ConnectionData)
mv) = do
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Maybe ConnectionData)
mv forall a b. (a -> b) -> a -> b
$ \Maybe ConnectionData
mconn ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\ConnectionData
cd -> ConnectionData
cd { cdStats :: ConnectionStats
cdStats = ConnectionStats
initialStats }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ConnectionData
mconn
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn
connect :: ConnectionSettings -> IO Connection
connect :: ConnectionSettings -> IO Connection
connect ConnectionSettings{[Text]
Maybe Text
Maybe (RawSQL ())
Text
csComposites :: [Text]
csRole :: Maybe (RawSQL ())
csClientEncoding :: Maybe Text
csConnInfo :: Text
csComposites :: ConnectionSettings -> [Text]
csRole :: ConnectionSettings -> Maybe (RawSQL ())
csClientEncoding :: ConnectionSettings -> Maybe Text
csConnInfo :: ConnectionSettings -> Text
..} = 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. IO a -> IO a
unmask -> do
Ptr PGconn
connPtr <- forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
T.encodeUtf8 Text
csConnInfo) ((forall a. IO a -> IO a) -> CString -> IO (Ptr PGconn)
openConnection forall a. IO a -> IO a
unmask)
(forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException` Ptr PGconn -> IO ()
c_PQfinish Ptr PGconn
connPtr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
unmask forall a b. (a -> b) -> a -> b
$ do
ConnStatusType
status <- Ptr PGconn -> IO ConnStatusType
c_PQstatus Ptr PGconn
connPtr
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConnStatusType
status forall a. Eq a => a -> a -> Bool
/= ConnStatusType
c_CONNECTION_OK) forall a b. (a -> b) -> a -> b
$
forall a. Ptr PGconn -> String -> IO a
throwLibPQError Ptr PGconn
connPtr String
fname
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ Maybe Text
csClientEncoding forall a b. (a -> b) -> a -> b
$ \Text
enc -> do
CInt
res <- forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
T.encodeUtf8 Text
enc) (Ptr PGconn -> CString -> IO CInt
c_PQsetClientEncoding Ptr PGconn
connPtr)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
res forall a. Eq a => a -> a -> Bool
== -CInt
1) forall a b. (a -> b) -> a -> b
$
forall a. Ptr PGconn -> String -> IO a
throwLibPQError Ptr PGconn
connPtr String
fname
Ptr PGconn -> IO ()
c_PQinitTypes Ptr PGconn
connPtr
Ptr PGconn -> [Text] -> IO ()
registerComposites Ptr PGconn
connPtr [Text]
csComposites
Connection
conn <- do
IORef (Set Text)
preparedQueries <- forall a. a -> IO (IORef a)
newIORef forall a. Set a
S.empty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVar (Maybe ConnectionData) -> Connection
Connection forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO (MVar a)
newMVar forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ConnectionData
{ cdPtr :: Ptr PGconn
cdPtr = Ptr PGconn
connPtr
, cdStats :: ConnectionStats
cdStats = ConnectionStats
initialStats
, cdPreparedQueries :: IORef (Set Text)
cdPreparedQueries = IORef (Set Text)
preparedQueries
}
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ Maybe (RawSQL ())
csRole forall a b. (a -> b) -> a -> b
$ \RawSQL ()
role -> forall sql.
IsSQL sql =>
Connection -> sql -> IO (Int, ForeignPtr PGresult)
runQueryIO Connection
conn forall a b. (a -> b) -> a -> b
$ RawSQL ()
"SET ROLE " forall a. Semigroup a => a -> a -> a
<> RawSQL ()
role
forall (f :: * -> *) a. Applicative f => a -> f a
pure Connection
conn
where
fname :: String
fname = String
"connect"
openConnection :: (forall r. IO r -> IO r) -> CString -> IO (Ptr PGconn)
openConnection :: (forall a. IO a -> IO a) -> CString -> IO (Ptr PGconn)
openConnection forall a. IO a -> IO a
unmask CString
conninfo = do
TMVar (Ptr PGconn)
connVar <- forall a. IO (TMVar a)
newEmptyTMVarIO
TVar Bool
runningVar <- forall a. a -> IO (TVar a)
newTVarIO Bool
True
ThreadId
_ <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ do
Ptr PGconn
conn <- CString -> IO (Ptr PGconn)
c_PQconnectdb CString
conninfo
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar TVar Bool
runningVar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> do
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Ptr PGconn)
connVar Ptr PGconn
conn
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ptr PGconn -> IO ()
c_PQfinish Ptr PGconn
conn
Ptr PGconn
conn <- forall a. STM a -> IO a
atomically (forall a. TMVar a -> STM a
takeTMVar TMVar (Ptr PGconn)
connVar) forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException` do
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
runningVar Bool
False
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Ptr PGconn -> IO ()
c_PQfinish forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TMVar a -> STM (Maybe a)
tryTakeTMVar TMVar (Ptr PGconn)
connVar
(forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException` Ptr PGconn -> IO ()
c_PQfinish Ptr PGconn
conn) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
unmask forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr PGconn
conn forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) forall a b. (a -> b) -> a -> b
$ do
forall a. String -> IO a
throwError String
"PQconnectdb returned a null pointer"
ConnStatusType
status <- Ptr PGconn -> IO ConnStatusType
c_PQstatus Ptr PGconn
conn
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConnStatusType
status forall a. Eq a => a -> a -> Bool
/= ConnStatusType
c_CONNECTION_OK) forall a b. (a -> b) -> a -> b
$ do
Maybe String
merr <- Ptr PGconn -> IO CString
c_PQerrorMessage Ptr PGconn
conn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO (Maybe String)
safePeekCString
let reason :: String
reason = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
err -> String
": " forall a. Semigroup a => a -> a -> a
<> String
err) Maybe String
merr
forall a. String -> IO a
throwError forall a b. (a -> b) -> a -> b
$ String
"openConnection failed" forall a. Semigroup a => a -> a -> a
<> String
reason
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr PGconn
conn
where
throwError :: String -> IO a
throwError :: forall a. String -> IO a
throwError = forall a. String -> IO a
hpqTypesError forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
fname forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
": " forall a. [a] -> [a] -> [a]
++)
disconnect :: Connection -> IO ()
disconnect :: Connection -> IO ()
disconnect (Connection MVar (Maybe ConnectionData)
mvconn) = forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Maybe ConnectionData)
mvconn forall a b. (a -> b) -> a -> b
$ \Maybe ConnectionData
mconn -> do
case Maybe ConnectionData
mconn of
Just ConnectionData
cd -> do
let conn :: Ptr PGconn
conn = ConnectionData -> Ptr PGconn
cdPtr ConnectionData
cd
Ptr PGconn -> IO Fd
c_PQsocket Ptr PGconn
conn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
-1 -> Ptr PGconn -> IO ()
c_PQfinish Ptr PGconn
conn
Fd
fd -> (Fd -> IO ()) -> Fd -> IO ()
closeFdWith (\Fd
_ -> Ptr PGconn -> IO ()
c_PQfinish Ptr PGconn
conn) Fd
fd
Maybe ConnectionData
Nothing -> forall e a. Exception e => e -> IO a
E.throwIO (String -> HPQTypesError
HPQTypesError String
"disconnect: no connection (shouldn't happen)")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
runQueryIO
:: IsSQL sql
=> Connection
-> sql
-> IO (Int, ForeignPtr PGresult)
runQueryIO :: forall sql.
IsSQL sql =>
Connection -> sql -> IO (Int, ForeignPtr PGresult)
runQueryIO Connection
conn sql
sql = do
forall sql.
IsSQL sql =>
String
-> Connection
-> sql
-> (ConnectionData -> IO (Int, ForeignPtr PGresult))
-> IO (Int, ForeignPtr PGresult)
runQueryImpl String
"runQueryIO" Connection
conn sql
sql forall a b. (a -> b) -> a -> b
$ \ConnectionData{Ptr PGconn
IORef (Set Text)
ConnectionStats
cdPreparedQueries :: IORef (Set Text)
cdStats :: ConnectionStats
cdPtr :: Ptr PGconn
cdPreparedQueries :: ConnectionData -> IORef (Set Text)
cdStats :: ConnectionData -> ConnectionStats
cdPtr :: ConnectionData -> Ptr PGconn
..} -> do
let allocParam :: ParamAllocator
allocParam = (forall r. (Ptr PGparam -> IO r) -> IO r) -> ParamAllocator
ParamAllocator forall a b. (a -> b) -> a -> b
$ forall r. Ptr PGconn -> (Ptr PGparam -> IO r) -> IO r
withPGparam Ptr PGconn
cdPtr
forall sql r.
IsSQL sql =>
sql -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL sql
sql ParamAllocator
allocParam forall a b. (a -> b) -> a -> b
$ \Ptr PGparam
param CString
query -> (,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PGparam -> IO CInt
c_PQparamCount Ptr PGparam
param)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr PGconn
-> Ptr PGerror
-> Ptr PGparam
-> CString
-> ResultFormat
-> IO (ForeignPtr PGresult)
c_PQparamExec Ptr PGconn
cdPtr forall a. Ptr a
nullPtr Ptr PGparam
param CString
query ResultFormat
c_RESULT_BINARY
newtype QueryName = QueryName T.Text
deriving (QueryName -> QueryName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryName -> QueryName -> Bool
$c/= :: QueryName -> QueryName -> Bool
== :: QueryName -> QueryName -> Bool
$c== :: QueryName -> QueryName -> Bool
Eq, Eq QueryName
QueryName -> QueryName -> Bool
QueryName -> QueryName -> Ordering
QueryName -> QueryName -> QueryName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QueryName -> QueryName -> QueryName
$cmin :: QueryName -> QueryName -> QueryName
max :: QueryName -> QueryName -> QueryName
$cmax :: QueryName -> QueryName -> QueryName
>= :: QueryName -> QueryName -> Bool
$c>= :: QueryName -> QueryName -> Bool
> :: QueryName -> QueryName -> Bool
$c> :: QueryName -> QueryName -> Bool
<= :: QueryName -> QueryName -> Bool
$c<= :: QueryName -> QueryName -> Bool
< :: QueryName -> QueryName -> Bool
$c< :: QueryName -> QueryName -> Bool
compare :: QueryName -> QueryName -> Ordering
$ccompare :: QueryName -> QueryName -> Ordering
Ord, Int -> QueryName -> ShowS
[QueryName] -> ShowS
QueryName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryName] -> ShowS
$cshowList :: [QueryName] -> ShowS
show :: QueryName -> String
$cshow :: QueryName -> String
showsPrec :: Int -> QueryName -> ShowS
$cshowsPrec :: Int -> QueryName -> ShowS
Show, String -> QueryName
forall a. (String -> a) -> IsString a
fromString :: String -> QueryName
$cfromString :: String -> QueryName
IsString)
runPreparedQueryIO
:: IsSQL sql
=> Connection
-> QueryName
-> sql
-> IO (Int, ForeignPtr PGresult)
runPreparedQueryIO :: forall sql.
IsSQL sql =>
Connection -> QueryName -> sql -> IO (Int, ForeignPtr PGresult)
runPreparedQueryIO Connection
conn (QueryName Text
queryName) sql
sql = do
forall sql.
IsSQL sql =>
String
-> Connection
-> sql
-> (ConnectionData -> IO (Int, ForeignPtr PGresult))
-> IO (Int, ForeignPtr PGresult)
runQueryImpl String
"runPreparedQueryIO" Connection
conn sql
sql forall a b. (a -> b) -> a -> b
$ \ConnectionData{Ptr PGconn
IORef (Set Text)
ConnectionStats
cdPreparedQueries :: IORef (Set Text)
cdStats :: ConnectionStats
cdPtr :: Ptr PGconn
cdPreparedQueries :: ConnectionData -> IORef (Set Text)
cdStats :: ConnectionData -> ConnectionStats
cdPtr :: ConnectionData -> Ptr PGconn
..} -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
queryName) forall a b. (a -> b) -> a -> b
$ do
forall e a. Exception e => e -> IO a
E.throwIO DBException
{ dbeQueryContext :: sql
dbeQueryContext = sql
sql
, dbeError :: HPQTypesError
dbeError = String -> HPQTypesError
HPQTypesError String
"runPreparedQueryIO: unnamed prepared query is not supported"
}
let allocParam :: ParamAllocator
allocParam = (forall r. (Ptr PGparam -> IO r) -> IO r) -> ParamAllocator
ParamAllocator forall a b. (a -> b) -> a -> b
$ forall r. Ptr PGconn -> (Ptr PGparam -> IO r) -> IO r
withPGparam Ptr PGconn
cdPtr
forall sql r.
IsSQL sql =>
sql -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL sql
sql ParamAllocator
allocParam forall a b. (a -> b) -> a -> b
$ \Ptr PGparam
param CString
query -> do
Set Text
preparedQueries <- forall a. IORef a -> IO a
readIORef IORef (Set Text)
cdPreparedQueries
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
T.encodeUtf8 Text
queryName) forall a b. (a -> b) -> a -> b
$ \CString
cname -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
queryName forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Text
preparedQueries) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
E.mask_ forall a b. (a -> b) -> a -> b
$ do
ForeignPtr PGresult
res <- Ptr PGconn
-> Ptr PGerror
-> Ptr PGparam
-> CString
-> CString
-> IO (ForeignPtr PGresult)
c_PQparamPrepare Ptr PGconn
cdPtr forall a. Ptr a
nullPtr Ptr PGparam
param CString
cname CString
query
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PGresult
res forall a b. (a -> b) -> a -> b
$ forall sql.
IsSQL sql =>
sql -> Ptr PGconn -> Ptr PGresult -> IO (Either Int Int)
verifyResult sql
sql Ptr PGconn
cdPtr
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Set Text)
cdPreparedQueries forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
S.insert Text
queryName
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PGparam -> IO CInt
c_PQparamCount Ptr PGparam
param)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr PGconn
-> Ptr PGerror
-> Ptr PGparam
-> CString
-> ResultFormat
-> IO (ForeignPtr PGresult)
c_PQparamExecPrepared Ptr PGconn
cdPtr forall a. Ptr a
nullPtr Ptr PGparam
param CString
cname ResultFormat
c_RESULT_BINARY
runQueryImpl
:: IsSQL sql
=> String
-> Connection
-> sql
-> (ConnectionData -> IO (Int, ForeignPtr PGresult))
-> IO (Int, ForeignPtr PGresult)
runQueryImpl :: forall sql.
IsSQL sql =>
String
-> Connection
-> sql
-> (ConnectionData -> IO (Int, ForeignPtr PGresult))
-> IO (Int, ForeignPtr PGresult)
runQueryImpl String
fname Connection
conn sql
sql ConnectionData -> IO (Int, ForeignPtr PGresult)
execSql = do
(ConnectionData -> IO (ConnectionData, (Int, ForeignPtr PGresult)))
-> IO (Int, ForeignPtr PGresult)
withConnDo forall a b. (a -> b) -> a -> b
$ \cd :: ConnectionData
cd@ConnectionData{Ptr PGconn
IORef (Set Text)
ConnectionStats
cdPreparedQueries :: IORef (Set Text)
cdStats :: ConnectionStats
cdPtr :: Ptr PGconn
cdPreparedQueries :: ConnectionData -> IORef (Set Text)
cdStats :: ConnectionData -> ConnectionStats
cdPtr :: ConnectionData -> Ptr PGconn
..} -> forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
Async (ConnectionData, (Int, ForeignPtr PGresult))
queryRunner <- forall a. IO a -> IO (Async a)
async forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
restore forall a b. (a -> b) -> a -> b
$ do
(Int
paramCount, ForeignPtr PGresult
res) <- ConnectionData -> IO (Int, ForeignPtr PGresult)
execSql ConnectionData
cd
Either Int Int
affected <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PGresult
res forall a b. (a -> b) -> a -> b
$ forall sql.
IsSQL sql =>
sql -> Ptr PGconn -> Ptr PGresult -> IO (Either Int Int)
verifyResult sql
sql Ptr PGconn
cdPtr
ConnectionStats
stats' <- case Either Int Int
affected of
Left Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ConnectionStats
cdStats {
statsQueries :: Int
statsQueries = ConnectionStats -> Int
statsQueries ConnectionStats
cdStats forall a. Num a => a -> a -> a
+ Int
1
, statsParams :: Int
statsParams = ConnectionStats -> Int
statsParams ConnectionStats
cdStats forall a. Num a => a -> a -> a
+ Int
paramCount
}
Right Int
rows -> do
Int
columns <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PGresult
res Ptr PGresult -> IO CInt
c_PQnfields
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectionStats {
statsQueries :: Int
statsQueries = ConnectionStats -> Int
statsQueries ConnectionStats
cdStats forall a. Num a => a -> a -> a
+ Int
1
, statsRows :: Int
statsRows = ConnectionStats -> Int
statsRows ConnectionStats
cdStats forall a. Num a => a -> a -> a
+ Int
rows
, statsValues :: Int
statsValues = ConnectionStats -> Int
statsValues ConnectionStats
cdStats forall a. Num a => a -> a -> a
+ (Int
rows forall a. Num a => a -> a -> a
* Int
columns)
, statsParams :: Int
statsParams = ConnectionStats -> Int
statsParams ConnectionStats
cdStats forall a. Num a => a -> a -> a
+ Int
paramCount
}
ConnectionStats
stats' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionData
cd { cdStats :: ConnectionStats
cdStats = ConnectionStats
stats' }, (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id Either Int Int
affected, ForeignPtr PGresult
res))
forall a b. IO a -> IO b -> IO a
E.onException (forall a. IO a -> IO a
restore forall a b. (a -> b) -> a -> b
$ forall a. Async a -> IO a
wait Async (ConnectionData, (Int, ForeignPtr PGresult))
queryRunner) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
E.uninterruptibleMask_ forall a b. (a -> b) -> a -> b
$ do
Ptr PGconn -> IO (Maybe String)
c_PQcancel Ptr PGconn
cdPtr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe String
Nothing -> forall a. Async a -> IO ()
cancel Async (ConnectionData, (Int, ForeignPtr PGresult))
queryRunner
Just String
_ -> forall a. Async a -> IO (Maybe (Either SomeException a))
poll Async (ConnectionData, (Int, ForeignPtr PGresult))
queryRunner forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Either SomeException (ConnectionData, (Int, ForeignPtr PGresult))
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe
(Either SomeException (ConnectionData, (Int, ForeignPtr PGresult)))
Nothing -> do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Ptr PGconn -> IO (Maybe String)
c_PQcancel Ptr PGconn
cdPtr
forall a. Async a -> IO ()
cancel Async (ConnectionData, (Int, ForeignPtr PGresult))
queryRunner
where
withConnDo :: (ConnectionData -> IO (ConnectionData, (Int, ForeignPtr PGresult)))
-> IO (Int, ForeignPtr PGresult)
withConnDo = forall r.
Connection
-> String -> (ConnectionData -> IO (ConnectionData, r)) -> IO r
withConnectionData Connection
conn String
fname
verifyResult :: IsSQL sql => sql -> Ptr PGconn -> Ptr PGresult -> IO (Either Int Int)
verifyResult :: forall sql.
IsSQL sql =>
sql -> Ptr PGconn -> Ptr PGresult -> IO (Either Int Int)
verifyResult sql
sql Ptr PGconn
conn Ptr PGresult
res = do
ExecStatusType
rst <- Ptr PGresult -> IO ExecStatusType
c_PQresultStatus Ptr PGresult
res
case ExecStatusType
rst of
ExecStatusType
_ | ExecStatusType
rst forall a. Eq a => a -> a -> Bool
== ExecStatusType
c_PGRES_COMMAND_OK -> do
ByteString
sn <- Ptr PGresult -> IO CString
c_PQcmdTuples Ptr PGresult
res forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO ByteString
BS.packCString
case ByteString -> Maybe (Int, ByteString)
BS.readInt ByteString
sn of
Maybe (Int, ByteString)
Nothing
| ByteString -> Bool
BS.null ByteString
sn -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Int
0
| Bool
otherwise -> ByteString -> IO (Either Int Int)
throwParseError ByteString
sn
Just (Int
n, ByteString
rest)
| ByteString
rest forall a. Eq a => a -> a -> Bool
/= ByteString
BS.empty -> ByteString -> IO (Either Int Int)
throwParseError ByteString
sn
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Int
n
ExecStatusType
_ | ExecStatusType
rst forall a. Eq a => a -> a -> Bool
== ExecStatusType
c_PGRES_TUPLES_OK -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PGresult -> IO CInt
c_PQntuples Ptr PGresult
res
ExecStatusType
_ | ExecStatusType
rst forall a. Eq a => a -> a -> Bool
== ExecStatusType
c_PGRES_FATAL_ERROR -> IO (Either Int Int)
throwSQLError
ExecStatusType
_ | ExecStatusType
rst forall a. Eq a => a -> a -> Bool
== ExecStatusType
c_PGRES_BAD_RESPONSE -> IO (Either Int Int)
throwSQLError
ExecStatusType
_ | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Int
0
where
throwSQLError :: IO (Either Int Int)
throwSQLError = forall sql a. IsSQL sql => sql -> SomeException -> IO a
rethrowWithContext sql
sql forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< if Ptr PGresult
res forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
E.toException forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QueryError
QueryError
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CString -> IO String
safePeekCString' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PGconn -> IO CString
c_PQerrorMessage Ptr PGconn
conn
else forall e. Exception e => e -> SomeException
E.toException forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String
-> ErrorCode
-> String
-> Maybe String
-> Maybe String
-> Maybe Int
-> Maybe Int
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe Int
-> Maybe String
-> DetailedQueryError
DetailedQueryError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ErrorField -> IO String
field ErrorField
c_PG_DIAG_SEVERITY
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ErrorCode
stringToErrorCode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ErrorField -> IO String
field ErrorField
c_PG_DIAG_SQLSTATE)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ErrorField -> IO String
field ErrorField
c_PG_DIAG_MESSAGE_PRIMARY
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ErrorField -> IO (Maybe String)
mfield ErrorField
c_PG_DIAG_MESSAGE_DETAIL
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ErrorField -> IO (Maybe String)
mfield ErrorField
c_PG_DIAG_MESSAGE_HINT
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. Read a => String -> Maybe a
mread forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ErrorField -> IO (Maybe String)
mfield ErrorField
c_PG_DIAG_STATEMENT_POSITION)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. Read a => String -> Maybe a
mread forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ErrorField -> IO (Maybe String)
mfield ErrorField
c_PG_DIAG_INTERNAL_POSITION)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ErrorField -> IO (Maybe String)
mfield ErrorField
c_PG_DIAG_INTERNAL_QUERY
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ErrorField -> IO (Maybe String)
mfield ErrorField
c_PG_DIAG_CONTEXT
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ErrorField -> IO (Maybe String)
mfield ErrorField
c_PG_DIAG_SOURCE_FILE
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. Read a => String -> Maybe a
mread forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ErrorField -> IO (Maybe String)
mfield ErrorField
c_PG_DIAG_SOURCE_LINE)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ErrorField -> IO (Maybe String)
mfield ErrorField
c_PG_DIAG_SOURCE_FUNCTION)
where
field :: ErrorField -> IO String
field ErrorField
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ErrorField -> IO (Maybe String)
mfield ErrorField
f
mfield :: ErrorField -> IO (Maybe String)
mfield ErrorField
f = CString -> IO (Maybe String)
safePeekCString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PGresult -> ErrorField -> IO CString
c_PQresultErrorField Ptr PGresult
res ErrorField
f
throwParseError :: ByteString -> IO (Either Int Int)
throwParseError ByteString
sn = forall e a. Exception e => e -> IO a
E.throwIO DBException {
dbeQueryContext :: sql
dbeQueryContext = sql
sql
, dbeError :: HPQTypesError
dbeError = String -> HPQTypesError
HPQTypesError (String
"verifyResult: string returned by PQcmdTuples is not a valid number: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
sn)
}