module Database.PostgreSQL.Store.Result (
ResultError (..),
ResultProcessor,
processResult,
processOneResult,
skipColumn,
unpackColumn
) where
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Reader
import Control.Monad.State.Strict
import Control.Monad.Except
import qualified Database.PostgreSQL.LibPQ as P
import Database.PostgreSQL.Store.Columns
data ResultError
= TooFewColumnsError P.Column
| UnpackError P.Row P.Column P.Oid P.Format
deriving (Show, Eq)
newtype ResultProcessor a =
ResultProcessor (StateT P.Column (ReaderT (P.Result, P.Row, P.Column) (ExceptT ResultError IO)) a)
deriving (Functor, Applicative, Monad, MonadIO, MonadError ResultError)
skipColumn :: ResultProcessor ()
skipColumn =
ResultProcessor (modify (+ 1))
unpackColumn :: (Column a) => ResultProcessor a
unpackColumn = do
col <- ResultProcessor get
(res, row, numCol) <- ResultProcessor ask
when (col >= numCol) (throwError (TooFewColumnsError numCol))
(typ, mbData) <- liftIO $
(,) <$> P.ftype res col <*> P.getvalue' res row col
case unpack (maybe NullValue (Value typ) mbData) of
Just ret -> ResultProcessor (put (col + 1) >> pure ret)
Nothing -> throwError (UnpackError row col typ P.Text)
processResult :: P.Result -> ResultProcessor a -> ExceptT ResultError IO [a]
processResult res (ResultProcessor proc) = do
(rows, cols) <- liftIO ((,) <$> P.ntuples res <*> P.nfields res)
forM [0 .. rows 1] $ \ row ->
runReaderT (evalStateT proc 0) (res, row, cols)
processOneResult :: P.Result -> ResultProcessor a -> ExceptT ResultError IO (Maybe a)
processOneResult res (ResultProcessor proc) = do
(rows, cols) <- liftIO ((,) <$> P.ntuples res <*> P.nfields res)
if rows > 0 then
Just <$> runReaderT (evalStateT proc 0) (res, 0, cols)
else
pure Nothing