nikita-volkov/hasql
1
1
Fork 0
mirror of https://github.com/nikita-volkov/hasql.git synced 2024-12-26 20:12:09 +03:00
Code Issues Projects Releases Wiki Activity

Add MonadFail instance for Row

Browse Source
This commit is contained in:
Renzo Carbonara 2020-05-09 18:12:42 +03:00
parent 46b836796e
commit 2c9c2377e1
2 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
library/Hasql/Private/Decoders.hs
View File

@ -113,7 +113,7 @@ x = (,,) '<$>' ('column' . 'nullable') 'int8' '<*>' ('column' . 'nonNullable') '
@ @
-} -}
newtype Row a = Row (Row.Row a) newtype Row a = Row (Row.Row a)
deriving (Functor, Applicative, Monad) deriving (Functor, Applicative, Monad, MonadFail)
{-| {-|
Lift an individual non-nullable value decoder to a composable row decoder. Lift an individual non-nullable value decoder to a composable row decoder.
@ -268,7 +268,7 @@ time = Value (Value.decoder (Prelude.bool A.time_float A.time_int))
{-| {-|
Decoder of the @TIMETZ@ values. Decoder of the @TIMETZ@ values.
Unlike in case of @TIMESTAMPTZ@, Unlike in case of @TIMESTAMPTZ@,
Postgres does store the timezone information for @TIMETZ@. Postgres does store the timezone information for @TIMETZ@.
However the Haskell's \"time\" library does not contain any composite type, However the Haskell's \"time\" library does not contain any composite type,
that fits the task, so we use a pair of 'TimeOfDay' and 'TimeZone' that fits the task, so we use a pair of 'TimeOfDay' and 'TimeZone'

11
library/Hasql/Private/Decoders/Row.hs
View File

@ -3,14 +3,19 @@ module Hasql.Private.Decoders.Row where
import Hasql.Private.Prelude hiding (error) 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 Data.Text as T
import qualified PostgreSQL.Binary.Decoding as A import qualified PostgreSQL.Binary.Decoding as A
import qualified Hasql.Private.Decoders.Value as Value import qualified Hasql.Private.Decoders.Value as Value
import Control.Monad.Fail (MonadFail(..))
newtype Row a = newtype Row a =
Row (ReaderT Env (ExceptT RowError IO) a) Row (ReaderT Env (ExceptT RowError IO) a)
deriving (Functor, Applicative, Monad) deriving (Functor, Applicative, Monad)
instance MonadFail Row where
fail = error . ValueError . T.pack
data Env = data Env =
Env !LibPQ.Result !LibPQ.Row !LibPQ.Column !Bool !(IORef LibPQ.Column) Env !LibPQ.Result !LibPQ.Row !LibPQ.Column !Bool !(IORef LibPQ.Column)
@ -35,14 +40,14 @@ error x =
{-# INLINE value #-} {-# INLINE value #-}
value :: Value.Value a -> Row (Maybe a) value :: Value.Value a -> Row (Maybe a)
value valueDec = value valueDec =
{-# SCC "value" #-} {-# SCC "value" #-}
Row $ ReaderT $ \(Env result row columnsAmount integerDatetimes columnRef) -> ExceptT $ do Row $ ReaderT $ \(Env result row columnsAmount integerDatetimes columnRef) -> ExceptT $ do
col <- readIORef columnRef col <- readIORef columnRef
writeIORef columnRef (succ col) writeIORef columnRef (succ col)
if col < columnsAmount if col < columnsAmount
then do then do
valueMaybe <- {-# SCC "getvalue'" #-} LibPQ.getvalue' result row col valueMaybe <- {-# SCC "getvalue'" #-} LibPQ.getvalue' result row col
pure $ pure $
case valueMaybe of case valueMaybe of
Nothing -> Nothing ->
Right Nothing Right Nothing
@ -56,5 +61,5 @@ value valueDec =
{-# INLINE nonNullValue #-} {-# INLINE nonNullValue #-}
nonNullValue :: Value.Value a -> Row a nonNullValue :: Value.Value a -> Row a
nonNullValue valueDec = nonNullValue valueDec =
{-# SCC "nonNullValue" #-} {-# SCC "nonNullValue" #-}
value valueDec >>= maybe (error UnexpectedNull) pure value valueDec >>= maybe (error UnexpectedNull) pure