Replace mapLeft with first

This commit is contained in:
Nikita Volkov 2024-04-27 07:33:08 +03:00
parent ddd667acb8
commit 14d78fb078
7 changed files with 15 additions and 21 deletions

View File

@ -51,7 +51,7 @@ rowsAffected =
then Left (UnexpectedResultError "Empty bytes") then Left (UnexpectedResultError "Empty bytes")
else Right bytes else Right bytes
decimal 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 $ Attoparsec.parseOnly (Attoparsec.decimal <* Attoparsec.endOfInput) bytes
{-# INLINE checkExecStatus #-} {-# INLINE checkExecStatus #-}
@ -112,7 +112,7 @@ maybe rowDec =
0 -> return (Right Nothing) 0 -> return (Right Nothing)
1 -> do 1 -> do
maxCols <- LibPQ.nfields result 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))) _ -> return (Left (UnexpectedAmountOfRowsResultError (rowToInt maxRows)))
where where
rowToInt (LibPQ.Row n) = rowToInt (LibPQ.Row n) =
@ -130,7 +130,7 @@ single rowDec =
case maxRows of case maxRows of
1 -> do 1 -> do
maxCols <- LibPQ.nfields result 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))) _ -> return (Left (UnexpectedAmountOfRowsResultError (rowToInt maxRows)))
where where
rowToInt (LibPQ.Row n) = rowToInt (LibPQ.Row n) =

View File

@ -45,7 +45,7 @@ single resultDec =
resultMaybe <- LibPQ.getResult connection resultMaybe <- LibPQ.getResult connection
case resultMaybe of case resultMaybe of
Just result -> Just result ->
mapLeft ResultCommandError <$> Result.run resultDec integerDatetimes result first ResultCommandError <$> Result.run resultDec integerDatetimes result
Nothing -> Nothing ->
fmap (Left . ClientCommandError) (LibPQ.errorMessage connection) fmap (Left . ClientCommandError) (LibPQ.errorMessage connection)
@ -64,11 +64,11 @@ dropRemainders =
loop integerDatetimes connection <* checkErrors loop integerDatetimes connection <* checkErrors
where where
checkErrors = 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 :: (a -> Either Text b) -> Results a -> Results b
refine refiner (Results stack) = Results refine refiner (Results stack) = Results
$ ReaderT $ ReaderT
$ \env -> ExceptT $ do $ \env -> ExceptT $ do
resultEither <- runExceptT $ runReaderT stack env resultEither <- runExceptT $ runReaderT stack env
return $ resultEither >>= mapLeft (ResultCommandError . UnexpectedResultError) . refiner return $ resultEither >>= first (ResultCommandError . UnexpectedResultError) . refiner

View File

@ -55,7 +55,7 @@ value valueDec =
Right Nothing Right Nothing
Just value -> Just value ->
fmap Just fmap Just
$ mapLeft ValueColumnError $ first ValueColumnError
$ {-# SCC "decode" #-} A.valueParser (Value.run valueDec integerDatetimes) value $ {-# SCC "decode" #-} A.valueParser (Value.run valueDec integerDatetimes) value
else pure (Left EndOfInputColumnError) else pure (Left EndOfInputColumnError)

View File

@ -45,7 +45,7 @@ run (Pipeline sendQueriesInIO) connection registry integerDatetimes = do
runResultsDecoder :: forall a. Decoders.Results.Results a -> ExceptT SessionError IO a runResultsDecoder :: forall a. Decoders.Results.Results a -> ExceptT SessionError IO a
runResultsDecoder decoder = runResultsDecoder decoder =
ExceptT ExceptT
$ fmap (mapLeft PipelineSessionError) $ fmap (first PipelineSessionError)
$ Decoders.Results.run decoder connection integerDatetimes $ Decoders.Results.run decoder connection integerDatetimes
runCommand :: IO Bool -> ExceptT SessionError IO () 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 else (False,) . Left . commandToSessionError . ClientCommandError <$> Pq.errorMessage connection
where where
recv = recv =
fmap (mapLeft commandToSessionError) fmap (first commandToSessionError)
$ (<*) $ (<*)
<$> Decoders.Results.run (Decoders.Results.single Decoders.Result.noResult) connection integerDatetimes <$> Decoders.Results.run (Decoders.Results.single Decoders.Result.noResult) connection integerDatetimes
<*> Decoders.Results.run Decoders.Results.dropRemainders 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) True -> pure (Right recv)
where where
recv = recv =
fmap (mapLeft commandToSessionError) fmap (first commandToSessionError)
$ (<*) $ (<*)
<$> Decoders.Results.run decoder connection integerDatetimes <$> Decoders.Results.run decoder connection integerDatetimes
<*> Decoders.Results.run Decoders.Results.dropRemainders 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) True -> pure (Right recv)
where where
recv = recv =
fmap (mapLeft commandToSessionError) fmap (first commandToSessionError)
$ (<*) $ (<*)
<$> Decoders.Results.run decoder connection integerDatetimes <$> Decoders.Results.run decoder connection integerDatetimes
<*> Decoders.Results.run Decoders.Results.dropRemainders connection integerDatetimes <*> Decoders.Results.run Decoders.Results.dropRemainders connection integerDatetimes

View File

@ -7,7 +7,6 @@ module Hasql.Prelude
forMToZero_, forMToZero_,
forMFromZero_, forMFromZero_,
strictCons, strictCons,
mapLeft,
) )
where where
@ -130,8 +129,3 @@ forMFromZero_ !endN f =
strictCons :: a -> [a] -> [a] strictCons :: a -> [a] -> [a]
strictCons !a b = strictCons !a b =
let !c = a : b in c let !c = a : b in c
{-# INLINE mapLeft #-}
mapLeft :: (a -> c) -> Either a b -> Either c b
mapLeft f =
either (Left . f) Right

View File

@ -35,7 +35,7 @@ sql sql =
$ ReaderT $ ReaderT
$ \(Connection.Connection pqConnectionRef integerDatetimes registry) -> $ \(Connection.Connection pqConnectionRef integerDatetimes registry) ->
ExceptT ExceptT
$ fmap (mapLeft (QuerySessionError sql [])) $ fmap (first (QuerySessionError sql []))
$ withMVar pqConnectionRef $ withMVar pqConnectionRef
$ \pqConnection -> do $ \pqConnection -> do
r1 <- IO.sendNonparametricStatement pqConnection sql r1 <- IO.sendNonparametricStatement pqConnection sql
@ -53,7 +53,7 @@ statement input (Statement.Statement template (Encoders.Params paramsEncoder) (D
$ ReaderT $ ReaderT
$ \(Connection.Connection pqConnectionRef integerDatetimes registry) -> $ \(Connection.Connection pqConnectionRef integerDatetimes registry) ->
ExceptT ExceptT
$ fmap (mapLeft (QuerySessionError template (Encoders.Params.renderReadable paramsEncoder input))) $ fmap (first (QuerySessionError template (Encoders.Params.renderReadable paramsEncoder input)))
$ withMVar pqConnectionRef $ withMVar pqConnectionRef
$ \pqConnection -> do $ \pqConnection -> do
r1 <- IO.sendParametricStatement pqConnection integerDatetimes registry template paramsEncoder preparable input r1 <- IO.sendParametricStatement pqConnection integerDatetimes registry template paramsEncoder preparable input

View File

@ -37,10 +37,10 @@ runSessionOnLocalDb session =
runExceptT $ acquire >>= \connection -> use connection <* release connection runExceptT $ acquire >>= \connection -> use connection <* release connection
where where
acquire = acquire =
ExceptT $ fmap (mapLeft ConnectionError) $ Connection.acquire Constants.localConnectionSettings ExceptT $ fmap (first ConnectionError) $ Connection.acquire Constants.localConnectionSettings
use connection = use connection =
ExceptT ExceptT
$ fmap (mapLeft SessionError) $ fmap (first SessionError)
$ Session.run session connection $ Session.run session connection
release connection = release connection =
lift $ Connection.release connection lift $ Connection.release connection