module Database.PostgreSQL.Store.Result (
ResultError (..),
ResultProcessor,
ColumnInfo,
runResultProcessor,
columnNumber,
columnType,
columnFormat,
columnInfo,
foreachRow,
cellValue,
unpackCellValue,
Result (..),
RawRow (..)
) where
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Except
import Data.List
import Data.Typeable
import qualified Data.ByteString as B
import qualified Database.PostgreSQL.LibPQ as P
import Database.PostgreSQL.Store.Columns
data ResultError
= ColumnMissing B.ByteString
| ValueError P.Row P.Column P.Oid P.Format ColumnDescription
deriving (Show, Eq)
type ResultProcessor = ReaderT P.Result (ExceptT ResultError IO)
type ColumnInfo = (P.Column, P.Oid, P.Format)
runResultProcessor :: P.Result -> ResultProcessor a -> ExceptT ResultError IO a
runResultProcessor = flip runReaderT
numColumns :: ResultProcessor P.Column
numColumns = do
result <- ask
lift (lift (P.nfields result))
columnNumber :: B.ByteString -> ResultProcessor P.Column
columnNumber name = do
result <- ask
lift (ExceptT (maybe (Left (ColumnMissing name)) pure <$> P.fnumber result name))
columnType :: P.Column -> ResultProcessor P.Oid
columnType col = do
result <- ask
lift (lift (P.ftype result col))
columnFormat :: P.Column -> ResultProcessor P.Format
columnFormat col = do
result <- ask
lift (lift (P.fformat result col))
columnInfo :: B.ByteString -> ResultProcessor ColumnInfo
columnInfo name = do
col <- columnNumber name
(,,) col <$> columnType col <*> columnFormat col
foreachRow :: (P.Row -> ResultProcessor a) -> ResultProcessor [a]
foreachRow rowProcessor = do
result <- ask
numRows <- lift (lift (P.ntuples result))
mapM rowProcessor [0 .. numRows 1]
cellValue :: P.Row -> ColumnInfo -> ResultProcessor Value
cellValue row (col, oid, fmt) = do
result <- ask
value <- lift (lift (P.getvalue' result row col))
case value of
Just dat -> pure (Value oid dat fmt)
Nothing -> pure NullValue
cellValue' :: P.Row -> P.Column -> ResultProcessor Value
cellValue' row col = do
result <- ask
(oid, fmt, value) <- lift (lift ((,,) <$> P.ftype result col
<*> P.fformat result col
<*> P.getvalue' result row col))
case value of
Just dat -> pure (Value oid dat fmt)
Nothing -> pure NullValue
unpackCellValue :: (Column a) => P.Row -> ColumnInfo -> ResultProcessor a
unpackCellValue row info =
withProxy Proxy
where
withProxy :: (Column a) => Proxy a -> ResultProcessor a
withProxy proxy = do
value <- cellValue row info
lift (ExceptT (make (describeColumn proxy) (unpack value)))
(col, oid, fmt) = info
valueError desc =
pure (Left (ValueError row col oid fmt desc))
make desc =
maybe (valueError desc) (pure . pure)
class Result a where
resultProcessor :: ResultProcessor [a]
instance Result () where
resultProcessor = foreachRow (const (pure ()))
instance (Result a, Result b) => Result (a, b) where
resultProcessor =
zip <$> resultProcessor
<*> resultProcessor
instance (Result a, Result b, Result c) => Result (a, b, c) where
resultProcessor =
zip3 <$> resultProcessor
<*> resultProcessor
<*> resultProcessor
instance (Result a, Result b, Result c, Result d) => Result (a, b, c, d) where
resultProcessor =
zip4 <$> resultProcessor
<*> resultProcessor
<*> resultProcessor
<*> resultProcessor
instance (Result a, Result b, Result c, Result d, Result e) => Result (a, b, c, d, e) where
resultProcessor =
zip5 <$> resultProcessor
<*> resultProcessor
<*> resultProcessor
<*> resultProcessor
<*> resultProcessor
instance (Result a, Result b, Result c, Result d, Result e, Result f) => Result (a, b, c, d, e, f) where
resultProcessor =
zip6 <$> resultProcessor
<*> resultProcessor
<*> resultProcessor
<*> resultProcessor
<*> resultProcessor
<*> resultProcessor
instance (Result a, Result b, Result c, Result d, Result e, Result f, Result g) => Result (a, b, c, d, e, f, g) where
resultProcessor =
zip7 <$> resultProcessor
<*> resultProcessor
<*> resultProcessor
<*> resultProcessor
<*> resultProcessor
<*> resultProcessor
<*> resultProcessor
newtype RawRow = RawRow [Value]
deriving (Show, Eq, Ord)
instance Result RawRow where
resultProcessor = do
ncols <- numColumns
foreachRow $ \ row ->
RawRow <$> forM [0 .. ncols 1] (cellValue' row)