{-# 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

-- | Representation of a query result. Provides 'Functor'
-- and 'Foldable' instances for data transformation and
-- extraction appropriately.
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
    -- This bit is referentially transparent iff appropriate
    -- FrowRow and FromSQL instances are (the ones provided
    -- by the library fulfil this requirement).
    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
    -- ⊥ of existential type hidden in QueryResult
    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
        -- mask asynchronous exceptions so they won't be wrapped in DBException
        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

-- Note: c_PQntuples/c_PQnfields are pure on a C level and QueryResult
-- constructor is not exported to the end user (so it's not possible
-- to enforce premature finalization via finalizeForeignPtr), which
-- makes usage of unsafeDupablePerformIO fine here.

-- | Extract number of returned tuples (rows) from query result.
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

-- | Extract number of returned fields (columns) from query result.
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