oops 0.1.6.0 → 0.2.0.0
raw patch · 3 files changed
+108/−222 lines, 3 files
Files
- oops.cabal +5/−2
- src/Control/Monad/Oops.hs +103/−110
- src/Control/Monad/Oops/Classic.hs +0/−110
oops.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: oops-version: 0.1.6.0+version: 0.2.0.0 synopsis: Combinators for handling errors of many types in a composable way description: Combinators for handling errors of many types in a composable way. homepage: https://www.github.com/haskell-works/oops@@ -39,6 +39,9 @@ common project-config default-language: Haskell2010+ default-extensions: BlockArguments+ RankNTypes+ ScopedTypeVariables ghc-options: -Wall library@@ -48,7 +51,6 @@ QuickCheck, transformers, exposed-modules: Control.Monad.Oops- Control.Monad.Oops.Classic Data.Variant hs-source-dirs: src default-language: Haskell2010@@ -82,6 +84,7 @@ hspec, hw-hspec-hedgehog, lens,+ mtl, QuickCheck, template-haskell, type: exitcode-stdio-1.0
src/Control/Monad/Oops.hs view
@@ -20,48 +20,48 @@ module Control.Monad.Oops ( -- * MTL/transformer utilities- catchFM,- catchM,+ catchF,+ catch, - throwFM,- throwM,+ throwF,+ throw, - snatchFM,- snatchM,+ snatchF,+ snatch, runOops,- runOops0,- runOops1,- suspendM,+ runOopsInExceptT,+ runOopsInEither,+ suspend, - catchAsLeftM,- catchAsNothingM,- catchAndExitFailureM, - throwLeftM,- throwNothingM,- throwNothingAsM,+ catchOrMap,+ catchAsLeft,+ catchAsNothing,+ catchAndExitFailure, - throwPureLeftM,- throwPureNothingM,- throwPureNothingAsM,+ hoistEither,+ hoistMaybe, - leftM,- nothingM,+ onLeftThrow,+ onNothingThrow, - recoverM,- recoverOrVoidM,+ onLeft,+ onNothing, - onExceptionThrowM,- onExceptionM,+ recover,+ recoverOrVoid, - DV.CouldBeF (..),- DV.CouldBe (..),- DV.CouldBeAnyOfF,- DV.CouldBeAnyOf,- DV.Variant,- DV.VariantF(..),+ onExceptionThrow,+ onException, + CouldBeF,+ CouldBe,+ CouldBeAnyOfF,+ CouldBeAnyOf,+ Variant,+ VariantF,+ ) where import Control.Monad.Error.Class (MonadError (..))@@ -69,9 +69,8 @@ import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Except (mapExceptT, runExceptT) import Data.Bifunctor (first)-import Data.Function ((&)) import Data.Functor.Identity (Identity (..))-import Data.Variant (Catch, CatchF(..), CouldBe, CouldBeF(..), Variant, VariantF, preposterous)+import Data.Variant (Catch, CatchF, CouldBe, CouldBeAnyOf, CouldBeAnyOfF, CouldBeF, Variant, VariantF) import Data.Void (Void, absurd) import qualified Control.Monad.Catch as CMC@@ -87,231 +86,225 @@ -- us to map over the error type and change it as we go. If the error we catch -- is the one in the variant that we want to handle, we pluck it out and deal -- with it. Otherwise, we "re-throw" the variant minus the one we've handled.-catchFM :: forall x e e' f m a. ()+catchF :: forall x e e' f m a. () => Monad m => CatchF x e e' => (f x -> ExceptT (VariantF f e') m a) -> ExceptT (VariantF f e ) m a -> ExceptT (VariantF f e') m a-catchFM recover xs = mapExceptT (>>= go) xs+catchF h xs = mapExceptT (>>= go) xs where go = \case Right success -> pure (Right success)- Left failure -> case catchF @x failure of- Right hit -> runExceptT (recover hit)+ Left failure -> case DV.catchF @x failure of+ Right hit -> runExceptT (h hit) Left miss -> pure (Left miss) --- | Just the same as 'catchFM', but specialised for our plain 'Variant' and+-- | Just the same as 'catchF', but specialised for our plain 'Variant' and -- sounding much less like a radio station.-catchM :: forall x e e' m a. ()+catch :: forall x e e' m a. () => Monad m => Catch x e e' => (x -> ExceptT (Variant e') m a) -> ExceptT (Variant e ) m a -> ExceptT (Variant e') m a-catchM recover xs- = catchFM (recover . runIdentity) xs+catch h xs+ = catchF (h . runIdentity) xs --- | Same as 'catchFM' except the error is not removed from the type.+-- | Same as 'catchF' except the error is not removed from the type. -- This is useful for writing recursive computations or computations that -- rethrow the same error type.-snatchFM+snatchF :: forall x e f m a. () => Monad m => e `CouldBe` x => (f x -> ExceptT (VariantF f e) m a) -> ExceptT (VariantF f e) m a -> ExceptT (VariantF f e) m a-snatchFM recover xs = mapExceptT (>>= go) xs+snatchF h xs = mapExceptT (>>= go) xs where go = \case Right success -> pure (Right success)- Left failure -> case snatchF @_ @_ @x failure of- Right hit -> runExceptT (recover hit)+ Left failure -> case DV.snatchF @_ @_ @x failure of+ Right hit -> runExceptT (h hit) Left miss -> pure (Left miss) --- | Same as 'catchM' except the error is not removed from the type.+-- | Same as 'catch' except the error is not removed from the type. -- This is useful for writing recursive computations or computations that -- rethrow the same error type.-snatchM :: forall x e m a. ()+snatch :: forall x e m a. () => Monad m => e `CouldBe` x => (x -> ExceptT (Variant e) m a) -> ExceptT (Variant e) m a -> ExceptT (Variant e) m a-snatchM recover xs = snatchFM (recover . runIdentity) xs+snatch h xs = snatchF (h . runIdentity) xs -- | Throw an error into a variant 'MonadError' context. Note that this /isn't/ -- type-changing, so this can work for any 'MonadError', rather than just -- 'ExceptT'.-throwFM :: forall x e f m a. ()+throwF :: forall x e f m a. () => MonadError (VariantF f e) m => e `CouldBe` x => f x -> m a-throwFM = throwError . throwF+throwF = throwError . DV.throwF --- | Same as 'throwFM', but without the @f@ context. Given a value of some type+-- | Same as 'throwF', but without the @f@ context. Given a value of some type -- within a 'Variant' within a 'MonadError' context, "throw" the error.-throwM :: forall x e m a. ()+throw :: forall x e m a. () => MonadError (Variant e) m => e `CouldBe` x => x -> m a-throwM = throwFM . Identity+throw = throwF . Identity -- | Add 'ExceptT (Variant '[])' to the monad transformer stack. runOops :: () => Monad m => ExceptT (Variant '[]) m a -> m a-runOops f = either (absurd . preposterous) pure =<< runExceptT f+runOops f = either (absurd . DV.preposterous) pure =<< runExceptT f --- | Convert an 'ExceptT (Variant '[])' expression to an 'ExceptT Void' expression-runOops0 :: forall m a. Monad m => ExceptT (Variant '[]) m a -> ExceptT Void m a-runOops0 = mapExceptT (fmap (first (absurd . preposterous)))+-- | Run an oops expression that throws one error in an ExceptT.+runOopsInExceptT :: forall x m a. Monad m => ExceptT (Variant '[x]) m a -> ExceptT x m a+runOopsInExceptT = mapExceptT (fmap (first DV.toEithers)) --- | Convert an ExceptT (Variant '[x]) expression to an 'ExceptT x' expression-runOops1 :: forall x m a. Monad m => ExceptT (Variant '[x]) m a -> ExceptT x m a-runOops1 = mapExceptT (fmap (first DV.toEithers))+-- | Run an oops expression that throws one error in an Either.+--+-- This function can also be implemented this way (which could be instructive for implementing+-- your own combinators)+runOopsInEither :: forall x m a. Monad m => ExceptT (Variant '[x]) m a -> m (Either x a)+runOopsInEither = runExceptT . mapExceptT (fmap (first DV.toEithers)) -- | Suspend the 'ExceptT` monad transformer from the top of the stack so that the -- stack can be manipulated without the 'ExceptT` layer.-suspendM :: forall x m a n b. ()+suspend :: forall x m a n b. () => (m (Either x a) -> n (Either x b)) -> ExceptT x m a -> ExceptT x n b-suspendM f = ExceptT . f . runExceptT+suspend f = ExceptT . f . runExceptT -- | Catch the specified exception and return the caught value as 'Left'. If no -- value was caught, then return the returned value in 'Right'.-catchAsLeftM :: forall x e m a. ()+catchOrMap :: forall x a e' m b. Monad m+ => (b -> a)+ -> (x -> ExceptT (Variant e') m a)+ -> ExceptT (Variant (x : e')) m b+ -> ExceptT (Variant e') m a+catchOrMap g h = catch h . fmap g++-- | Catch the specified exception and return the caught value as 'Left'. If no+-- value was caught, then return the returned value in 'Right'.+catchAsLeft :: forall x e m a. () => Monad m => ExceptT (Variant (x : e)) m a -> ExceptT (Variant e) m (Either x a)-catchAsLeftM = catchM @x (pure . Left) . fmap Right+catchAsLeft = catchOrMap Right (pure . Left) --- | Catch the specified exception and return the caught value as 'Left'. If no--- value was caught, then return the returned value in 'Right'.-catchAsNothingM :: forall x e m a. ()+-- | Catch the specified exception and return 'Nothing'. If no+-- value was caught, then return the returned value in 'Just'.+catchAsNothing :: forall x e m a. () => Monad m => ExceptT (Variant (x : e)) m a -> ExceptT (Variant e) m (Maybe a)-catchAsNothingM = catchM @x (pure . (const Nothing)) . fmap Just+catchAsNothing = catchOrMap Just (pure . (const Nothing)) -- | Catch the specified exception. If that exception is caught, exit the program.-catchAndExitFailureM :: forall x e m a. ()+catchAndExitFailure :: forall x e m a. () => MonadIO m => ExceptT (Variant (x : e)) m a -> ExceptT (Variant e) m a-catchAndExitFailureM = catchM @x (const (liftIO IO.exitFailure))+catchAndExitFailure = catch @x (const (liftIO IO.exitFailure)) -- | When the expression of type 'Either x a' evaluates to 'Left x', throw the 'x', -- otherwise return 'a'.-throwLeftM :: forall x e m a. ()+hoistEither :: forall x e m a. () => MonadError (Variant e) m => CouldBeF e x => Monad m => Either x a -> m a-throwLeftM = either throwM pure---- | When the expression of type 'Maybe a' evaluates to 'Nothing', throw '()',--- otherwise return 'a'.-throwNothingM :: ()- => MonadError (Variant e) m- => CouldBeF e ()- => Monad m- => Maybe a- -> m a-throwNothingM = throwNothingAsM ()+hoistEither = either throw pure -- | When the expression of type 'Maybe a' evaluates to 'Nothing', throw the specified value, -- otherwise return 'a'.-throwNothingAsM :: forall e es m a. ()+hoistMaybe :: forall e es m a. () => MonadError (Variant es) m => CouldBe es e => e -> Maybe a -> m a-throwNothingAsM e = maybe (throwM e) pure+hoistMaybe e = maybe (throw e) pure -- | When the expression of type 'm (Either x a)' evaluates to 'pure (Left x)', throw the 'x', -- otherwise return 'a'.-throwPureLeftM :: forall x e m a. ()+onLeftThrow :: forall x e m a. () => MonadError (Variant e) m => CouldBeF e x => m (Either x a) -> m a-throwPureLeftM f = f >>= throwLeftM---- | When the expression of type 'Maybe a' evaluates to 'Nothing', throw '()',--- otherwise return 'a'.-throwPureNothingM :: ()- => MonadError (Variant e) m- => CouldBeF e ()- => Monad m- => m (Maybe a)- -> m a-throwPureNothingM f = f >>= throwNothingM+onLeftThrow f = f >>= hoistEither -- | When the expression of type 'Maybe a' evaluates to 'Nothing', throw the specified value, -- otherwise return 'a'.-throwPureNothingAsM :: forall e es m a. ()+onNothingThrow :: forall e es m a. () => MonadError (Variant es) m => CouldBe es e => e -> m (Maybe a) -> m a-throwPureNothingAsM e f = f >>= throwNothingAsM e+onNothingThrow e f = f >>= hoistMaybe e -leftM :: forall x m a. ()+-- | Handle the 'Left' constructor of the returned 'Either'+onLeft :: forall x m a. () => Monad m => (x -> m a) -> m (Either x a) -> m a-leftM g f = f >>= either g pure+onLeft g f = f >>= either g pure -nothingM :: forall m a. ()+-- | Handle the 'Nothing' constructor of the returned 'Maybe'+onNothing :: forall m a. () => Monad m => m a -> m (Maybe a) -> m a-nothingM g f = f >>= maybe g pure+onNothing g f = f >>= maybe g pure -- | Catch the specified exception and return it instead. -- The evaluated computation must return the same type that is being caught.-recoverM :: forall x e m a. ()+recover :: forall x e m a. () => Monad m => (x -> a) -> ExceptT (Variant (x : e)) m a -> ExceptT (Variant e) m a-recoverM g f = f & catchM (pure . g)+recover f = catch (pure . f) -- | Catch the specified exception and return it instead. The evaluated computation -- must return `Void` (ie. it never returns)-recoverOrVoidM :: forall x e m. ()+recoverOrVoid :: forall x e m. () => Monad m => ExceptT (Variant (x : e)) m Void -> ExceptT (Variant e) m x-recoverOrVoidM f = either pure absurd =<< (fmap Right f & catchM @x (pure . Left))+recoverOrVoid = catchOrMap @x absurd pure -- | Catch an exception of the specified type 'x' and throw it as an error-onExceptionThrowM :: forall x e m a. ()+onExceptionThrow :: forall x e m a. () => CMC.MonadCatch m => CMC.Exception x => MonadError (Variant e) m => CouldBeF e x => m a -> m a-onExceptionThrowM = onExceptionM @x throwM+onExceptionThrow = onException @x throw -- | Catch an exception of the specified type 'x' and call the the handler 'h'-onExceptionM :: forall x m a. ()+onException :: forall x m a. () => CMC.MonadCatch m => CMC.Exception x => (x -> m a) -> m a -> m a-onExceptionM h f = either h pure =<< CMC.try f+onException h f = either h pure =<< CMC.try f
− src/Control/Monad/Oops/Classic.hs
@@ -1,110 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE EmptyCase #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilyDependencies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-unused-imports #-}--module Control.Monad.Oops.Classic- ( -- * MTL/transformer utilities- catchFM,- catchM,-- snatchFM,- snatchM,-- Oops.throwFM,- Oops.throwM,-- Oops.runOops,- Oops.suspendM,-- Oops.catchAsLeftM,- Oops.catchAndExitFailureM,-- Oops.throwLeftM,- Oops.throwNothingM,- Oops.throwNothingAsM,-- Oops.recoverM,- Oops.recoverOrVoidM,-- DV.CouldBeF (..),- DV.CouldBe (..),- DV.CouldBeAnyOfF,- DV.CouldBeAnyOf,- DV.Variant,- DV.VariantF(..),-- ) where--import Control.Monad.Error.Class (MonadError (..))-import Control.Monad.Except (ExceptT(ExceptT))-import Data.Variant ( Catch, CatchF, CouldBe, Variant, VariantF )--import qualified Data.Variant as DV-import qualified Control.Monad.Oops as Oops---- | When working in some monadic context, using 'catch' becomes trickier. The--- intuitive behaviour is that each 'catch' shrinks the variant in the left--- side of my 'MonadError', but this is therefore type-changing: as we can only--- 'throwError' and 'catchError' with a 'MonadError' type, this is impossible!------ To get round this problem, we have to specialise to 'ExceptT', which allows--- us to map over the error type and change it as we go. If the error we catch--- is the one in the variant that we want to handle, we pluck it out and deal--- with it. Otherwise, we "re-throw" the variant minus the one we've handled.-catchFM :: forall x e e' f m a. ()- => Monad m- => CatchF x e e'- => ExceptT (VariantF f e ) m a- -> (f x -> ExceptT (VariantF f e') m a)- -> ExceptT (VariantF f e') m a-catchFM = flip Oops.catchFM---- | Just the same as 'catchFM', but specialised for our plain 'Variant' and--- sounding much less like a radio station.-catchM :: forall x e e' m a. ()- => Monad m- => Catch x e e'- => ExceptT (Variant e ) m a- -> (x -> ExceptT (Variant e') m a)- -> ExceptT (Variant e') m a-catchM = flip Oops.catchM---- | Same as 'catchFM' except the error is not removed from the type.--- This is useful for writing recursive computations or computations that--- rethrow the same error type.-snatchFM- :: forall x e f m a. ()- => Monad m- => e `CouldBe` x- => ExceptT (VariantF f e) m a- -> (f x -> ExceptT (VariantF f e) m a)- -> ExceptT (VariantF f e) m a-snatchFM = flip Oops.snatchFM---- | Same as 'catchM' except the error is not removed from the type.--- This is useful for writing recursive computations or computations that--- rethrow the same error type.-snatchM :: forall x e m a. ()- => Monad m- => e `CouldBe` x- => ExceptT (Variant e) m a- -> (x -> ExceptT (Variant e) m a)- -> ExceptT (Variant e) m a-snatchM = flip Oops.snatchM