diff --git a/library/Hasql/Decoders/Result.hs b/library/Hasql/Decoders/Result.hs index 54e395e..38fce65 100644 --- a/library/Hasql/Decoders/Result.hs +++ b/library/Hasql/Decoders/Result.hs @@ -51,7 +51,7 @@ rowsAffected = then Left (UnexpectedResultError "Empty bytes") else Right bytes decimal bytes = - mapLeft (\m -> UnexpectedResultError ("Decimal parsing failure: " <> fromString m)) + first (\m -> UnexpectedResultError ("Decimal parsing failure: " <> fromString m)) $ Attoparsec.parseOnly (Attoparsec.decimal <* Attoparsec.endOfInput) bytes {-# INLINE checkExecStatus #-} @@ -112,7 +112,7 @@ maybe rowDec = 0 -> return (Right Nothing) 1 -> do maxCols <- LibPQ.nfields result - fmap (fmap Just . mapLeft (RowResultError 0)) $ Row.run rowDec (result, 0, maxCols, integerDatetimes) + fmap (fmap Just . first (RowResultError 0)) $ Row.run rowDec (result, 0, maxCols, integerDatetimes) _ -> return (Left (UnexpectedAmountOfRowsResultError (rowToInt maxRows))) where rowToInt (LibPQ.Row n) = @@ -130,7 +130,7 @@ single rowDec = case maxRows of 1 -> do maxCols <- LibPQ.nfields result - fmap (mapLeft (RowResultError 0)) $ Row.run rowDec (result, 0, maxCols, integerDatetimes) + fmap (first (RowResultError 0)) $ Row.run rowDec (result, 0, maxCols, integerDatetimes) _ -> return (Left (UnexpectedAmountOfRowsResultError (rowToInt maxRows))) where rowToInt (LibPQ.Row n) = diff --git a/library/Hasql/Decoders/Results.hs b/library/Hasql/Decoders/Results.hs index caef949..99d7a7f 100644 --- a/library/Hasql/Decoders/Results.hs +++ b/library/Hasql/Decoders/Results.hs @@ -45,7 +45,7 @@ single resultDec = resultMaybe <- LibPQ.getResult connection case resultMaybe of Just result -> - mapLeft ResultCommandError <$> Result.run resultDec integerDatetimes result + first ResultCommandError <$> Result.run resultDec integerDatetimes result Nothing -> fmap (Left . ClientCommandError) (LibPQ.errorMessage connection) @@ -64,11 +64,11 @@ dropRemainders = loop integerDatetimes connection <* checkErrors where checkErrors = - ExceptT $ fmap (mapLeft ResultCommandError) $ Result.run Result.noResult integerDatetimes result + ExceptT $ fmap (first ResultCommandError) $ Result.run Result.noResult integerDatetimes result refine :: (a -> Either Text b) -> Results a -> Results b refine refiner (Results stack) = Results $ ReaderT $ \env -> ExceptT $ do resultEither <- runExceptT $ runReaderT stack env - return $ resultEither >>= mapLeft (ResultCommandError . UnexpectedResultError) . refiner + return $ resultEither >>= first (ResultCommandError . UnexpectedResultError) . refiner diff --git a/library/Hasql/Decoders/Row.hs b/library/Hasql/Decoders/Row.hs index cf8d71d..98c0ec0 100644 --- a/library/Hasql/Decoders/Row.hs +++ b/library/Hasql/Decoders/Row.hs @@ -55,7 +55,7 @@ value valueDec = Right Nothing Just value -> fmap Just - $ mapLeft ValueColumnError + $ first ValueColumnError $ {-# SCC "decode" #-} A.valueParser (Value.run valueDec integerDatetimes) value else pure (Left EndOfInputColumnError) diff --git a/library/Hasql/Pipeline/Core.hs b/library/Hasql/Pipeline/Core.hs index 3c420c3..6c1b685 100644 --- a/library/Hasql/Pipeline/Core.hs +++ b/library/Hasql/Pipeline/Core.hs @@ -45,7 +45,7 @@ run (Pipeline sendQueriesInIO) connection registry integerDatetimes = do runResultsDecoder :: forall a. Decoders.Results.Results a -> ExceptT SessionError IO a runResultsDecoder decoder = ExceptT - $ fmap (mapLeft PipelineSessionError) + $ fmap (first PipelineSessionError) $ Decoders.Results.run decoder connection integerDatetimes runCommand :: IO Bool -> ExceptT SessionError IO () @@ -109,7 +109,7 @@ statement params (Statement.Statement sql (Encoders.Params encoder) (Decoders.Re else (False,) . Left . commandToSessionError . ClientCommandError <$> Pq.errorMessage connection where recv = - fmap (mapLeft commandToSessionError) + fmap (first commandToSessionError) $ (<*) <$> Decoders.Results.run (Decoders.Results.single Decoders.Result.noResult) connection integerDatetimes <*> Decoders.Results.run Decoders.Results.dropRemainders connection integerDatetimes @@ -122,7 +122,7 @@ statement params (Statement.Statement sql (Encoders.Params encoder) (Decoders.Re True -> pure (Right recv) where recv = - fmap (mapLeft commandToSessionError) + fmap (first commandToSessionError) $ (<*) <$> Decoders.Results.run decoder connection integerDatetimes <*> Decoders.Results.run Decoders.Results.dropRemainders connection integerDatetimes @@ -133,7 +133,7 @@ statement params (Statement.Statement sql (Encoders.Params encoder) (Decoders.Re True -> pure (Right recv) where recv = - fmap (mapLeft commandToSessionError) + fmap (first commandToSessionError) $ (<*) <$> Decoders.Results.run decoder connection integerDatetimes <*> Decoders.Results.run Decoders.Results.dropRemainders connection integerDatetimes diff --git a/library/Hasql/Prelude.hs b/library/Hasql/Prelude.hs index 88e6911..cf80c9b 100644 --- a/library/Hasql/Prelude.hs +++ b/library/Hasql/Prelude.hs @@ -7,7 +7,6 @@ module Hasql.Prelude forMToZero_, forMFromZero_, strictCons, - mapLeft, ) where @@ -130,8 +129,3 @@ forMFromZero_ !endN f = strictCons :: a -> [a] -> [a] strictCons !a b = let !c = a : b in c - -{-# INLINE mapLeft #-} -mapLeft :: (a -> c) -> Either a b -> Either c b -mapLeft f = - either (Left . f) Right diff --git a/library/Hasql/Session/Core.hs b/library/Hasql/Session/Core.hs index 23c3db0..c84fcb7 100644 --- a/library/Hasql/Session/Core.hs +++ b/library/Hasql/Session/Core.hs @@ -35,7 +35,7 @@ sql sql = $ ReaderT $ \(Connection.Connection pqConnectionRef integerDatetimes registry) -> ExceptT - $ fmap (mapLeft (QuerySessionError sql [])) + $ fmap (first (QuerySessionError sql [])) $ withMVar pqConnectionRef $ \pqConnection -> do r1 <- IO.sendNonparametricStatement pqConnection sql @@ -53,7 +53,7 @@ statement input (Statement.Statement template (Encoders.Params paramsEncoder) (D $ ReaderT $ \(Connection.Connection pqConnectionRef integerDatetimes registry) -> ExceptT - $ fmap (mapLeft (QuerySessionError template (Encoders.Params.renderReadable paramsEncoder input))) + $ fmap (first (QuerySessionError template (Encoders.Params.renderReadable paramsEncoder input))) $ withMVar pqConnectionRef $ \pqConnection -> do r1 <- IO.sendParametricStatement pqConnection integerDatetimes registry template paramsEncoder preparable input diff --git a/testing-kit/Hasql/TestingKit/TestingDsl.hs b/testing-kit/Hasql/TestingKit/TestingDsl.hs index 5183939..3d91810 100644 --- a/testing-kit/Hasql/TestingKit/TestingDsl.hs +++ b/testing-kit/Hasql/TestingKit/TestingDsl.hs @@ -37,10 +37,10 @@ runSessionOnLocalDb session = runExceptT $ acquire >>= \connection -> use connection <* release connection where acquire = - ExceptT $ fmap (mapLeft ConnectionError) $ Connection.acquire Constants.localConnectionSettings + ExceptT $ fmap (first ConnectionError) $ Connection.acquire Constants.localConnectionSettings use connection = ExceptT - $ fmap (mapLeft SessionError) + $ fmap (first SessionError) $ Session.run session connection release connection = lift $ Connection.release connection