diff options
| author | Simon Jakobi <simon.jakobi@gmail.com> | 2018-11-22 11:51:53 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-11-22 13:14:02 -0500 |
| commit | 66f0056ae1279c3149053aa600c7fe09575212b1 (patch) | |
| tree | 411bfd21e5fab0db4976eddfe177a29fdb4baa36 | |
| parent | 390df8b51b917fb6409cbde8e73fe838d61d8832 (diff) | |
| download | haskell-66f0056ae1279c3149053aa600c7fe09575212b1.tar.gz | |
Refactor TcRnMonad.mapAndRecoverM
This version doesn't require the 'reverse' step after the monadic
fold.
Test Plan: ./validate
Reviewers: bgamari, tdammers
Reviewed By: tdammers
Subscribers: monoidal, rwbarton, carter
Differential Revision: https://phabricator.haskell.org/D5343
| -rw-r--r-- | compiler/typecheck/TcRnMonad.hs | 2 | ||||
| -rw-r--r-- | compiler/utils/Maybes.hs | 5 |
2 files changed, 6 insertions, 1 deletions
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index eb5a63afd7..a033bc44a5 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -990,7 +990,7 @@ recoverM recover thing -- | Drop elements of the input that fail, so the result -- list can be shorter than the argument list mapAndRecoverM :: (a -> TcRn b) -> [a] -> TcRn [b] -mapAndRecoverM f = fmap reverse . foldAndRecoverM (\xs x -> (:xs) <$> f x ) [] +mapAndRecoverM f = mapMaybeM (fmap rightToMaybe . try_m . f) -- | The accumulator is not updated if the action fails foldAndRecoverM :: (b -> a -> TcRn b) -> b -> [a] -> TcRn b diff --git a/compiler/utils/Maybes.hs b/compiler/utils/Maybes.hs index 3a139a5b36..14bc46b9b8 100644 --- a/compiler/utils/Maybes.hs +++ b/compiler/utils/Maybes.hs @@ -18,6 +18,7 @@ module Maybes ( firstJust, firstJusts, whenIsJust, expectJust, + rightToMaybe, -- * MaybeT MaybeT(..), liftMaybeT, tryMaybeT @@ -62,6 +63,10 @@ whenIsJust Nothing _ = return () orElse :: Maybe a -> a -> a orElse = flip fromMaybe +rightToMaybe :: Either a b -> Maybe b +rightToMaybe (Left _) = Nothing +rightToMaybe (Right x) = Just x + {- ************************************************************************ * * |