packages feed

exitcode 0.1.0.2 → 0.1.0.3

raw patch · 4 files changed

+303/−160 lines, 4 filesdep ~basedep ~lensdep ~transformersnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, lens, transformers

API changes (from Hackage documentation)

- Control.Exitcode: instance (Data.Functor.Bind.Class.Bind f, GHC.Base.Monad f) => Data.Functor.Bind.Class.Bind (Control.Exitcode.ExitcodeT f)
- Control.Exitcode: instance Data.Functor.Bind.Class.Apply f => Data.Functor.Bind.Class.Apply (Control.Exitcode.ExitcodeT f)
- Control.Exitcode: instance Data.Semigroup.Foldable.Class.Foldable1 f => Data.Semigroup.Foldable.Class.Foldable1 (Control.Exitcode.ExitcodeT f)
- Control.Exitcode: instance GHC.Base.Applicative f => Data.Functor.Extend.Extend (Control.Exitcode.ExitcodeT f)
- Control.Exitcode: instance GHC.Base.Applicative f => GHC.Base.Applicative (Control.Exitcode.ExitcodeT f)
+ Control.Exitcode: fromExitCode' :: ExitCode -> Exitcode0
+ Control.Exitcode: fromExitCodeValue :: Applicative f => Int -> a -> ExitcodeT f a
+ Control.Exitcode: fromExitCodeValue' :: Applicative f => Int -> ExitcodeT0 f
+ Control.Exitcode: instance Data.Functor.Extend.Extend f => Data.Functor.Extend.Extend (Control.Exitcode.ExitcodeT f)
+ Control.Exitcode: instance GHC.Base.Monad f => Data.Functor.Bind.Class.Apply (Control.Exitcode.ExitcodeT f)
+ Control.Exitcode: instance GHC.Base.Monad f => Data.Functor.Bind.Class.Bind (Control.Exitcode.ExitcodeT f)
+ Control.Exitcode: instance GHC.Base.Monad f => GHC.Base.Applicative (Control.Exitcode.ExitcodeT f)

Files

changelog.md view
@@ -1,3 +1,9 @@+0.1.0.3++* Fix bug in `Extend` instance.+* Remove `Extend` instance.+* Add more constructor functions.+ 0.1.0.2  * `_ExitSuccess` more polymorphic.
exitcode.cabal view
@@ -1,54 +1,54 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                exitcode-version:             0.1.0.2+version:             0.1.0.3 synopsis:            Monad transformer for exit codes-description:       -  <<http://i.imgur.com/uZnp9ke.png>>+description:+  <<https://system-f.gitlab.io/logo/systemf-450x450.jpg>>   .   Monad transformer for exit codes license:             BSD3 license-file:        LICENCE author:              Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>-maintainer:          Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>-copyright:           Copyright (C) 2017,2018 Commonwealth Scientific and Industrial Research Organisation (CSIRO)+maintainer:          Tony Morris <oᴉ˙ldɟb@llǝʞsɐɥ>+copyright:           Copyright (C) 2019-2022 Tony Morris category:            Control build-type:          Simple extra-source-files:  changelog.md cabal-version:       >=1.10-homepage:            https://github.com/qfpl/exitcode-bug-reports:         https://github.com/qfpl/exitcode/issues+homepage:            https://github.com/system-f/exitcode+bug-reports:         https://github.com/system-f/exitcode/issues tested-with:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1  source-repository   head   type:             git-  location:         git@github.com:qfpl/exitcode.git+  location:         git@github.com:system-f/exitcode.git  library   exposed-modules:     Control.Exitcode-  build-depends:       base >=4.8 && <4.13-                     , lens >=4.15 && < 4.18+  build-depends:       base >= 4.8 && < 6+                     , lens >= 4.15 && < 6                      , mmorph >= 1.0 && < 1.2-                     , mtl >=2.2 && <2.3-                     , semigroupoids >=5.1 && <5.4-                     , semigroups >=0.16 && <0.19-                     , transformers >=0.4.1 && <5.5+                     , mtl >= 2.2 && < 2.3+                     , semigroupoids >= 5.1 && < 5.4+                     , semigroups >= 0.16 && < 0.19+                     , transformers >= 0.5.0 && < 5.5   hs-source-dirs:      src   default-language:    Haskell2010   ghc-options:         -Wall  test-suite             tests-  build-depends:       QuickCheck >=2.9.2 && <2.13-                     , base >=4.8 && <4.13-                     , checkers >=0.4.6 && <0.5+  build-depends:       QuickCheck >= 2.9.2 && < 2.13+                     , base >= 4.8 && < 6+                     , checkers >= 0.4.6 && < 0.5                      , exitcode-                     , hedgehog >=0.5 && <0.7-                     , lens >=4.15 && <4.18-                     , tasty >=0.11 && <1.3-                     , tasty-hunit >=0.9 && <0.11-                     , tasty-hedgehog >= 0.1 && <0.3-                     , tasty-quickcheck >=0.8.4 && <0.11-                     , transformers >=0.4.1 && <5.5+                     , hedgehog >= 0.5 && < 0.7+                     , lens >= 4.15 && < 6+                     , tasty >= 0.11 && < 1.3+                     , tasty-hunit >= 0.9 && < 0.11+                     , tasty-hedgehog >= 0.1 && < 0.3+                     , tasty-quickcheck >= 0.8.4 && < 0.11+                     , transformers >= 0.5.0 && < 5.5   type:                exitcode-stdio-1.0   main-is:             Tests.hs   hs-source-dirs:      test
src/Control/Exitcode.hs view
@@ -1,77 +1,89 @@-{-# LANGUAGE NoImplicitPrelude     #-}-{-# LANGUAGE FlexibleInstances     #-}+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TupleSections         #-}-{-# LANGUAGE UndecidableInstances  #-}-{-# LANGUAGE CPP                   #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE LambdaCase #-}  module Control.Exitcode (-                        -- * Types-                          ExitcodeT-                        , Exitcode-                        , ExitcodeT0-                        , Exitcode0-                        -- * Construction-                        , exitsuccess-                        , exitsuccess0-                        , exitfailure0-                        , fromExitCode-                        -- * Extraction-                        , runExitcode-                        -- * Optics-                        , exitCode-                        , _ExitFailure-                        , _ExitSuccess-                        ) where+-- * Types+  ExitcodeT+, Exitcode+, ExitcodeT0+, Exitcode0+-- * Construction+, exitsuccess+, exitsuccess0+, exitfailure0+, fromExitCode+, fromExitCode'+, fromExitCodeValue+, fromExitCodeValue'+-- * Extraction+, runExitcode+-- * Optics+, exitCode+, _ExitFailure+, _ExitSuccess+) where -import           Control.Applicative        (Applicative(pure, (<*>)), liftA2)-import           Control.Category           ((.))-import           Control.Lens               (Iso, Prism', Prism, iso, prism', prism, view, over,-                                             (^?), _Left)-import           Control.Monad              (Monad(return, (>>=)))-import           Control.Monad.Cont.Class   (MonadCont (..))-import           Control.Monad.Error.Class  (MonadError (..))-import           Control.Monad.IO.Class     (MonadIO (liftIO))-import           Control.Monad.Morph        (MFunctor(hoist), MMonad(embed))-import           Control.Monad.Reader       (MonadReader (ask, local))-import           Control.Monad.RWS.Class    (MonadRWS)-import           Control.Monad.State.Lazy   (MonadState (get, put))-import           Control.Monad.Trans.Class  (MonadTrans (lift))-import           Control.Monad.Trans.Maybe  (MaybeT (MaybeT))-import           Control.Monad.Writer.Class (MonadWriter (listen, pass, tell, writer))-import           Data.Either                (Either(Left, Right), either)-import           Data.Eq                    (Eq((==)))-import           Data.Foldable              (Foldable(foldr))-import           Data.Function              (($), const, flip)-import           Data.Functor               (Functor(fmap), (<$>))-import           Data.Functor.Alt           (Alt, (<!>))-import           Data.Functor.Apply         (Apply, liftF2, (<.>))-import           Data.Functor.Bind          (Bind, (>>-))-# if MIN_VERSION_transformers(0,5,0)-import           Data.Functor.Classes       (Eq1, Ord1, Show1, compare1, eq1,+import Control.Applicative+    ( Applicative((<*>), liftA2, pure) )+import Control.Category ( Category((.)) )+import Control.Lens+    ( (^?),+      view,+      iso,+      _Left,+      prism,+      prism',+      over,+      Iso,+      Prism,+      Prism' )+import Control.Monad ( join, Monad(return, (>>=)) )+import Control.Monad.Cont.Class ( MonadCont(..) )+import Control.Monad.Error.Class ( MonadError(..) )+import Control.Monad.IO.Class ( MonadIO(..) )+import Control.Monad.Morph+    ( MFunctor(..), MMonad(..) )+import Control.Monad.Reader ( MonadReader(ask, local) )+import Control.Monad.RWS.Class+    ( MonadRWS )+import Control.Monad.State.Lazy+    ( MonadState(get, put) )+import Control.Monad.Trans.Class ( MonadTrans(..) )+import Control.Monad.Trans.Maybe ( MaybeT(MaybeT) )+import Control.Monad.Writer.Class ( MonadWriter(..) )+import Data.Bool+import Data.Either ( Either(..), either )+import Data.Eq ( Eq((==)) )+import Data.Foldable ( Foldable(foldr) )+import Data.Function ( ($), const, flip )+import Data.Functor ( Functor(fmap), (<$>) )+import Data.Functor.Alt ( Alt((<!>)) )+import Data.Functor.Apply ( Apply((<.>)) )+import Data.Functor.Bind ( Bind((>>-)) )+import Data.Functor.Classes (Eq1, Ord1, Show1, compare1, eq1,                                              liftCompare, liftEq, liftShowList,                                              liftShowsPrec, showsPrec1,                                              showsUnaryWith)-# else-import           Data.Functor.Classes       (Eq1, Ord1, Show1, compare1, eq1,-                                             showsPrec1, showsUnary1)-# endif-import           Data.Functor.Extend        (Extend, duplicated)-import           Data.Functor.Identity      (Identity (Identity))-import           Data.Int                   (Int)-import           Data.Maybe                 (Maybe(Just, Nothing), fromMaybe)-import           Data.Ord                   (Ord(compare))-import           Data.Semigroup             (Semigroup, (<>))-import           Data.Semigroup.Foldable    (Foldable1)-import           Data.Traversable           (Traversable(traverse))-import           Data.Tuple                 (uncurry)-import           Prelude                    (Show(showsPrec))-import           System.Exit                (ExitCode (ExitFailure, ExitSuccess))+import Data.Functor.Extend ( Extend(..) )+import Data.Functor.Identity ( Identity(Identity) )+import Data.Int ( Int )+import Data.Maybe ( Maybe(Nothing, Just), fromMaybe )+import Data.Ord ( Ord(compare) )+import Data.Semigroup ( Semigroup((<>)) )+import Data.Traversable ( Traversable(traverse) )+import Data.Tuple ( uncurry )+import GHC.Show ( Show(showsPrec) )+import System.Exit ( ExitCode(..) )  -- | An exit code status where failing with a value `0` cannot be represented. -- -- Transformer for either a non-zero exit code (`Int`) or a value :: `a`.-data ExitcodeT f a =+newtype ExitcodeT f a =   ExitcodeT (f (Either Int a))  type Exitcode a =@@ -84,6 +96,9 @@   Exitcode ()  -- | Construct a succeeding exit code with the given value.+--+-- >>> exitsuccess "abc" :: ExitcodeT Identity String+-- ExitcodeT (Identity (Right "abc")) exitsuccess ::   Applicative f =>   a@@ -92,6 +107,9 @@   ExitcodeT . pure . Right  -- | Construct a succeeding exit code with unit.+--+-- >>> exitsuccess0 :: ExitcodeT0 Identity+-- ExitcodeT (Identity (Right ())) exitsuccess0 ::   Applicative f =>   ExitcodeT0 f@@ -101,6 +119,9 @@ -- | Construct a failing exit code with the given status. -- -- If the given status is `0` then the exit code will succeed with unit.+--+-- >>> exitfailure0 99 :: ExitcodeT0 Identity+-- ExitcodeT (Identity (Left 99)) exitfailure0 ::   Applicative f =>   Int@@ -112,6 +133,12 @@     else       ExitcodeT . pure . Left $ n +-- | From base exitcode.+--+-- >>> fromExitCode (Identity ExitSuccess)+-- ExitcodeT (Identity (Right ()))+-- >>> fromExitCode (Identity (ExitFailure 99))+-- ExitcodeT (Identity (Left 99)) fromExitCode ::   Functor f =>   f ExitCode@@ -120,6 +147,51 @@   let ExitcodeT (MaybeT r) = view exitCode x   in  ExitcodeT (fromMaybe (Right ()) <$> r) +-- | From base exitcode.+--+-- >>> fromExitCode' ExitSuccess+-- ExitcodeT (Identity (Right ()))+-- >>> fromExitCode' (ExitFailure 99)+-- ExitcodeT (Identity (Left 99))+-- >>> fromExitCode' (ExitFailure 0)+-- ExitcodeT (Identity (Right ()))+fromExitCode' ::+  ExitCode+  -> Exitcode0+fromExitCode' =+  fromExitCode . Identity++-- |+--+-- >>> fromExitCodeValue 99 "abc" :: ExitcodeT Identity String+-- ExitcodeT (Identity (Left 99))+-- >>> fromExitCodeValue 0 "abc" :: ExitcodeT Identity String+-- ExitcodeT (Identity (Right "abc"))+fromExitCodeValue ::+  Applicative f =>+  Int+  -> a+  -> ExitcodeT f a+fromExitCodeValue n a =+  ExitcodeT (pure (bool (Left n) (Right a) (n == 0)))++fromExitCodeValue' ::+  Applicative f =>+  Int+  -> ExitcodeT0 f+fromExitCodeValue' n =+  fromExitCodeValue n ()++-- | Isomorphism from base exitcode to underlying `Maybe (Either Int ())` where `Int` is non-zero.+--+-- >>> view exitCode (Identity (ExitFailure 99))+-- ExitcodeT (MaybeT (Identity (Just (Left 99))))+-- >>> view exitCode (Identity ExitSuccess)+-- ExitcodeT (MaybeT (Identity (Just (Right ()))))+-- >>> review exitCode (exitfailure0 99) :: Identity ExitCode+-- Identity (ExitFailure 99)+-- >>> review exitCode exitsuccess0 :: Identity ExitCode+-- Identity ExitSuccess exitCode ::   (Functor f, Functor g) =>   Iso@@ -129,27 +201,41 @@     (ExitcodeT0 (MaybeT g)) exitCode =   iso-    (\x -> ExitcodeT (MaybeT ((\e ->  case e of-                                        ExitSuccess ->-                                          Just (Right ())-                                        ExitFailure 0 ->-                                          Nothing-                                        ExitFailure n ->-                                          Just (Left n)) <$> x)))-    (\(ExitcodeT (MaybeT x)) -> (\e ->  case e of-                                          Just (Right ()) ->-                                            ExitSuccess-                                          Nothing ->-                                            ExitFailure 0-                                          Just (Left n) ->-                                            ExitFailure n) <$> x)+    (\x -> ExitcodeT (MaybeT ((\case+                                ExitSuccess ->+                                  Just (Right ())+                                ExitFailure 0 ->+                                  Nothing+                                ExitFailure n ->+                                  Just (Left n)) <$> x)))+    (\(ExitcodeT (MaybeT x)) -> (\case+                                  Just (Right ()) ->+                                    ExitSuccess+                                  Nothing ->+                                    ExitFailure 0+                                  Just (Left n) ->+                                    ExitFailure n) <$> x) +-- | Extract either the non-zero value or the success value.+--+-- >>> runExitcode exitsuccess0 :: Identity (Either Int ())+-- Identity (Right ())+-- >>> runExitcode (exitfailure0 99) :: Identity (Either Int ())+-- Identity (Left 99) runExitcode ::   ExitcodeT f a   -> f (Either Int a) runExitcode (ExitcodeT x) =   x +-- | A prism to exit failure.+--+-- >>> preview _ExitFailure (exitfailure0 99)+-- Just 99+-- >>> preview _ExitFailure exitsuccess0+-- Nothing+-- >>> review _ExitFailure 99+-- ExitcodeT (Identity (Left 99)) _ExitFailure ::   Prism'     Exitcode0@@ -159,6 +245,14 @@     exitfailure0     (\(ExitcodeT (Identity x)) -> x ^? _Left) +-- | A prism to exit success.+--+-- >>> preview _ExitSuccess (exitfailure0 99)+-- Nothing+-- >>> preview _ExitSuccess exitsuccess0+-- Just ()+-- >>> review _ExitSuccess "abc"+-- ExitcodeT (Identity (Right "abc")) _ExitSuccess ::   Prism     (Exitcode a)@@ -176,17 +270,29 @@   fmap f (ExitcodeT x) =     ExitcodeT (fmap (fmap f) x) -instance Apply f => Apply (ExitcodeT f) where+instance Monad f => Apply (ExitcodeT f) where   ExitcodeT f <.> ExitcodeT a =-    ExitcodeT (liftF2 (<.>) f a)+    ExitcodeT (f >>= either (pure . Left) (\f' -> fmap (fmap f') a)) -instance Applicative f => Applicative (ExitcodeT f) where+instance Monad f => Applicative (ExitcodeT f) where   pure =     ExitcodeT . pure . pure   ExitcodeT f <*> ExitcodeT a =-    ExitcodeT (liftA2 (<*>) f a)+    ExitcodeT (f >>= either (pure . Left) (\f' -> fmap (fmap f') a)) -instance (Bind f, Monad f) => Bind (ExitcodeT f) where+-- |+--+-- >>> exitsuccess "abc" >>= \s -> exitsuccess (reverse s) :: ExitcodeT Identity String+-- ExitcodeT (Identity (Right "cba"))+-- >>> exitsuccess "abc" >>= \_ -> exitfailure0 99 :: ExitcodeT Identity ()+-- ExitcodeT (Identity (Left 99))+-- >>> exitfailure0 99 >>= \_ -> exitsuccess "abc" :: ExitcodeT Identity String+-- ExitcodeT (Identity (Left 99))+-- >>> exitfailure0 99 >>= \_ -> exitfailure0 88 :: ExitcodeT Identity ()+-- ExitcodeT (Identity (Left 99))+-- >>> let loop = loop in exitfailure0 99 >>= loop :: ExitcodeT Identity ()+-- ExitcodeT (Identity (Left 99))+instance Monad f => Bind (ExitcodeT f) where   (>>-) =     (>>=) @@ -195,7 +301,7 @@     ExitcodeT . return . return   ExitcodeT x >>= f =     ExitcodeT-      (x >>= either (pure . Left) (\a -> let ExitcodeT y = f a in y))+      (x >>= either (pure . Left) (runExitcode . f))  instance Monad f => Alt (ExitcodeT f) where   ExitcodeT a <!> ExitcodeT b =@@ -205,60 +311,57 @@   ExitcodeT a <> ExitcodeT b =     ExitcodeT (a >>= either (const b) (pure a)) -instance Applicative f => Extend (ExitcodeT f) where+-- |+--+-- >>> duplicated (exitfailure0 99) :: ExitcodeT Identity (ExitcodeT Identity ())+-- ExitcodeT (Identity (Right (ExitcodeT (Identity (Left 99)))))+-- >>> duplicated (exitsuccess "abc") :: ExitcodeT Identity (ExitcodeT Identity String)+-- ExitcodeT (Identity (Right (ExitcodeT (Identity (Right "abc")))))+instance Extend f => Extend (ExitcodeT f) where   duplicated (ExitcodeT x) =-    ExitcodeT ((pure <$>) <$> x )+    ExitcodeT (extended (Right . ExitcodeT) x)  instance (Eq1 f, Eq a) => Eq (ExitcodeT f a) where   ExitcodeT a == ExitcodeT b =     a `eq1` b  instance Eq1 f => Eq1 (ExitcodeT f) where-# if MIN_VERSION_transformers(0,5,0)   liftEq f (ExitcodeT a) (ExitcodeT b) =     liftEq (liftEq f) a b-# else-  eq1 (ExitcodeT a) (ExitcodeT b) =-   eq1 a b-# endif  instance (Ord1 f, Ord a) => Ord (ExitcodeT f a) where   ExitcodeT a `compare` ExitcodeT b =     a `compare1` b  instance (Ord1 f) => Ord1 (ExitcodeT f) where-# if MIN_VERSION_transformers(0,5,0)   liftCompare f (ExitcodeT a) (ExitcodeT b) =     liftCompare (liftCompare f) a b-# else-  compare1 (ExitcodeT a) (ExitcodeT b) =-    compare1 a b-# endif  instance (Show1 f, Show a) => Show (ExitcodeT f a) where   showsPrec d (ExitcodeT m) =-# if MIN_VERSION_transformers(0,5,0)     showsUnaryWith showsPrec1 "ExitcodeT" d m-# else-    showsUnary1 "ExitcodeT" d m-# endif  instance Show1 f => Show1 (ExitcodeT f) where-# if MIN_VERSION_transformers(0,5,0)   liftShowsPrec sp sl d (ExitcodeT fa) =     let showsPrecF = liftA2 liftShowsPrec (uncurry liftShowsPrec) (uncurry liftShowList) (sp, sl)-     in showsUnaryWith showsPrecF "ExitcodeT" d fa-# else-  showsPrec1 d (ExitcodeT fa) =-    showsUnary1 "ExitcodeT" d fa-# endif+    in showsUnaryWith showsPrecF "ExitcodeT" d fa  instance Foldable f => Foldable (ExitcodeT f) where   foldr f z (ExitcodeT x) =     foldr (flip (foldr f)) z x -instance Foldable1 f => Foldable1 (ExitcodeT f)-+-- |+--+-- >>> traverse id [exitfailure0 99] :: ExitcodeT Identity [()]+-- ExitcodeT (Identity (Left 99))+-- >>> traverse id [exitfailure0 99, exitsuccess0] :: ExitcodeT Identity [()]+-- ExitcodeT (Identity (Left 99))+-- >>> traverse id [exitfailure0 99, exitsuccess0, exitfailure0 88] :: ExitcodeT Identity [()]+-- ExitcodeT (Identity (Left 99))+-- >>> traverse id [exitsuccess0, exitfailure0 88] :: ExitcodeT Identity [()]+-- ExitcodeT (Identity (Left 88))+-- >>> traverse id [exitsuccess0] :: ExitcodeT Identity [()]+-- ExitcodeT (Identity (Right [()])) instance Traversable f => Traversable (ExitcodeT f) where   traverse f (ExitcodeT x) =     ExitcodeT <$> traverse (traverse f) x@@ -268,30 +371,64 @@     ExitcodeT (Right <$> liftIO io)  instance MonadTrans ExitcodeT where-  lift = ExitcodeT . (>>= pure . pure)+  lift =+    ExitcodeT . (>>= pure . pure)  instance MonadReader r f => MonadReader r (ExitcodeT f) where-  ask = lift ask-  local f (ExitcodeT m) = ExitcodeT $ local f m+  ask =+    lift ask+  local f (ExitcodeT m) =+    ExitcodeT (local f m) +-- |+--+-- >>> writer'' ('x', "abc")+-- ExitcodeT ("abc",Right 'x')+-- >>> listen (exitfailure0 99 :: ExitcodeT ((,) String) ())+-- ExitcodeT ("",Left 99)+-- >>> listen (exitsuccess 99 :: ExitcodeT ((,) String) Int)+-- ExitcodeT ("",Right (99,""))+-- >>> tell "abc" :: ExitcodeT ((,) String) ()+-- ExitcodeT ("abc",Right ())+-- >>> pass (exitsuccess ('x', reverse)) :: ExitcodeT ((,) String) Char+-- ExitcodeT ("",Right 'x')+-- >>> pass (('x', reverse) <$ (exitfailure0 99 :: ExitcodeT ((,) String) ()))+-- ExitcodeT ("",Left 99) instance MonadWriter w f => MonadWriter w (ExitcodeT f) where-  writer t = ExitcodeT . fmap pure $ writer t+  writer t =+    ExitcodeT . fmap pure $ writer t   listen (ExitcodeT m) =-     ExitcodeT ((\(e, w) -> (,w) <$> e) <$> listen m)-  tell = ExitcodeT . fmap Right . tell-  pass e = do-    ((a, f), w) <- listen e-    tell (f w)-    pure a+    ExitcodeT ((\(e, w) -> (,w) <$> e) <$> listen m)+  tell =+    ExitcodeT . fmap Right . tell+  pass e =+    do  ((a, f), w) <- listen e+        tell (f w)+        pure a  instance MonadState s f => MonadState s (ExitcodeT f) where-  get = ExitcodeT (fmap Right get)-  put = ExitcodeT . fmap Right . put+  get =+    ExitcodeT (fmap Right get)+  put =+    ExitcodeT . fmap Right . put +-- |+--+-- >>> throwError 99 :: ExitcodeT (Either Int) String+-- ExitcodeT (Left 99)+-- >>> catchError exitsuccess0 exitfailure0 :: ExitcodeT (Either Int) ()+-- ExitcodeT (Right (Right ()))+-- >>> catchError (exitfailure0 99) (\_ -> exitsuccess0) :: ExitcodeT (Either Int) ()+-- ExitcodeT (Right (Left 99))+-- >>> catchError (exitfailure0 99) exitfailure0 :: ExitcodeT (Either Int) ()+-- ExitcodeT (Right (Left 99))+-- >>> catchError exitsuccess0 (\_ -> exitsuccess0) :: ExitcodeT (Either Int) ()+-- ExitcodeT (Right (Right ())) instance MonadError e f => MonadError e (ExitcodeT f) where-  throwError = ExitcodeT . fmap Right . throwError+  throwError =+    ExitcodeT . fmap Right . throwError   catchError (ExitcodeT f) h =-     ExitcodeT $ flip catchError (runExitcode . h) f+     ExitcodeT (catchError f (runExitcode . h))  instance MonadRWS r w s f => MonadRWS r w s (ExitcodeT f) @@ -299,22 +436,22 @@ -- This code taken from the ExceptT instance: --   https://hackage.haskell.org/package/transformers-0.5.4.0/docs/src/Control.Monad.Trans.Except.html#line-237 instance MonadCont f => MonadCont (ExitcodeT f) where-  callCC = liftCallCC callCC--liftCallCC :: Functor f => (((Either Int a -> f (Either Int b)) -> f (Either Int a)) -> f (Either Int a))-           -> ((a -> ExitcodeT f b) -> ExitcodeT f a)-           -> ExitcodeT f a-liftCallCC callCC' f =-  ExitcodeT . callCC' $-    \c -> runExitcode (f (\a -> ExitcodeT (c (Right a))))+  callCC =+    let liftCallCC callCC' f =+          ExitcodeT . callCC' $+            \c -> runExitcode (f (ExitcodeT . c . Right))+    in  liftCallCC callCC +-- |+--+-- >>> hoist (\(Identity x) -> Just x) exitsuccess0+-- ExitcodeT (Just (Right ()))+-- >>> hoist (\(Identity x) -> Just x) (exitfailure0 99)+-- ExitcodeT (Just (Left 99)) instance MFunctor ExitcodeT where   hoist nat (ExitcodeT x) =     ExitcodeT (nat x)  instance MMonad ExitcodeT where-  embed nat (ExitcodeT x) = -    let ex (Left e) = Left e-        ex (Right (Left e)) = Left e-        ex (Right (Right a)) = Right a-    in  ExitcodeT (fmap ex (let ExitcodeT y = nat x in y))+  embed nat (ExitcodeT x) =+    ExitcodeT (join <$> runExitcode (nat x))
test/Tests.hs view
@@ -25,13 +25,13 @@  newtype EW f a = EW { unEW :: ExitcodeT f a } deriving (Eq, Show) -instance (Applicative f, Arbitrary a) => Arbitrary (EW f a) where+instance (Monad f, Arbitrary a) => Arbitrary (EW f a) where   arbitrary = fmap (EW . pure) TQC.arbitrary  instance Functor f => Functor (EW f) where   fmap f = EW . fmap f . unEW -instance Applicative f => Applicative (EW f) where+instance Monad f => Applicative (EW f) where   pure = EW . pure   EW f <*> EW a = EW (f <*> a)