diff --git a/hasql.cabal b/hasql.cabal --- a/hasql.cabal +++ b/hasql.cabal @@ -1,5 +1,5 @@ name: hasql -version: 1.4.5.3 +version: 1.5 category: Hasql, Database, PostgreSQL synopsis: An efficient PostgreSQL driver with a flexible mapping API description: diff --git a/library/Hasql/Private/Decoders/Result.hs b/library/Hasql/Private/Decoders/Result.hs --- a/library/Hasql/Private/Decoders/Result.hs +++ b/library/Hasql/Private/Decoders/Result.hs @@ -93,7 +93,8 @@ 0 -> return (Right Nothing) 1 -> do maxCols <- LibPQ.nfields result - fmap (fmap Just . mapLeft (RowError 0)) $ Row.run rowDec (result, 0, maxCols, integerDatetimes) + let fromRowError (col, err) = RowError 0 col err + fmap (fmap Just . mapLeft fromRowError) $ Row.run rowDec (result, 0, maxCols, integerDatetimes) _ -> return (Left (UnexpectedAmountOfRows (rowToInt maxRows))) where rowToInt (LibPQ.Row n) = @@ -113,7 +114,8 @@ case maxRows of 1 -> do maxCols <- LibPQ.nfields result - fmap (mapLeft (RowError 0)) $ Row.run rowDec (result, 0, maxCols, integerDatetimes) + let fromRowError (col, err) = RowError 0 col err + fmap (mapLeft fromRowError) $ Row.run rowDec (result, 0, maxCols, integerDatetimes) _ -> return (Left (UnexpectedAmountOfRows (rowToInt maxRows))) where rowToInt (LibPQ.Row n) = @@ -136,7 +138,7 @@ forMFromZero_ (rowToInt maxRows) $ \rowIndex -> do rowResult <- Row.run rowDec (result, intToRow rowIndex, maxCols, integerDatetimes) case rowResult of - Left !x -> writeIORef failureRef (Just (RowError rowIndex x)) + Left !(!colIndex,!x) -> writeIORef failureRef (Just (RowError rowIndex colIndex x)) Right !x -> MutableVector.unsafeWrite mvector rowIndex x readIORef failureRef >>= \case Nothing -> Right <$> Vector.unsafeFreeze mvector @@ -163,7 +165,7 @@ forMFromZero_ (rowToInt maxRows) $ \rowIndex -> do rowResult <- Row.run rowDec (result, intToRow rowIndex, maxCols, integerDatetimes) case rowResult of - Left !x -> writeIORef failureRef (Just (RowError rowIndex x)) + Left !(!colIndex,!x) -> writeIORef failureRef (Just (RowError rowIndex colIndex x)) Right !x -> modifyIORef' accRef (\acc -> step acc x) readIORef failureRef >>= \case Nothing -> Right <$> readIORef accRef @@ -190,7 +192,7 @@ forMToZero_ (rowToInt maxRows) $ \rowIndex -> do rowResult <- Row.run rowDec (result, intToRow rowIndex, maxCols, integerDatetimes) case rowResult of - Left !x -> writeIORef failureRef (Just (RowError rowIndex x)) + Left !(!colIndex,!x) -> writeIORef failureRef (Just (RowError rowIndex colIndex x)) Right !x -> modifyIORef accRef (\acc -> step x acc) readIORef failureRef >>= \case Nothing -> Right <$> readIORef accRef diff --git a/library/Hasql/Private/Decoders/Row.hs b/library/Hasql/Private/Decoders/Row.hs --- a/library/Hasql/Private/Decoders/Row.hs +++ b/library/Hasql/Private/Decoders/Row.hs @@ -22,11 +22,16 @@ ------------------------- {-# INLINE run #-} -run :: Row a -> (LibPQ.Result, LibPQ.Row, LibPQ.Column, Bool) -> IO (Either RowError a) +run :: Row a -> (LibPQ.Result, LibPQ.Row, LibPQ.Column, Bool) -> IO (Either (Int, RowError) a) run (Row impl) (result, row, columnsAmount, integerDatetimes) = do columnRef <- newIORef 0 - runExceptT (runReaderT impl (Env result row columnsAmount integerDatetimes columnRef)) + runExceptT (runReaderT impl (Env result row columnsAmount integerDatetimes columnRef)) >>= \case + Left e -> do + LibPQ.Col col <- readIORef columnRef + -- -1 because succ is applied before the error is returned + pure $ Left (fromIntegral col - 1, e) + Right x -> pure $ Right x {-# INLINE error #-} error :: RowError -> Row a diff --git a/library/Hasql/Private/Errors.hs b/library/Hasql/Private/Errors.hs --- a/library/Hasql/Private/Errors.hs +++ b/library/Hasql/Private/Errors.hs @@ -67,8 +67,8 @@ -- Indicates an improper statement or a schema mismatch. UnexpectedResult Text | -- | - -- An error of the row reader, preceded by the index of the row. - RowError Int RowError | + -- An error of the row reader, preceded by the indexes of the row and column. + RowError Int Int RowError | -- | -- An unexpected amount of rows. UnexpectedAmountOfRows Int diff --git a/library/Hasql/Private/Prelude.hs b/library/Hasql/Private/Prelude.hs --- a/library/Hasql/Private/Prelude.hs +++ b/library/Hasql/Private/Prelude.hs @@ -91,7 +91,7 @@ import Control.Monad.Trans.Cont as Exports hiding (shift, callCC) import Control.Monad.Trans.Except as Exports (ExceptT(ExceptT), Except, except, runExcept, runExceptT, mapExcept, mapExceptT, withExcept, withExceptT, throwE, catchE) import Control.Monad.Trans.Maybe as Exports -import Control.Monad.Trans.Reader as Exports (Reader, ask, runReader, mapReader, withReader, ReaderT(ReaderT), runReaderT, mapReaderT, withReaderT) +import Control.Monad.Trans.Reader as Exports (Reader, runReader, mapReader, withReader, ReaderT(ReaderT), runReaderT, mapReaderT, withReaderT) import Control.Monad.Trans.State.Strict as Exports (State, runState, evalState, execState, mapState, withState, StateT(StateT), runStateT, evalStateT, execStateT, mapStateT, withStateT) import Control.Monad.Trans.Writer.Strict as Exports (Writer, runWriter, execWriter, mapWriter, WriterT(..), execWriterT, mapWriterT) import Data.Functor.Compose as Exports @@ -100,6 +100,7 @@ -- mtl ------------------------- import Control.Monad.Error.Class as Exports (MonadError (..)) +import Control.Monad.Reader.Class as Exports (MonadReader (..)) -- profunctors ------------------------- diff --git a/library/Hasql/Private/Session.hs b/library/Hasql/Private/Session.hs --- a/library/Hasql/Private/Session.hs +++ b/library/Hasql/Private/Session.hs @@ -18,7 +18,7 @@ -- A batch of actions to be executed in the context of a database connection. newtype Session a = Session (ReaderT Connection.Connection (ExceptT QueryError IO) a) - deriving (Functor, Applicative, Monad, MonadError QueryError, MonadIO) + deriving (Functor, Applicative, Monad, MonadError QueryError, MonadIO, MonadReader Connection.Connection) -- | -- Executes a bunch of commands on the provided connection.