{-# LANGUAGE TypeApplications #-}
module Database.PostgreSQL.PQTypes.FromRow (
    FromRow(..)
  , fromRow'
  ) where

import Data.Functor.Identity
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import qualified Control.Exception as E
import qualified Data.ByteString.Unsafe as BS

import Database.PostgreSQL.PQTypes.Format
import Database.PostgreSQL.PQTypes.FromSQL
import Database.PostgreSQL.PQTypes.Internal.C.Get
import Database.PostgreSQL.PQTypes.Internal.C.Interface
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.Internal.Error
import Database.PostgreSQL.PQTypes.Internal.Utils

-- | Convert base (libpqtypes) type to destination type.
convert :: FromSQL t => Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert :: forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
tuple CInt
column PQBase t
base = do
  CInt
isNull <- Ptr PGresult -> CInt -> CInt -> IO CInt
c_PQgetisnull Ptr PGresult
res CInt
tuple CInt
column
  forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL (if CInt
isNull forall a. Eq a => a -> a -> Bool
== CInt
1 then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just PQBase t
base)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` forall a. SomeException -> IO a
rethrowWithConvError
  where
    rethrowWithConvError :: E.SomeException -> IO a
    rethrowWithConvError :: forall a. SomeException -> IO a
rethrowWithConvError (E.SomeException e
e) = do
      String
colname <- CString -> IO String
safePeekCString' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PGresult -> CInt -> IO CString
c_PQfname Ptr PGresult
res CInt
column
      forall e a. Exception e => e -> IO a
E.throwIO ConversionError {
        convColumn :: Int
convColumn = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
column forall a. Num a => a -> a -> a
+ Int
1
      , convColumnName :: String
convColumnName = String
colname
      , convRow :: Int
convRow = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
tuple forall a. Num a => a -> a -> a
+ Int
1
      , convError :: e
convError = e
e
      }

-- | 'verifyPQTRes' specialized for usage in 'fromRow'.
verify :: Ptr PGerror -> CInt -> IO ()
verify :: Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err = Ptr PGerror -> String -> CInt -> IO ()
verifyPQTRes Ptr PGerror
err String
"fromRow"

withFormat :: forall row. FromRow row => (CString -> IO row) -> IO row
withFormat :: forall row. FromRow row => (CString -> IO row) -> IO row
withFormat = forall a. ByteString -> (CString -> IO a) -> IO a
BS.unsafeUseAsCString forall a b. (a -> b) -> a -> b
$ forall t. PQFormat t => ByteString
pqFormat0 @row

----------------------------------------

-- | More convenient version of 'fromRow' that allocates 'PGerror' by itself.
fromRow' :: forall row. FromRow row => Ptr PGresult -> CInt -> CInt -> IO row
fromRow' :: forall row. FromRow row => Ptr PGresult -> CInt -> CInt -> IO row
fromRow' Ptr PGresult
res CInt
b CInt
i = forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> forall row.
FromRow row =>
Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO row
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i

-- | Class which represents \"from SQL row to Haskell tuple\" transformation.
class PQFormat row => FromRow row where
  -- | Extract SQL row from 'PGresult' and convert it into a tuple.
  fromRow  :: Ptr PGresult -- ^ Source result.
           -> Ptr PGerror  -- ^ Local error info.
           -> CInt         -- ^ Base position for c_PQgetf.
           -> CInt         -- ^ Index of row to be extracted.
           -> IO row

instance (
    FromRow row1, FromRow row2
  ) => FromRow (row1 :*: row2) where
    fromRow :: Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO (row1 :*: row2)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall a b. a -> b -> a :*: b
(:*:)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall row.
FromRow row =>
Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO row
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b  CInt
i
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall row.
FromRow row =>
Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO row
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b' CInt
i
      where
        b' :: CInt
b' = CInt
b forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall t. PQFormat t => Int
pqVariables @row1)

instance FromRow () where
  fromRow :: Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO ()
fromRow Ptr PGresult
_ Ptr PGerror
_ CInt
_ CInt
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance FromSQL t => FromRow (Identity t) where
  fromRow :: Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO (Identity t)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t)
p1 -> do
    Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1.
Ptr PGresult
-> Ptr PGerror -> CInt -> CString -> CInt -> Ptr t1 -> IO CInt
c_PQgetf1 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t)
p1
    t
t <- forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Identity a
Identity t
t)

instance (
    FromSQL t1, FromSQL t2
  ) => FromRow (t1, t2) where
    fromRow :: Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO (t1, t2)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> IO CInt
c_PQgetf2 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1
        (,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3
  ) => FromRow (t1, t2, t3) where
    fromRow :: Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO (t1, t2, t3)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> IO CInt
c_PQgetf3 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2
        (,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4
  ) => FromRow (t1, t2, t3, t4) where
    fromRow :: Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO (t1, t2, t3, t4)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> IO CInt
c_PQgetf4 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3
        (,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5
  ) => FromRow (t1, t2, t3, t4, t5) where
    fromRow :: Ptr PGresult
-> Ptr PGerror -> CInt -> CInt -> IO (t1, t2, t3, t4, t5)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> IO CInt
c_PQgetf5 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4
        (,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  ) => FromRow (t1, t2, t3, t4, t5, t6) where
    fromRow :: Ptr PGresult
-> Ptr PGerror -> CInt -> CInt -> IO (t1, t2, t3, t4, t5, t6)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> IO CInt
c_PQgetf6 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5
        (,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7) where
    fromRow :: Ptr PGresult
-> Ptr PGerror -> CInt -> CInt -> IO (t1, t2, t3, t4, t5, t6, t7)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> IO CInt
c_PQgetf7 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6
        (,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO (t1, t2, t3, t4, t5, t6, t7, t8)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> IO CInt
c_PQgetf8 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7
        (,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO (t1, t2, t3, t4, t5, t6, t7, t8, t9)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> IO CInt
c_PQgetf9 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8
        (,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> IO CInt
c_PQgetf10 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9
        (,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> IO CInt
c_PQgetf11 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10
        (,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> IO CInt
c_PQgetf12 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11
        (,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> IO CInt
c_PQgetf13 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12
        (,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> IO CInt
c_PQgetf14 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13
        (,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> IO CInt
c_PQgetf15 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14
        (,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> IO CInt
c_PQgetf16 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15
        (,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> IO CInt
c_PQgetf17 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16
        (,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> IO CInt
c_PQgetf18 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17
        (,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> IO CInt
c_PQgetf19 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18
        (,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> IO CInt
c_PQgetf20 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19
        (,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> IO CInt
c_PQgetf21 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20
        (,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> IO CInt
c_PQgetf22 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21
        (,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> IO CInt
c_PQgetf23 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22
        (,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> IO CInt
c_PQgetf24 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23
        (,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> IO CInt
c_PQgetf25 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24
        (,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> IO CInt
c_PQgetf26 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25
        (,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> IO CInt
c_PQgetf27 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26
        (,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> IO CInt
c_PQgetf28 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> IO CInt
c_PQgetf29 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> IO CInt
c_PQgetf30 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> IO CInt
c_PQgetf31 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> IO CInt
c_PQgetf32 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> IO CInt
c_PQgetf33 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33
       t34.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> IO CInt
c_PQgetf34 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> IO CInt
c_PQgetf35 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> IO CInt
c_PQgetf36 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> IO CInt
c_PQgetf37 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> IO CInt
c_PQgetf38 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38, FromSQL t39
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t39)
p38 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38 t39.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> CInt
-> Ptr t39
-> IO CInt
c_PQgetf39 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37 (CInt
bforall a. Num a => a -> a -> a
+CInt
38) Ptr (PQBase t39)
p38
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t39)
p38 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
38))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38, FromSQL t39, FromSQL t40
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t39)
p38 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t40)
p39 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38 t39 t40.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> CInt
-> Ptr t39
-> CInt
-> Ptr t40
-> IO CInt
c_PQgetf40 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37 (CInt
bforall a. Num a => a -> a -> a
+CInt
38) Ptr (PQBase t39)
p38 (CInt
bforall a. Num a => a -> a -> a
+CInt
39) Ptr (PQBase t40)
p39
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t39)
p38 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
38)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t40)
p39 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
39))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38, FromSQL t39, FromSQL t40, FromSQL t41
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t39)
p38 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t40)
p39 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t41)
p40 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38 t39 t40 t41.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> CInt
-> Ptr t39
-> CInt
-> Ptr t40
-> CInt
-> Ptr t41
-> IO CInt
c_PQgetf41 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37 (CInt
bforall a. Num a => a -> a -> a
+CInt
38) Ptr (PQBase t39)
p38 (CInt
bforall a. Num a => a -> a -> a
+CInt
39) Ptr (PQBase t40)
p39 (CInt
bforall a. Num a => a -> a -> a
+CInt
40) Ptr (PQBase t41)
p40
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t39)
p38 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
38)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t40)
p39 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
39))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t41)
p40 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
40))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38, FromSQL t39, FromSQL t40, FromSQL t41, FromSQL t42
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41,
      t42)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t39)
p38 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t40)
p39 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t41)
p40 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t42)
p41 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38 t39 t40 t41 t42.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> CInt
-> Ptr t39
-> CInt
-> Ptr t40
-> CInt
-> Ptr t41
-> CInt
-> Ptr t42
-> IO CInt
c_PQgetf42 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37 (CInt
bforall a. Num a => a -> a -> a
+CInt
38) Ptr (PQBase t39)
p38 (CInt
bforall a. Num a => a -> a -> a
+CInt
39) Ptr (PQBase t40)
p39 (CInt
bforall a. Num a => a -> a -> a
+CInt
40) Ptr (PQBase t41)
p40 (CInt
bforall a. Num a => a -> a -> a
+CInt
41) Ptr (PQBase t42)
p41
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t39)
p38 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
38)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t40)
p39 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
39))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t41)
p40 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
40)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t42)
p41 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
41))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38, FromSQL t39, FromSQL t40, FromSQL t41, FromSQL t42
  , FromSQL t43
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41,
      t42, t43)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t39)
p38 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t40)
p39 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t41)
p40 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t42)
p41 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t43)
p42 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38 t39 t40 t41 t42 t43.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> CInt
-> Ptr t39
-> CInt
-> Ptr t40
-> CInt
-> Ptr t41
-> CInt
-> Ptr t42
-> CInt
-> Ptr t43
-> IO CInt
c_PQgetf43 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37 (CInt
bforall a. Num a => a -> a -> a
+CInt
38) Ptr (PQBase t39)
p38 (CInt
bforall a. Num a => a -> a -> a
+CInt
39) Ptr (PQBase t40)
p39 (CInt
bforall a. Num a => a -> a -> a
+CInt
40) Ptr (PQBase t41)
p40 (CInt
bforall a. Num a => a -> a -> a
+CInt
41) Ptr (PQBase t42)
p41 (CInt
bforall a. Num a => a -> a -> a
+CInt
42) Ptr (PQBase t43)
p42
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t39)
p38 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
38)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t40)
p39 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
39))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t41)
p40 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
40)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t42)
p41 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
41))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t43)
p42 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
42))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38, FromSQL t39, FromSQL t40, FromSQL t41, FromSQL t42
  , FromSQL t43, FromSQL t44
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41,
      t42, t43, t44)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t39)
p38 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t40)
p39 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t41)
p40 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t42)
p41 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t43)
p42 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t44)
p43 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38 t39 t40 t41 t42 t43 t44.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> CInt
-> Ptr t39
-> CInt
-> Ptr t40
-> CInt
-> Ptr t41
-> CInt
-> Ptr t42
-> CInt
-> Ptr t43
-> CInt
-> Ptr t44
-> IO CInt
c_PQgetf44 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37 (CInt
bforall a. Num a => a -> a -> a
+CInt
38) Ptr (PQBase t39)
p38 (CInt
bforall a. Num a => a -> a -> a
+CInt
39) Ptr (PQBase t40)
p39 (CInt
bforall a. Num a => a -> a -> a
+CInt
40) Ptr (PQBase t41)
p40 (CInt
bforall a. Num a => a -> a -> a
+CInt
41) Ptr (PQBase t42)
p41 (CInt
bforall a. Num a => a -> a -> a
+CInt
42) Ptr (PQBase t43)
p42 (CInt
bforall a. Num a => a -> a -> a
+CInt
43) Ptr (PQBase t44)
p43
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t39)
p38 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
38)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t40)
p39 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
39))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t41)
p40 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
40)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t42)
p41 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
41))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t43)
p42 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
42)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t44)
p43 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
43))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38, FromSQL t39, FromSQL t40, FromSQL t41, FromSQL t42
  , FromSQL t43, FromSQL t44, FromSQL t45
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44, t45) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41,
      t42, t43, t44, t45)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t39)
p38 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t40)
p39 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t41)
p40 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t42)
p41 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t43)
p42 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t44)
p43 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t45)
p44 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> CInt
-> Ptr t39
-> CInt
-> Ptr t40
-> CInt
-> Ptr t41
-> CInt
-> Ptr t42
-> CInt
-> Ptr t43
-> CInt
-> Ptr t44
-> CInt
-> Ptr t45
-> IO CInt
c_PQgetf45 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37 (CInt
bforall a. Num a => a -> a -> a
+CInt
38) Ptr (PQBase t39)
p38 (CInt
bforall a. Num a => a -> a -> a
+CInt
39) Ptr (PQBase t40)
p39 (CInt
bforall a. Num a => a -> a -> a
+CInt
40) Ptr (PQBase t41)
p40 (CInt
bforall a. Num a => a -> a -> a
+CInt
41) Ptr (PQBase t42)
p41 (CInt
bforall a. Num a => a -> a -> a
+CInt
42) Ptr (PQBase t43)
p42 (CInt
bforall a. Num a => a -> a -> a
+CInt
43) Ptr (PQBase t44)
p43 (CInt
bforall a. Num a => a -> a -> a
+CInt
44) Ptr (PQBase t45)
p44
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t39)
p38 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
38)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t40)
p39 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
39))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t41)
p40 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
40)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t42)
p41 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
41))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t43)
p42 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
42)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t44)
p43 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
43))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t45)
p44 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
44))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38, FromSQL t39, FromSQL t40, FromSQL t41, FromSQL t42
  , FromSQL t43, FromSQL t44, FromSQL t45, FromSQL t46
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44, t45, t46) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41,
      t42, t43, t44, t45, t46)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t39)
p38 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t40)
p39 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t41)
p40 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t42)
p41 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t43)
p42 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t44)
p43 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t45)
p44 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t46)
p45 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> CInt
-> Ptr t39
-> CInt
-> Ptr t40
-> CInt
-> Ptr t41
-> CInt
-> Ptr t42
-> CInt
-> Ptr t43
-> CInt
-> Ptr t44
-> CInt
-> Ptr t45
-> CInt
-> Ptr t46
-> IO CInt
c_PQgetf46 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37 (CInt
bforall a. Num a => a -> a -> a
+CInt
38) Ptr (PQBase t39)
p38 (CInt
bforall a. Num a => a -> a -> a
+CInt
39) Ptr (PQBase t40)
p39 (CInt
bforall a. Num a => a -> a -> a
+CInt
40) Ptr (PQBase t41)
p40 (CInt
bforall a. Num a => a -> a -> a
+CInt
41) Ptr (PQBase t42)
p41 (CInt
bforall a. Num a => a -> a -> a
+CInt
42) Ptr (PQBase t43)
p42 (CInt
bforall a. Num a => a -> a -> a
+CInt
43) Ptr (PQBase t44)
p43 (CInt
bforall a. Num a => a -> a -> a
+CInt
44) Ptr (PQBase t45)
p44 (CInt
bforall a. Num a => a -> a -> a
+CInt
45) Ptr (PQBase t46)
p45
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t39)
p38 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
38)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t40)
p39 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
39))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t41)
p40 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
40)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t42)
p41 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
41))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t43)
p42 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
42)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t44)
p43 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
43))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t45)
p44 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
44)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t46)
p45 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
45))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38, FromSQL t39, FromSQL t40, FromSQL t41, FromSQL t42
  , FromSQL t43, FromSQL t44, FromSQL t45, FromSQL t46, FromSQL t47
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44, t45, t46, t47) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41,
      t42, t43, t44, t45, t46, t47)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t39)
p38 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t40)
p39 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t41)
p40 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t42)
p41 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t43)
p42 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t44)
p43 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t45)
p44 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t46)
p45 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t47)
p46 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> CInt
-> Ptr t39
-> CInt
-> Ptr t40
-> CInt
-> Ptr t41
-> CInt
-> Ptr t42
-> CInt
-> Ptr t43
-> CInt
-> Ptr t44
-> CInt
-> Ptr t45
-> CInt
-> Ptr t46
-> CInt
-> Ptr t47
-> IO CInt
c_PQgetf47 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37 (CInt
bforall a. Num a => a -> a -> a
+CInt
38) Ptr (PQBase t39)
p38 (CInt
bforall a. Num a => a -> a -> a
+CInt
39) Ptr (PQBase t40)
p39 (CInt
bforall a. Num a => a -> a -> a
+CInt
40) Ptr (PQBase t41)
p40 (CInt
bforall a. Num a => a -> a -> a
+CInt
41) Ptr (PQBase t42)
p41 (CInt
bforall a. Num a => a -> a -> a
+CInt
42) Ptr (PQBase t43)
p42 (CInt
bforall a. Num a => a -> a -> a
+CInt
43) Ptr (PQBase t44)
p43 (CInt
bforall a. Num a => a -> a -> a
+CInt
44) Ptr (PQBase t45)
p44 (CInt
bforall a. Num a => a -> a -> a
+CInt
45) Ptr (PQBase t46)
p45 (CInt
bforall a. Num a => a -> a -> a
+CInt
46) Ptr (PQBase t47)
p46
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t39)
p38 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
38)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t40)
p39 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
39))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t41)
p40 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
40)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t42)
p41 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
41))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t43)
p42 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
42)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t44)
p43 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
43))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t45)
p44 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
44)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t46)
p45 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
45))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t47)
p46 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
46))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38, FromSQL t39, FromSQL t40, FromSQL t41, FromSQL t42
  , FromSQL t43, FromSQL t44, FromSQL t45, FromSQL t46, FromSQL t47, FromSQL t48
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44, t45, t46, t47, t48) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41,
      t42, t43, t44, t45, t46, t47, t48)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t39)
p38 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t40)
p39 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t41)
p40 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t42)
p41 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t43)
p42 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t44)
p43 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t45)
p44 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t46)
p45 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t47)
p46 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t48)
p47 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> CInt
-> Ptr t39
-> CInt
-> Ptr t40
-> CInt
-> Ptr t41
-> CInt
-> Ptr t42
-> CInt
-> Ptr t43
-> CInt
-> Ptr t44
-> CInt
-> Ptr t45
-> CInt
-> Ptr t46
-> CInt
-> Ptr t47
-> CInt
-> Ptr t48
-> IO CInt
c_PQgetf48 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37 (CInt
bforall a. Num a => a -> a -> a
+CInt
38) Ptr (PQBase t39)
p38 (CInt
bforall a. Num a => a -> a -> a
+CInt
39) Ptr (PQBase t40)
p39 (CInt
bforall a. Num a => a -> a -> a
+CInt
40) Ptr (PQBase t41)
p40 (CInt
bforall a. Num a => a -> a -> a
+CInt
41) Ptr (PQBase t42)
p41 (CInt
bforall a. Num a => a -> a -> a
+CInt
42) Ptr (PQBase t43)
p42 (CInt
bforall a. Num a => a -> a -> a
+CInt
43) Ptr (PQBase t44)
p43 (CInt
bforall a. Num a => a -> a -> a
+CInt
44) Ptr (PQBase t45)
p44 (CInt
bforall a. Num a => a -> a -> a
+CInt
45) Ptr (PQBase t46)
p45 (CInt
bforall a. Num a => a -> a -> a
+CInt
46) Ptr (PQBase t47)
p46 (CInt
bforall a. Num a => a -> a -> a
+CInt
47) Ptr (PQBase t48)
p47
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t39)
p38 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
38)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t40)
p39 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
39))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t41)
p40 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
40)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t42)
p41 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
41))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t43)
p42 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
42)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t44)
p43 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
43))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t45)
p44 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
44)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t46)
p45 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
45))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t47)
p46 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
46)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t48)
p47 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
47))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38, FromSQL t39, FromSQL t40, FromSQL t41, FromSQL t42
  , FromSQL t43, FromSQL t44, FromSQL t45, FromSQL t46, FromSQL t47, FromSQL t48
  , FromSQL t49
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44, t45, t46, t47, t48, t49) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41,
      t42, t43, t44, t45, t46, t47, t48, t49)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t39)
p38 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t40)
p39 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t41)
p40 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t42)
p41 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t43)
p42 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t44)
p43 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t45)
p44 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t46)
p45 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t47)
p46 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t48)
p47 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t49)
p48 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> CInt
-> Ptr t39
-> CInt
-> Ptr t40
-> CInt
-> Ptr t41
-> CInt
-> Ptr t42
-> CInt
-> Ptr t43
-> CInt
-> Ptr t44
-> CInt
-> Ptr t45
-> CInt
-> Ptr t46
-> CInt
-> Ptr t47
-> CInt
-> Ptr t48
-> CInt
-> Ptr t49
-> IO CInt
c_PQgetf49 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37 (CInt
bforall a. Num a => a -> a -> a
+CInt
38) Ptr (PQBase t39)
p38 (CInt
bforall a. Num a => a -> a -> a
+CInt
39) Ptr (PQBase t40)
p39 (CInt
bforall a. Num a => a -> a -> a
+CInt
40) Ptr (PQBase t41)
p40 (CInt
bforall a. Num a => a -> a -> a
+CInt
41) Ptr (PQBase t42)
p41 (CInt
bforall a. Num a => a -> a -> a
+CInt
42) Ptr (PQBase t43)
p42 (CInt
bforall a. Num a => a -> a -> a
+CInt
43) Ptr (PQBase t44)
p43 (CInt
bforall a. Num a => a -> a -> a
+CInt
44) Ptr (PQBase t45)
p44 (CInt
bforall a. Num a => a -> a -> a
+CInt
45) Ptr (PQBase t46)
p45 (CInt
bforall a. Num a => a -> a -> a
+CInt
46) Ptr (PQBase t47)
p46 (CInt
bforall a. Num a => a -> a -> a
+CInt
47) Ptr (PQBase t48)
p47 (CInt
bforall a. Num a => a -> a -> a
+CInt
48) Ptr (PQBase t49)
p48
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t39)
p38 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
38)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t40)
p39 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
39))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t41)
p40 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
40)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t42)
p41 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
41))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t43)
p42 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
42)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t44)
p43 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
43))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t45)
p44 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
44)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t46)
p45 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
45))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t47)
p46 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
46)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t48)
p47 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
47))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t49)
p48 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
48))

instance (
    FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6
  , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12
  , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18
  , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24
  , FromSQL t25, FromSQL t26, FromSQL t27, FromSQL t28, FromSQL t29, FromSQL t30
  , FromSQL t31, FromSQL t32, FromSQL t33, FromSQL t34, FromSQL t35, FromSQL t36
  , FromSQL t37, FromSQL t38, FromSQL t39, FromSQL t40, FromSQL t41, FromSQL t42
  , FromSQL t43, FromSQL t44, FromSQL t45, FromSQL t46, FromSQL t47, FromSQL t48
  , FromSQL t49, FromSQL t50
  ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44, t45, t46, t47, t48, t49, t50) where
    fromRow :: Ptr PGresult
-> Ptr PGerror
-> CInt
-> CInt
-> IO
     (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15,
      t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28,
      t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41,
      t42, t43, t44, t45, t46, t47, t48, t49, t50)
fromRow Ptr PGresult
res Ptr PGerror
err CInt
b CInt
i = forall row. FromRow row => (CString -> IO row) -> IO row
withFormat forall a b. (a -> b) -> a -> b
$ \CString
fmt ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t1)
p0 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t2)
p1 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t3)
p2 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t4)
p3 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t5)
p4 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t6)
p5 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t7)
p6 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t8)
p7 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t9)
p8 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t10)
p9 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t11)
p10 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t12)
p11 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t13)
p12 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t14)
p13 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t15)
p14 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t16)
p15 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t17)
p16 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t18)
p17 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t19)
p18 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t20)
p19 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t21)
p20 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t22)
p21 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t23)
p22 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t24)
p23 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t25)
p24 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t26)
p25 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t27)
p26 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t28)
p27 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t29)
p28 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t30)
p29 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t31)
p30 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t32)
p31 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t33)
p32 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t34)
p33 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t35)
p34 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t36)
p35 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t37)
p36 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t38)
p37 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t39)
p38 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t40)
p39 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t41)
p40 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t42)
p41 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t43)
p42 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t44)
p43 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t45)
p44 ->
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t46)
p45 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t47)
p46 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t48)
p47 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t49)
p48 -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (PQBase t50)
p49 -> do
        Ptr PGerror -> CInt -> IO ()
verify Ptr PGerror
err forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17
       t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34
       t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50.
Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr t1
-> CInt
-> Ptr t2
-> CInt
-> Ptr t3
-> CInt
-> Ptr t4
-> CInt
-> Ptr t5
-> CInt
-> Ptr t6
-> CInt
-> Ptr t7
-> CInt
-> Ptr t8
-> CInt
-> Ptr t9
-> CInt
-> Ptr t10
-> CInt
-> Ptr t11
-> CInt
-> Ptr t12
-> CInt
-> Ptr t13
-> CInt
-> Ptr t14
-> CInt
-> Ptr t15
-> CInt
-> Ptr t16
-> CInt
-> Ptr t17
-> CInt
-> Ptr t18
-> CInt
-> Ptr t19
-> CInt
-> Ptr t20
-> CInt
-> Ptr t21
-> CInt
-> Ptr t22
-> CInt
-> Ptr t23
-> CInt
-> Ptr t24
-> CInt
-> Ptr t25
-> CInt
-> Ptr t26
-> CInt
-> Ptr t27
-> CInt
-> Ptr t28
-> CInt
-> Ptr t29
-> CInt
-> Ptr t30
-> CInt
-> Ptr t31
-> CInt
-> Ptr t32
-> CInt
-> Ptr t33
-> CInt
-> Ptr t34
-> CInt
-> Ptr t35
-> CInt
-> Ptr t36
-> CInt
-> Ptr t37
-> CInt
-> Ptr t38
-> CInt
-> Ptr t39
-> CInt
-> Ptr t40
-> CInt
-> Ptr t41
-> CInt
-> Ptr t42
-> CInt
-> Ptr t43
-> CInt
-> Ptr t44
-> CInt
-> Ptr t45
-> CInt
-> Ptr t46
-> CInt
-> Ptr t47
-> CInt
-> Ptr t48
-> CInt
-> Ptr t49
-> CInt
-> Ptr t50
-> IO CInt
c_PQgetf50 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
b Ptr (PQBase t1)
p0 (CInt
bforall a. Num a => a -> a -> a
+CInt
1) Ptr (PQBase t2)
p1 (CInt
bforall a. Num a => a -> a -> a
+CInt
2) Ptr (PQBase t3)
p2 (CInt
bforall a. Num a => a -> a -> a
+CInt
3) Ptr (PQBase t4)
p3 (CInt
bforall a. Num a => a -> a -> a
+CInt
4) Ptr (PQBase t5)
p4 (CInt
bforall a. Num a => a -> a -> a
+CInt
5) Ptr (PQBase t6)
p5 (CInt
bforall a. Num a => a -> a -> a
+CInt
6) Ptr (PQBase t7)
p6 (CInt
bforall a. Num a => a -> a -> a
+CInt
7) Ptr (PQBase t8)
p7 (CInt
bforall a. Num a => a -> a -> a
+CInt
8) Ptr (PQBase t9)
p8 (CInt
bforall a. Num a => a -> a -> a
+CInt
9) Ptr (PQBase t10)
p9 (CInt
bforall a. Num a => a -> a -> a
+CInt
10) Ptr (PQBase t11)
p10 (CInt
bforall a. Num a => a -> a -> a
+CInt
11) Ptr (PQBase t12)
p11 (CInt
bforall a. Num a => a -> a -> a
+CInt
12) Ptr (PQBase t13)
p12 (CInt
bforall a. Num a => a -> a -> a
+CInt
13) Ptr (PQBase t14)
p13 (CInt
bforall a. Num a => a -> a -> a
+CInt
14) Ptr (PQBase t15)
p14 (CInt
bforall a. Num a => a -> a -> a
+CInt
15) Ptr (PQBase t16)
p15 (CInt
bforall a. Num a => a -> a -> a
+CInt
16) Ptr (PQBase t17)
p16 (CInt
bforall a. Num a => a -> a -> a
+CInt
17) Ptr (PQBase t18)
p17 (CInt
bforall a. Num a => a -> a -> a
+CInt
18) Ptr (PQBase t19)
p18 (CInt
bforall a. Num a => a -> a -> a
+CInt
19) Ptr (PQBase t20)
p19 (CInt
bforall a. Num a => a -> a -> a
+CInt
20) Ptr (PQBase t21)
p20 (CInt
bforall a. Num a => a -> a -> a
+CInt
21) Ptr (PQBase t22)
p21 (CInt
bforall a. Num a => a -> a -> a
+CInt
22) Ptr (PQBase t23)
p22 (CInt
bforall a. Num a => a -> a -> a
+CInt
23) Ptr (PQBase t24)
p23 (CInt
bforall a. Num a => a -> a -> a
+CInt
24) Ptr (PQBase t25)
p24 (CInt
bforall a. Num a => a -> a -> a
+CInt
25) Ptr (PQBase t26)
p25 (CInt
bforall a. Num a => a -> a -> a
+CInt
26) Ptr (PQBase t27)
p26 (CInt
bforall a. Num a => a -> a -> a
+CInt
27) Ptr (PQBase t28)
p27 (CInt
bforall a. Num a => a -> a -> a
+CInt
28) Ptr (PQBase t29)
p28 (CInt
bforall a. Num a => a -> a -> a
+CInt
29) Ptr (PQBase t30)
p29 (CInt
bforall a. Num a => a -> a -> a
+CInt
30) Ptr (PQBase t31)
p30 (CInt
bforall a. Num a => a -> a -> a
+CInt
31) Ptr (PQBase t32)
p31 (CInt
bforall a. Num a => a -> a -> a
+CInt
32) Ptr (PQBase t33)
p32 (CInt
bforall a. Num a => a -> a -> a
+CInt
33) Ptr (PQBase t34)
p33 (CInt
bforall a. Num a => a -> a -> a
+CInt
34) Ptr (PQBase t35)
p34 (CInt
bforall a. Num a => a -> a -> a
+CInt
35) Ptr (PQBase t36)
p35 (CInt
bforall a. Num a => a -> a -> a
+CInt
36) Ptr (PQBase t37)
p36 (CInt
bforall a. Num a => a -> a -> a
+CInt
37) Ptr (PQBase t38)
p37 (CInt
bforall a. Num a => a -> a -> a
+CInt
38) Ptr (PQBase t39)
p38 (CInt
bforall a. Num a => a -> a -> a
+CInt
39) Ptr (PQBase t40)
p39 (CInt
bforall a. Num a => a -> a -> a
+CInt
40) Ptr (PQBase t41)
p40 (CInt
bforall a. Num a => a -> a -> a
+CInt
41) Ptr (PQBase t42)
p41 (CInt
bforall a. Num a => a -> a -> a
+CInt
42) Ptr (PQBase t43)
p42 (CInt
bforall a. Num a => a -> a -> a
+CInt
43) Ptr (PQBase t44)
p43 (CInt
bforall a. Num a => a -> a -> a
+CInt
44) Ptr (PQBase t45)
p44 (CInt
bforall a. Num a => a -> a -> a
+CInt
45) Ptr (PQBase t46)
p45 (CInt
bforall a. Num a => a -> a -> a
+CInt
46) Ptr (PQBase t47)
p46 (CInt
bforall a. Num a => a -> a -> a
+CInt
47) Ptr (PQBase t48)
p47 (CInt
bforall a. Num a => a -> a -> a
+CInt
48) Ptr (PQBase t49)
p48 (CInt
bforall a. Num a => a -> a -> a
+CInt
49) Ptr (PQBase t50)
p49
        (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t1)
p0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i CInt
b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t2)
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
1))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t3)
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t4)
p3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
3))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t5)
p4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t6)
p5 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
5))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t7)
p6 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t8)
p7 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
7))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t9)
p8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t10)
p9 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
9))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t11)
p10 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t12)
p11 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
11))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t13)
p12 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
12)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t14)
p13 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
13))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t15)
p14 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
14)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t16)
p15 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
15))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t17)
p16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
16)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t18)
p17 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
17))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t19)
p18 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
18)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t20)
p19 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
19))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t21)
p20 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
20)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t22)
p21 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
21))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t23)
p22 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
22)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t24)
p23 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
23))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t25)
p24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
24)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t26)
p25 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
25))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t27)
p26 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
26)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t28)
p27 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
27))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t29)
p28 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
28)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t30)
p29 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
29))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t31)
p30 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
30)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t32)
p31 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
31))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t33)
p32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
32)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t34)
p33 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
33))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t35)
p34 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
34)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t36)
p35 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
35))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t37)
p36 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
36)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t38)
p37 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
37))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t39)
p38 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
38)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t40)
p39 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
39))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t41)
p40 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
40)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t42)
p41 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
41))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t43)
p42 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
42)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t44)
p43 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
43))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t45)
p44 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
44)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t46)
p45 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
45))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t47)
p46 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
46)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t48)
p47 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
47))
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t49)
p48 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
48)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase t50)
p49 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t.
FromSQL t =>
Ptr PGresult -> CInt -> CInt -> PQBase t -> IO t
convert Ptr PGresult
res CInt
i (CInt
bforall a. Num a => a -> a -> a
+CInt
49))