FailT 0.1.0.1 → 0.1.1.0

raw patch · 5 files changed

+128/−17 lines, 5 filesdep ~mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: mtl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• FailT.cabal +1/−1
• src/Control/Monad/Trans/Fail.hs +84/−16
• src/Control/Monad/Trans/Fail/String.hs +16/−0
• src/Control/Monad/Trans/Fail/Text.hs +16/−0

@@ -1,5 +1,16 @@ # Changelog for `FailT` +## 0.1.1.0++* Remove unnecessary `IsString` constraint from instance definitions for GHC >= 8.10+* Add `MonadFix` instance.+* Add `MonadRWS` instance.+* Add `MonadAccum` and `MonadSelect` instances, whenever mtl-2.3 or newer is used.+* Add `MonadThrow` instance.+* Fix a bug in `Applicative` instance. Implementation for `*>` did not short circuit+  mondic computation.+* Add `throwErrorFailT` that uses `MonadError` interface.+ ## 0.1.0.0  * Initial release

@@ -1,5 +1,5 @@ name:                FailT-version:             0.1.0.1+version:             0.1.1.0 synopsis:            A 'FailT' monad transformer that plays well with 'MonadFail' description:     Fail gracefully when stuck in a 'MonadFail'

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ImplicitParams #-}@@ -8,6 +9,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE UndecidableInstances #-}+#if MIN_VERSION_mtl(2,3,0)+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE StandaloneDeriving #-}+#endif  -- | -- Module      : Control.Monad.Trans.Fail@@ -37,6 +42,7 @@   mapErrorFailT,   mapErrorsFailT,   exceptFailT,+  throwErrorFailT,   throwFailT,    -- * Helpers@@ -51,6 +57,7 @@ import Control.Monad.Cont import Control.Monad.Except import qualified Control.Monad.Fail as F+import Control.Monad.RWS.Class (MonadRWS) import Control.Monad.Reader import Control.Monad.State import Control.Monad.Writer@@ -67,7 +74,17 @@ #if MIN_VERSION_base(4,12,0) import Data.Functor.Contravariant #endif+#if MIN_VERSION_mtl(2,3,0)+import Control.Monad.Accum+import Control.Monad.Select+#endif +#if !(MIN_VERSION_base(4,13,0))+#define IS_MONAD_STRING IsString e,+#else+#define IS_MONAD_STRING+#endif+ -- | `FailT` transformer with `Identity` as the base monad. type Fail e = FailT e Identity @@ -214,6 +231,28 @@               } {-# INLINE exceptFailT #-} +-- | Same as `exceptFailT`, but works with any `MonadError`.+--+-- >>> throwErrorFailT (fail "A bad thing" >> pure () :: FailT String (Except FailException) ())+-- ExceptT (Identity (Left FailException+-- "A bad thing"+-- CallStack (from HasCallStack):+-- ...+throwErrorFailT+  :: (HasCallStack, Typeable e, Show e, MonadError FailException m)+  => FailT e m a+  -> m a+throwErrorFailT m =+  runFailAggT m >>= \case+    Right x -> pure x+    Left errMsgs ->+      throwError $+        FailException+          { failMessages = errMsgs+          , failCallStack = ?callStack+          }+{-# INLINE throwErrorFailT #-}+ -- | An exception that is produced by the `FailT` monad transformer. data FailException where   FailException@@ -266,7 +305,7 @@   fmap f (FailT m) = FailT (fmap (fmap f) m)   {-# INLINE fmap #-} -instance Monad m => Applicative (FailT e m) where+instance (IS_MONAD_STRING Monad m) => Applicative (FailT e m) where   pure = FailT . pure . Right   {-# INLINE pure #-} @@ -279,11 +318,11 @@             Left kerr -> pure $ Left kerr             Right a -> pure $ Right (f a)   {-# INLINE (<*>) #-}-  FailT m *> FailT k = FailT $ m *> k+  m *> k = m >>= \_ -> k   {-# INLINE (*>) #-}  -- | Short-circuites on the first failing operation.-instance (IsString e, Monad m) => Monad (FailT e m) where+instance (IS_MONAD_STRING Monad m) => Monad (FailT e m) where   FailT m >>= k =     FailT $       m >>= \case@@ -309,7 +348,7 @@   {-# INLINE traverse #-}  -- | Short-circuits on the first successful operation, combines failures otherwise.-instance Monad m => Alternative (FailT e m) where+instance (IS_MONAD_STRING Monad m) => Alternative (FailT e m) where   empty = FailT $ pure (Left [])   {-# INLINE empty #-}   FailT m <|> FailT k = FailT $ do@@ -317,13 +356,13 @@       Left merr ->         k >>= \case           Left kerr -> pure $ Left $ merr ++ kerr-          Right result -> pure $ Right $ result-      Right x -> pure (Right x)+          Right result -> pure $ Right result+      Right result -> pure $ Right result   {-# INLINEABLE (<|>) #-}  -- | Executes all monadic actions and combines all successful results using a `Semi.Semigroup` -- instance. Combines together all failures as well, until a successful operation.-instance (Monad m, Semi.Semigroup a) => Semi.Semigroup (FailT e m a) where+instance (IS_MONAD_STRING Monad m, Semi.Semigroup a) => Semi.Semigroup (FailT e m a) where   (<>) (FailT m) (FailT k) = FailT $ do     mres <- m     kres <- k@@ -338,14 +377,14 @@           Right y -> pure $ Right (x Semi.<> y)   {-# INLINEABLE (<>) #-} -instance (Monad m, Semi.Semigroup a) => Monoid (FailT e m a) where+instance (IS_MONAD_STRING Monad m, Semi.Semigroup a) => Monoid (FailT e m a) where   mempty = empty   {-# INLINE mempty #-} #if !(MIN_VERSION_base(4,11,0))   mappend = (Semi.<>) #endif -instance (IsString e, MonadIO m) => MonadIO (FailT e m) where+instance (IS_MONAD_STRING MonadIO m) => MonadIO (FailT e m) where   liftIO = lift . liftIO   {-# INLINE liftIO #-} @@ -353,10 +392,16 @@   lift = FailT . fmap Right   {-# INLINE lift #-} -instance (IsString e, MonadZip m) => MonadZip (FailT e m) where+instance (IS_MONAD_STRING MonadZip m) => MonadZip (FailT e m) where   mzipWith f (FailT a) (FailT b) = FailT $ mzipWith (liftA2 f) a b   {-# INLINE mzipWith #-} +instance (IS_MONAD_STRING MonadFix m) => MonadFix (FailT e m) where+  mfix f = FailT (mfix (runFailAggT . f . either explode id))+    where+      explode _errMsgs = error "mfix (FailT): inner computation returned Left value"+  {-# INLINE mfix #-}+ #if MIN_VERSION_base(4,12,0) instance Contravariant f => Contravariant (FailT e f) where   contramap f = FailT . contramap (fmap f) . runFailAggT@@ -401,7 +446,11 @@ instance (Show e, Show1 m, Show a) => Show (FailT e m a) where   showsPrec = showsPrec1 -instance (IsString e, MonadReader r m) => MonadReader r (FailT e m) where+instance (IS_MONAD_STRING MonadThrow m) => MonadThrow (FailT e m) where+  throwM = lift . throwM+  {-# INLINE throwM #-}++instance (IS_MONAD_STRING MonadReader r m) => MonadReader r (FailT e m) where   ask = lift ask   {-# INLINE ask #-}   local = mapFailT . local@@ -409,7 +458,7 @@   reader = lift . reader   {-# INLINE reader #-} -instance (IsString e, MonadState s m) => MonadState s (FailT e m) where+instance (IS_MONAD_STRING MonadState s m) => MonadState s (FailT e m) where   get = lift get   {-# INLINE get #-}   put = lift . put@@ -417,13 +466,13 @@   state = lift . state   {-# INLINE state #-} -instance (IsString e, MonadError e m) => MonadError e (FailT e m) where+instance (IS_MONAD_STRING MonadError e m) => MonadError e (FailT e m) where   throwError = lift . throwError   {-# INLINE throwError #-}   catchError = liftCatch catchError   {-# INLINE catchError #-} -instance (IsString e, MonadWriter w m) => MonadWriter w (FailT e m) where+instance (IS_MONAD_STRING MonadWriter w m) => MonadWriter w (FailT e m) where   writer = lift . writer   {-# INLINE writer #-}   tell = lift . tell@@ -433,7 +482,10 @@   pass = liftPass pass   {-# INLINE pass #-} -instance (IsString e, MonadCont m) => MonadCont (FailT e m) where+-- | @since 0.1.1+instance (IS_MONAD_STRING MonadRWS r w s m) => MonadRWS r w s (FailT e m)++instance (IS_MONAD_STRING MonadCont m) => MonadCont (FailT e m) where   callCC = liftCallCC callCC   {-# INLINE callCC #-} @@ -443,7 +495,7 @@   -> ((a -> FailT e m b) -> FailT e m a)   -> FailT e m a liftCallCC ccc f = FailT $ ccc $ \c ->-  runFailAggT (f (\a -> FailT $ c (Right a)))+  runFailAggT (f (FailT . c . Right)) {-# INLINE liftCallCC #-}  -- | Lift a @`catchE`@ operation to the new monad.@@ -478,3 +530,19 @@     Left errs -> (Left errs, id)     Right (v, f) -> (Right v, f) {-# INLINE liftPass #-}++#if MIN_VERSION_mtl(2,3,0)+-- | @since 0.1.1+deriving via+  (LiftingAccum (FailT e) m)+  instance+    (MonadAccum w m) =>+    MonadAccum w (FailT e m)++-- | @since 0.1.1+deriving via+  (LiftingSelect (FailT e) m)+  instance+    (MonadSelect r m) =>+    MonadSelect r (FailT e m)+#endif

@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}  -- |@@ -30,6 +31,7 @@   mapErrorFailT,   mapErrorsFailT,   exceptFailT,+  throwErrorFailT,   throwFailT, ) where @@ -138,6 +140,20 @@ exceptFailT :: (HasCallStack, Monad m) => FailT m a -> ExceptT F.FailException m a exceptFailT = F.exceptFailT {-# INLINE exceptFailT #-}++-- | Version of `F.throwErrorFailT` restricted to `String`+--+-- Same as `exceptFailT`, but works with any `MonadError`.+--+-- >>> import Control.Monad.Trans.Fail.String+-- >>> throwErrorFailT (fail "A bad thing" >> pure () :: FailT (Except FailException) ())+-- ExceptT (Identity (Left FailException+-- "A bad thing"+-- CallStack (from HasCallStack):+-- ...+throwErrorFailT :: (HasCallStack, MonadError F.FailException m) => FailT m a -> m a+throwErrorFailT = F.throwErrorFailT+{-# INLINE throwErrorFailT #-}  -- | Version of `F.throwFailT` restricted to `String` throwFailT :: (HasCallStack, MonadThrow m) => FailT m a -> m a

@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}  -- |@@ -30,6 +31,7 @@   mapErrorFailT,   mapErrorsFailT,   exceptFailT,+  throwErrorFailT,   throwFailT, ) where @@ -139,6 +141,20 @@ exceptFailT :: (HasCallStack, Monad m) => FailT m a -> ExceptT F.FailException m a exceptFailT = F.exceptFailT {-# INLINE exceptFailT #-}++-- | Version of `F.throwErrorFailT` restricted to `Text`+--+-- Same as `exceptFailT`, but works with any `MonadError`.+--+-- >>> import Control.Monad.Trans.Fail.Text+-- >>> throwErrorFailT (fail "A bad thing" >> pure () :: FailT (Except FailException) ())+-- ExceptT (Identity (Left FailException+-- "A bad thing"+-- CallStack (from HasCallStack):+-- ...+throwErrorFailT :: (HasCallStack, MonadError F.FailException m) => FailT m a -> m a+throwErrorFailT = F.throwErrorFailT+{-# INLINE throwErrorFailT #-}  -- | Version of `F.throwFailT` restricted to `Text` throwFailT :: (HasCallStack, MonadThrow m) => FailT m a -> m a