module Hasql.Decoding.Results where
import Hasql.Prelude hiding (maybe, many)
import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Hasql.Prelude as Prelude
import qualified Hasql.Decoding.Result as Result
import qualified Hasql.Decoding.Row as Row
newtype Results a =
Results (ReaderT (Bool, LibPQ.Connection) (EitherT Error IO) a)
deriving (Functor, Applicative, Monad)
data Error =
ClientError !(Maybe ByteString) |
ResultError !Result.Error
run :: Results a -> (Bool, LibPQ.Connection) -> IO (Either Error a)
run (Results stack) env =
runEitherT (runReaderT stack env)
clientError :: Results a
clientError =
Results $ ReaderT $ \(_, connection) -> EitherT $
fmap (Left . ClientError) (LibPQ.errorMessage connection)
single :: Result.Result a -> Results a
single resultDec =
Results $ ReaderT $ \(integerDatetimes, connection) -> EitherT $ do
resultMaybe <- LibPQ.getResult connection
case resultMaybe of
Just result ->
mapLeft ResultError <$> Result.run resultDec (integerDatetimes, result)
<* LibPQ.unsafeFreeResult result
Nothing ->
fmap (Left . ClientError) (LibPQ.errorMessage connection)
getResult :: Results LibPQ.Result
getResult =
Results $ ReaderT $ \(_, connection) -> EitherT $ do
resultMaybe <- LibPQ.getResult connection
case resultMaybe of
Just result -> pure (Right result)
Nothing -> fmap (Left . ClientError) (LibPQ.errorMessage connection)
getResultMaybe :: Results (Maybe LibPQ.Result)
getResultMaybe =
Results $ ReaderT $ \(_, connection) -> lift $ LibPQ.getResult connection
dropRemainders :: Results ()
dropRemainders =
Results $ ReaderT $ \(integerDatetimes, connection) -> loop integerDatetimes connection
where
loop integerDatetimes connection =
getResultMaybe >>= Prelude.maybe (pure ()) onResult
where
getResultMaybe =
lift $ LibPQ.getResult connection
onResult result =
checkErrors *> loop integerDatetimes connection
where
checkErrors =
EitherT $ fmap (mapLeft ResultError) $ Result.run Result.unit (integerDatetimes, result)