{-# LANGUAGE TypeApplications #-}
module Database.PostgreSQL.PQTypes.Internal.QueryResult (
QueryResult(..)
, ntuples
, nfields
) where
import Control.Monad
import Data.Foldable
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Ptr
import System.IO.Unsafe
import qualified Control.Exception as E
import Database.PostgreSQL.PQTypes.Format
import Database.PostgreSQL.PQTypes.FromRow
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.Exception
import Database.PostgreSQL.PQTypes.SQL.Class
data QueryResult t = forall row. FromRow row => QueryResult
{ forall t. QueryResult t -> SomeSQL
qrSQL :: !SomeSQL
, forall t. QueryResult t -> ForeignPtr PGresult
qrResult :: !(ForeignPtr PGresult)
, ()
qrFromRow :: !(row -> t)
}
instance Functor QueryResult where
a -> b
f fmap :: forall a b. (a -> b) -> QueryResult a -> QueryResult b
`fmap` QueryResult SomeSQL
ctx ForeignPtr PGresult
fres row -> a
g = forall t row.
FromRow row =>
SomeSQL -> ForeignPtr PGresult -> (row -> t) -> QueryResult t
QueryResult SomeSQL
ctx ForeignPtr PGresult
fres (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. row -> a
g)
instance Foldable QueryResult where
foldr :: forall a b. (a -> b -> b) -> b -> QueryResult a -> b
foldr = forall t acc.
Bool
-> (Ptr PGresult -> IO CInt)
-> (Ptr PGresult -> IO CInt)
-> (CInt -> CInt)
-> (t -> acc -> acc)
-> acc
-> QueryResult t
-> acc
foldImpl Bool
False (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Enum a => a -> a
pred forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PGresult -> IO CInt
c_PQntuples) (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ -CInt
1) forall a. Enum a => a -> a
pred
foldr' :: forall a b. (a -> b -> b) -> b -> QueryResult a -> b
foldr' = forall t acc.
Bool
-> (Ptr PGresult -> IO CInt)
-> (Ptr PGresult -> IO CInt)
-> (CInt -> CInt)
-> (t -> acc -> acc)
-> acc
-> QueryResult t
-> acc
foldImpl Bool
True (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Enum a => a -> a
pred forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PGresult -> IO CInt
c_PQntuples) (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ -CInt
1) forall a. Enum a => a -> a
pred
foldl :: forall b a. (b -> a -> b) -> b -> QueryResult a -> b
foldl = forall t acc.
Bool
-> (Ptr PGresult -> IO CInt)
-> (Ptr PGresult -> IO CInt)
-> (CInt -> CInt)
-> (t -> acc -> acc)
-> acc
-> QueryResult t
-> acc
foldImpl Bool
False (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return CInt
0) Ptr PGresult -> IO CInt
c_PQntuples forall a. Enum a => a -> a
succ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip
foldl' :: forall b a. (b -> a -> b) -> b -> QueryResult a -> b
foldl' = forall t acc.
Bool
-> (Ptr PGresult -> IO CInt)
-> (Ptr PGresult -> IO CInt)
-> (CInt -> CInt)
-> (t -> acc -> acc)
-> acc
-> QueryResult t
-> acc
foldImpl Bool
True (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return CInt
0) Ptr PGresult -> IO CInt
c_PQntuples forall a. Enum a => a -> a
succ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip
foldImpl :: Bool
-> (Ptr PGresult -> IO CInt)
-> (Ptr PGresult -> IO CInt)
-> (CInt -> CInt)
-> (t -> acc -> acc)
-> acc
-> QueryResult t
-> acc
foldImpl :: forall t acc.
Bool
-> (Ptr PGresult -> IO CInt)
-> (Ptr PGresult -> IO CInt)
-> (CInt -> CInt)
-> (t -> acc -> acc)
-> acc
-> QueryResult t
-> acc
foldImpl Bool
strict Ptr PGresult -> IO CInt
initCtr Ptr PGresult -> IO CInt
termCtr CInt -> CInt
advCtr t -> acc -> acc
f acc
iacc (QueryResult (SomeSQL sql
ctx) ForeignPtr PGresult
fres row -> t
g) =
forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PGresult
fres forall a b. (a -> b) -> a -> b
$ \Ptr PGresult
res -> do
Int
rowlen <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PGresult -> IO CInt
c_PQnfields Ptr PGresult
res
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
rowlen forall a. Eq a => a -> a -> Bool
/= forall t. PQFormat t => Proxy t -> Int
pqVariablesP Proxy row
rowp) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
E.throwIO DBException {
dbeQueryContext :: sql
dbeQueryContext = sql
ctx
, dbeError :: RowLengthMismatch
dbeError = RowLengthMismatch {
lengthExpected :: Int
lengthExpected = forall t. PQFormat t => Proxy t -> Int
pqVariablesP Proxy row
rowp
, lengthDelivered :: Int
lengthDelivered = Int
rowlen
}
}
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> do
CInt
i <- Ptr PGresult -> IO CInt
initCtr Ptr PGresult
res
CInt
n <- Ptr PGresult -> IO CInt
termCtr Ptr PGresult
res
Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> acc -> IO acc
worker Ptr PGresult
res Ptr PGerror
err CInt
i CInt
n acc
iacc
where
row :: row
row = let t
_ = row -> t
g row
row in row
row
rowp :: Proxy row
rowp = forall (f :: * -> *) a. Applicative f => a -> f a
pure row
row
apply :: (acc -> IO acc) -> acc -> IO acc
apply = if Bool
strict then forall a b. (a -> b) -> a -> b
($!) else forall a b. (a -> b) -> a -> b
($)
worker :: Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> acc -> IO acc
worker Ptr PGresult
res Ptr PGerror
err !CInt
i CInt
n acc
acc
| CInt
i forall a. Eq a => a -> a -> Bool
== CInt
n = forall (m :: * -> *) a. Monad m => a -> m a
return acc
acc
| Bool
otherwise = do
t
obj <- forall a. IO a -> IO a
E.mask_ (row -> t
g 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
0 CInt
i forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` forall sql a. IsSQL sql => sql -> SomeException -> IO a
rethrowWithContext sql
ctx)
Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> acc -> IO acc
worker Ptr PGresult
res Ptr PGerror
err (CInt -> CInt
advCtr CInt
i) CInt
n (acc -> IO acc) -> acc -> IO acc
`apply` t -> acc -> acc
f t
obj acc
acc
ntuples :: QueryResult t -> Int
ntuples :: forall a. QueryResult a -> Int
ntuples QueryResult t
qr = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (forall t. QueryResult t -> ForeignPtr PGresult
qrResult QueryResult t
qr) Ptr PGresult -> IO CInt
c_PQntuples
nfields :: QueryResult t -> Int
nfields :: forall a. QueryResult a -> Int
nfields QueryResult t
qr = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (forall t. QueryResult t -> ForeignPtr PGresult
qrResult QueryResult t
qr) Ptr PGresult -> IO CInt
c_PQnfields