Add refineResult

This commit is contained in:
Nikita Volkov 2020-03-21 20:54:13 +03:00
parent 3de214198a
commit f578165491
5 changed files with 23 additions and 2 deletions

View File

@ -50,6 +50,9 @@ Will raise the 'Hasql.Errors.UnexpectedAmountOfRows' error if it's any other.
singleRow :: Row a -> Result a singleRow :: Row a -> Result a
singleRow (Row row) = Result (Results.single (Result.single row)) singleRow (Row row) = Result (Results.single (Result.single row))
refineResult :: (a -> Either Text b) -> Result a -> Result b
refineResult refiner (Result results) = Result (Results.refine refiner results)
-- ** Multi-row traversers -- ** Multi-row traversers
------------------------- -------------------------

View File

@ -82,3 +82,8 @@ dropRemainders =
where where
checkErrors = checkErrors =
ExceptT $ fmap (mapLeft ResultError) $ Result.run Result.noResult (integerDatetimes, result) ExceptT $ fmap (mapLeft ResultError) $ Result.run Result.noResult (integerDatetimes, result)
refine :: (a -> Either Text b) -> Results a -> Results b
refine refiner results = Results $ ReaderT $ \ env -> ExceptT $ do
resultEither <- run results env
return $ resultEither >>= mapLeft (ResultError . UnexpectedResult) . refiner

View File

@ -1,6 +1,6 @@
module Hasql.Private.Decoders.Row where module Hasql.Private.Decoders.Row where
import Hasql.Private.Prelude import Hasql.Private.Prelude hiding (error)
import Hasql.Private.Errors import Hasql.Private.Errors
import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified PostgreSQL.Binary.Decoding as A import qualified PostgreSQL.Binary.Decoding as A

View File

@ -17,7 +17,7 @@ where
-- base-prelude -- base-prelude
------------------------- -------------------------
import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, fromLeft, fromRight, error, (<>), First(..), Last(..), new) import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, fromLeft, fromRight, (<>), First(..), Last(..), new)
-- transformers -- transformers
------------------------- -------------------------

View File

@ -1,6 +1,7 @@
module Hasql.Statement module Hasql.Statement
( (
Statement(..), Statement(..),
refineResult,
-- * Recipies -- * Recipies
-- ** Insert many -- ** Insert many
@ -14,6 +15,7 @@ where
import Hasql.Private.Prelude import Hasql.Private.Prelude
import qualified Hasql.Decoders as Decoders import qualified Hasql.Decoders as Decoders
import qualified Hasql.Encoders as Encoders import qualified Hasql.Encoders as Encoders
import qualified Hasql.Private.Decoders as Decoders
{-| {-|
Specification of a strictly single-statement query, which can be parameterized and prepared. Specification of a strictly single-statement query, which can be parameterized and prepared.
@ -60,6 +62,17 @@ instance Profunctor Statement where
dimap f1 f2 (Statement template encoder decoder preparable) = dimap f1 f2 (Statement template encoder decoder preparable) =
Statement template (contramap f1 encoder) (fmap f2 decoder) preparable Statement template (contramap f1 encoder) (fmap f2 decoder) preparable
{-|
Refine a result of a statement,
causing the running session to fail with the `UnexpectedResult` error in case of refinement failure.
This function is especially useful for refining the results of statements produced with
<http://hackage.haskell.org/package/hasql-th the \"hasql-th\" library>.
-}
refineResult :: (a -> Either Text b) -> Statement params a -> Statement params b
refineResult refiner (Statement template encoder decoder preparable) =
Statement template encoder (Decoders.refineResult refiner decoder) preparable
{- $insertMany {- $insertMany