module Database.PostgreSQL.PQTypes.Internal.Query
  ( runQueryIO
  , QueryName(..)
  , runPreparedQueryIO
  ) where

import Control.Concurrent.Async
import Control.Monad
import Data.IORef
import Data.String
import Foreign.ForeignPtr
import Foreign.Ptr
import qualified Control.Exception as E
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Set as S

import Database.PostgreSQL.PQTypes.Internal.C.Interface
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.Internal.Connection
import Database.PostgreSQL.PQTypes.Internal.Error
import Database.PostgreSQL.PQTypes.Internal.Error.Code
import Database.PostgreSQL.PQTypes.Internal.Exception
import Database.PostgreSQL.PQTypes.Internal.QueryResult
import Database.PostgreSQL.PQTypes.Internal.State
import Database.PostgreSQL.PQTypes.Internal.Utils
import Database.PostgreSQL.PQTypes.SQL.Class
import Database.PostgreSQL.PQTypes.ToSQL

-- | Low-level function for running an SQL query.
runQueryIO
  :: IsSQL sql
  => sql
  -> DBState m
  -> IO (Int, DBState m)
runQueryIO :: forall sql (m :: * -> *).
IsSQL sql =>
sql -> DBState m -> IO (Int, DBState m)
runQueryIO sql
sql = forall sql (m :: * -> *).
IsSQL sql =>
String
-> sql
-> (ConnectionData -> IO (Int, ForeignPtr PGresult))
-> DBState m
-> IO (Int, DBState m)
runQueryImpl String
"runQueryIO" sql
sql forall a b. (a -> b) -> a -> b
$ \ConnectionData{Ptr PGconn
IORef (Set Text)
ConnectionStats
cdPreparedQueries :: ConnectionData -> IORef (Set Text)
cdStats :: ConnectionData -> ConnectionStats
cdPtr :: ConnectionData -> Ptr PGconn
cdPreparedQueries :: IORef (Set Text)
cdStats :: ConnectionStats
cdPtr :: 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

-- | Name of a prepared query.
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)

-- | Low-level function for running a prepared SQL query.
runPreparedQueryIO
  :: IsSQL sql
  => QueryName
  -> sql
  -> DBState m
  -> IO (Int, DBState m)
runPreparedQueryIO :: forall sql (m :: * -> *).
IsSQL sql =>
QueryName -> sql -> DBState m -> IO (Int, DBState m)
runPreparedQueryIO (QueryName Text
queryName) sql
sql = do
  forall sql (m :: * -> *).
IsSQL sql =>
String
-> sql
-> (ConnectionData -> IO (Int, ForeignPtr PGresult))
-> DBState m
-> IO (Int, DBState m)
runQueryImpl String
"runPreparedQueryIO" 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
          -- Mask asynchronous exceptions, because if preparation of the query
          -- succeeds, we need to reflect that fact in cdPreparedQueries since
          -- you can't prepare a query with the same name more than once.
          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

----------------------------------------
-- Helpers

-- | Shared implementation of 'runQueryIO' and 'runPreparedQueryIO'.
runQueryImpl
  :: IsSQL sql
  => String
  -> sql
  -> (ConnectionData -> IO (Int, ForeignPtr PGresult))
  -> DBState m
  -> IO (Int, DBState m)
runQueryImpl :: forall sql (m :: * -> *).
IsSQL sql =>
String
-> sql
-> (ConnectionData -> IO (Int, ForeignPtr PGresult))
-> DBState m
-> IO (Int, DBState m)
runQueryImpl String
fname sql
sql ConnectionData -> IO (Int, ForeignPtr PGresult)
execSql DBState m
st = do
  (Int
affected, ForeignPtr PGresult
res) <- (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
    -- While the query runs, the current thread will not be able to receive
    -- asynchronous exceptions. This prevents clients of the library from
    -- interrupting execution of the query. To remedy that we spawn a separate
    -- thread for the query execution and while we wait for its completion, we
    -- are able to receive asynchronous exceptions (assuming that threaded GHC
    -- runtime system is used) and react appropriately.
    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
          }
      -- Force evaluation of modified stats to squash a space leak.
      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))
    -- If we receive an exception while waiting for the execution to complete,
    -- we need to send a request to PostgreSQL for query cancellation and wait
    -- for the query runner thread to terminate. It is paramount we make the
    -- exception handler uninterruptible as we can't exit from the main block
    -- until the query runner thread has terminated.
    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
        -- If query cancellation request was successfully processed, there is
        -- nothing else to do apart from waiting for the runner to terminate.
        Maybe String
Nothing -> forall a. Async a -> IO ()
cancel Async (ConnectionData, (Int, ForeignPtr PGresult))
queryRunner
        -- Otherwise we check what happened with the runner. If it already
        -- finished we're fine, just ignore the result. If it didn't, something
        -- weird is going on. Maybe the cancellation request went through when
        -- the thread wasn't making a request to the server? In any case, try to
        -- cancel again and wait for the thread to terminate.
        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

  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
affected, DBState m
st {
    dbLastQuery :: SomeSQL
dbLastQuery = if forall (m :: * -> *). DBState m -> Bool
dbRecordLastQuery DBState m
st then forall sql. IsSQL sql => sql -> SomeSQL
SomeSQL sql
sql else forall (m :: * -> *). DBState m -> SomeSQL
dbLastQuery DBState m
st
  , dbQueryResult :: forall row. FromRow row => Maybe (QueryResult row)
dbQueryResult = forall a. a -> Maybe a
Just QueryResult {
      qrSQL :: SomeSQL
qrSQL = forall sql. IsSQL sql => sql -> SomeSQL
SomeSQL sql
sql
    , qrResult :: ForeignPtr PGresult
qrResult = ForeignPtr PGresult
res
    , qrFromRow :: row -> row
qrFromRow = forall a. a -> a
id
    }
  })
  where
    withConnDo :: (ConnectionData -> IO (ConnectionData, (Int, ForeignPtr PGresult)))
-> IO (Int, ForeignPtr PGresult)
withConnDo = forall r.
Connection
-> String -> (ConnectionData -> IO (ConnectionData, r)) -> IO r
withConnectionData (forall (m :: * -> *). DBState m -> Connection
dbConnection DBState m
st) 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
  -- works even if res is NULL
  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)
      }