{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-}

module Control.Exitcode (
-- * Types
  ExitcodeT
, Exitcode
, ExitcodeT0
, Exitcode0
-- * Construction
, exitsuccess
, exitsuccess0
, exitfailure0
, fromExitCode
, fromExitCode'
, fromExitCodeValue
, fromExitCodeValue'
-- * Extraction
, runExitcode
-- * Optics
, exitCode
, _ExitFailure
, _ExitSuccess
) where

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)
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`.
newtype ExitcodeT f a =
  ExitcodeT (f (Either Int a))

type Exitcode a =
  ExitcodeT Identity a

type ExitcodeT0 f =
  ExitcodeT f ()

type Exitcode0 =
  Exitcode ()

-- | Construct a succeeding exit code with the given value.
--
-- >>> exitsuccess "abc" :: ExitcodeT Identity String
-- ExitcodeT (Identity (Right "abc"))
exitsuccess ::
  Applicative f =>
  a
  -> ExitcodeT f a
exitsuccess :: a -> ExitcodeT f a
exitsuccess =
  f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int a) -> ExitcodeT f a)
-> (a -> f (Either Int a)) -> a -> ExitcodeT f a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either Int a -> f (Either Int a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Int a -> f (Either Int a))
-> (a -> Either Int a) -> a -> f (Either Int a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Either Int a
forall a b. b -> Either a b
Right

-- | Construct a succeeding exit code with unit.
--
-- >>> exitsuccess0 :: ExitcodeT0 Identity
-- ExitcodeT (Identity (Right ()))
exitsuccess0 ::
  Applicative f =>
  ExitcodeT0 f
exitsuccess0 :: ExitcodeT0 f
exitsuccess0 =
  () -> ExitcodeT0 f
forall (f :: * -> *) a. Applicative f => a -> ExitcodeT f a
exitsuccess ()

-- | 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
  -> ExitcodeT0 f
exitfailure0 :: Int -> ExitcodeT0 f
exitfailure0 Int
n =
  if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then
      ExitcodeT0 f
forall (f :: * -> *). Applicative f => ExitcodeT0 f
exitsuccess0
    else
      f (Either Int ()) -> ExitcodeT0 f
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int ()) -> ExitcodeT0 f)
-> (Int -> f (Either Int ())) -> Int -> ExitcodeT0 f
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either Int () -> f (Either Int ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Int () -> f (Either Int ()))
-> (Int -> Either Int ()) -> Int -> f (Either Int ())
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Either Int ()
forall a b. a -> Either a b
Left (Int -> ExitcodeT0 f) -> Int -> ExitcodeT0 f
forall a b. (a -> b) -> a -> b
$ Int
n

-- | From base exitcode.
--
-- >>> fromExitCode (Identity ExitSuccess)
-- ExitcodeT (Identity (Right ()))
-- >>> fromExitCode (Identity (ExitFailure 99))
-- ExitcodeT (Identity (Left 99))
fromExitCode ::
  Functor f =>
  f ExitCode
  -> ExitcodeT0 f
fromExitCode :: f ExitCode -> ExitcodeT0 f
fromExitCode f ExitCode
x =
  let ExitcodeT (MaybeT f (Maybe (Either Int ()))
r) = Getting
  (ExitcodeT (MaybeT f) ()) (f ExitCode) (ExitcodeT (MaybeT f) ())
-> f ExitCode -> ExitcodeT (MaybeT f) ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (ExitcodeT (MaybeT f) ()) (f ExitCode) (ExitcodeT (MaybeT f) ())
forall (f :: * -> *) (g :: * -> *).
(Functor f, Functor g) =>
Iso
  (f ExitCode)
  (g ExitCode)
  (ExitcodeT0 (MaybeT f))
  (ExitcodeT0 (MaybeT g))
exitCode f ExitCode
x
  in  f (Either Int ()) -> ExitcodeT0 f
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (Either Int () -> Maybe (Either Int ()) -> Either Int ()
forall a. a -> Maybe a -> a
fromMaybe (() -> Either Int ()
forall a b. b -> Either a b
Right ()) (Maybe (Either Int ()) -> Either Int ())
-> f (Maybe (Either Int ())) -> f (Either Int ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Maybe (Either Int ()))
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' :: ExitCode -> Exitcode0
fromExitCode' =
  Identity ExitCode -> Exitcode0
forall (f :: * -> *). Functor f => f ExitCode -> ExitcodeT0 f
fromExitCode (Identity ExitCode -> Exitcode0)
-> (ExitCode -> Identity ExitCode) -> ExitCode -> Exitcode0
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExitCode -> Identity ExitCode
forall a. a -> Identity a
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 :: Int -> a -> ExitcodeT f a
fromExitCodeValue Int
n a
a =
  f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (Either Int a -> f (Either Int a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Int a -> Either Int a -> Bool -> Either Int a
forall a. a -> a -> Bool -> a
bool (Int -> Either Int a
forall a b. a -> Either a b
Left Int
n) (a -> Either Int a
forall a b. b -> Either a b
Right a
a) (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)))

fromExitCodeValue' ::
  Applicative f =>
  Int
  -> ExitcodeT0 f
fromExitCodeValue' :: Int -> ExitcodeT0 f
fromExitCodeValue' Int
n =
  Int -> () -> ExitcodeT0 f
forall (f :: * -> *) a. Applicative f => Int -> a -> ExitcodeT f a
fromExitCodeValue Int
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
    (f ExitCode)
    (g ExitCode)
    (ExitcodeT0 (MaybeT f))
    (ExitcodeT0 (MaybeT g))
exitCode :: Iso
  (f ExitCode)
  (g ExitCode)
  (ExitcodeT0 (MaybeT f))
  (ExitcodeT0 (MaybeT g))
exitCode =
  (f ExitCode -> ExitcodeT0 (MaybeT f))
-> (ExitcodeT0 (MaybeT g) -> g ExitCode)
-> Iso
     (f ExitCode)
     (g ExitCode)
     (ExitcodeT0 (MaybeT f))
     (ExitcodeT0 (MaybeT g))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (\f ExitCode
x -> MaybeT f (Either Int ()) -> ExitcodeT0 (MaybeT f)
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Maybe (Either Int ())) -> MaybeT f (Either Int ())
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ((\case
                                ExitCode
ExitSuccess ->
                                  Either Int () -> Maybe (Either Int ())
forall a. a -> Maybe a
Just (() -> Either Int ()
forall a b. b -> Either a b
Right ())
                                ExitFailure Int
0 ->
                                  Maybe (Either Int ())
forall a. Maybe a
Nothing
                                ExitFailure Int
n ->
                                  Either Int () -> Maybe (Either Int ())
forall a. a -> Maybe a
Just (Int -> Either Int ()
forall a b. a -> Either a b
Left Int
n)) (ExitCode -> Maybe (Either Int ()))
-> f ExitCode -> f (Maybe (Either Int ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f ExitCode
x)))
    (\(ExitcodeT (MaybeT g (Maybe (Either Int ()))
x)) -> (\case
                                  Just (Right ()) ->
                                    ExitCode
ExitSuccess
                                  Maybe (Either Int ())
Nothing ->
                                    Int -> ExitCode
ExitFailure Int
0
                                  Just (Left Int
n) ->
                                    Int -> ExitCode
ExitFailure Int
n) (Maybe (Either Int ()) -> ExitCode)
-> g (Maybe (Either Int ())) -> g ExitCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Maybe (Either Int ()))
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 f a -> f (Either Int a)
runExitcode (ExitcodeT f (Either Int a)
x) =
  f (Either Int a)
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
    Int
_ExitFailure :: p Int (f Int) -> p Exitcode0 (f Exitcode0)
_ExitFailure =
  (Int -> Exitcode0)
-> (Exitcode0 -> Maybe Int) -> Prism Exitcode0 Exitcode0 Int Int
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
    Int -> Exitcode0
forall (f :: * -> *). Applicative f => Int -> ExitcodeT0 f
exitfailure0
    (\(ExitcodeT (Identity Either Int ()
x)) -> Either Int ()
x Either Int ()
-> Getting (First Int) (Either Int ()) Int -> Maybe Int
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Int) (Either Int ()) Int
forall a c b. Prism (Either a c) (Either b c) a b
_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)
    (Exitcode b)
    a
    b
_ExitSuccess :: p a (f b) -> p (Exitcode a) (f (Exitcode b))
_ExitSuccess =
  (b -> Exitcode b)
-> (Exitcode a -> Either (Exitcode b) a)
-> Prism (Exitcode a) (Exitcode b) a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    b -> Exitcode b
forall (f :: * -> *) a. Applicative f => a -> ExitcodeT f a
exitsuccess
    (\(ExitcodeT (Identity Either Int a
x)) ->
      ASetter (Either Int a) (Either (Exitcode b) a) Int (Exitcode b)
-> (Int -> Exitcode b) -> Either Int a -> Either (Exitcode b) a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Either Int a) (Either (Exitcode b) a) Int (Exitcode b)
forall a c b. Prism (Either a c) (Either b c) a b
_Left (Identity (Either Int b) -> Exitcode b
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (Identity (Either Int b) -> Exitcode b)
-> (Int -> Identity (Either Int b)) -> Int -> Exitcode b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either Int b -> Identity (Either Int b)
forall a. a -> Identity a
Identity (Either Int b -> Identity (Either Int b))
-> (Int -> Either Int b) -> Int -> Identity (Either Int b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Either Int b
forall a b. a -> Either a b
Left) Either Int a
x
    )

instance Functor f => Functor (ExitcodeT f) where
  fmap :: (a -> b) -> ExitcodeT f a -> ExitcodeT f b
fmap a -> b
f (ExitcodeT f (Either Int a)
x) =
    f (Either Int b) -> ExitcodeT f b
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT ((Either Int a -> Either Int b)
-> f (Either Int a) -> f (Either Int b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Either Int a -> Either Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) f (Either Int a)
x)

instance Monad f => Apply (ExitcodeT f) where
  ExitcodeT f (Either Int (a -> b))
f <.> :: ExitcodeT f (a -> b) -> ExitcodeT f a -> ExitcodeT f b
<.> ExitcodeT f (Either Int a)
a =
    f (Either Int b) -> ExitcodeT f b
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int (a -> b))
f f (Either Int (a -> b))
-> (Either Int (a -> b) -> f (Either Int b)) -> f (Either Int b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> f (Either Int b))
-> ((a -> b) -> f (Either Int b))
-> Either Int (a -> b)
-> f (Either Int b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either Int b -> f (Either Int b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Int b -> f (Either Int b))
-> (Int -> Either Int b) -> Int -> f (Either Int b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Either Int b
forall a b. a -> Either a b
Left) (\a -> b
f' -> (Either Int a -> Either Int b)
-> f (Either Int a) -> f (Either Int b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Either Int a -> Either Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f') f (Either Int a)
a))

instance Monad f => Applicative (ExitcodeT f) where
  pure :: a -> ExitcodeT f a
pure =
    f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int a) -> ExitcodeT f a)
-> (a -> f (Either Int a)) -> a -> ExitcodeT f a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either Int a -> f (Either Int a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Int a -> f (Either Int a))
-> (a -> Either Int a) -> a -> f (Either Int a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Either Int a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ExitcodeT f (Either Int (a -> b))
f <*> :: ExitcodeT f (a -> b) -> ExitcodeT f a -> ExitcodeT f b
<*> ExitcodeT f (Either Int a)
a =
    f (Either Int b) -> ExitcodeT f b
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int (a -> b))
f f (Either Int (a -> b))
-> (Either Int (a -> b) -> f (Either Int b)) -> f (Either Int b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> f (Either Int b))
-> ((a -> b) -> f (Either Int b))
-> Either Int (a -> b)
-> f (Either Int b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either Int b -> f (Either Int b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Int b -> f (Either Int b))
-> (Int -> Either Int b) -> Int -> f (Either Int b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Either Int b
forall a b. a -> Either a b
Left) (\a -> b
f' -> (Either Int a -> Either Int b)
-> f (Either Int a) -> f (Either Int b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Either Int a -> Either Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f') f (Either Int a)
a))

-- |
--
-- >>> 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
  >>- :: ExitcodeT f a -> (a -> ExitcodeT f b) -> ExitcodeT f b
(>>-) =
    ExitcodeT f a -> (a -> ExitcodeT f b) -> ExitcodeT f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)

instance Monad f => Monad (ExitcodeT f) where
  return :: a -> ExitcodeT f a
return =
    f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int a) -> ExitcodeT f a)
-> (a -> f (Either Int a)) -> a -> ExitcodeT f a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either Int a -> f (Either Int a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int a -> f (Either Int a))
-> (a -> Either Int a) -> a -> f (Either Int a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Either Int a
forall (m :: * -> *) a. Monad m => a -> m a
return
  ExitcodeT f (Either Int a)
x >>= :: ExitcodeT f a -> (a -> ExitcodeT f b) -> ExitcodeT f b
>>= a -> ExitcodeT f b
f =
    f (Either Int b) -> ExitcodeT f b
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT
      (f (Either Int a)
x f (Either Int a)
-> (Either Int a -> f (Either Int b)) -> f (Either Int b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> f (Either Int b))
-> (a -> f (Either Int b)) -> Either Int a -> f (Either Int b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either Int b -> f (Either Int b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Int b -> f (Either Int b))
-> (Int -> Either Int b) -> Int -> f (Either Int b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Either Int b
forall a b. a -> Either a b
Left) (ExitcodeT f b -> f (Either Int b)
forall (f :: * -> *) a. ExitcodeT f a -> f (Either Int a)
runExitcode (ExitcodeT f b -> f (Either Int b))
-> (a -> ExitcodeT f b) -> a -> f (Either Int b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> ExitcodeT f b
f))

instance Monad f => Alt (ExitcodeT f) where
  ExitcodeT f (Either Int a)
a <!> :: ExitcodeT f a -> ExitcodeT f a -> ExitcodeT f a
<!> ExitcodeT f (Either Int a)
b =
    f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int a)
a f (Either Int a)
-> (Either Int a -> f (Either Int a)) -> f (Either Int a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> f (Either Int a))
-> (a -> f (Either Int a)) -> Either Int a -> f (Either Int a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (f (Either Int a) -> Int -> f (Either Int a)
forall a b. a -> b -> a
const f (Either Int a)
b) (f (Either Int a) -> a -> f (Either Int a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure f (Either Int a)
a))

instance Monad f => Semigroup (ExitcodeT f a) where
  ExitcodeT f (Either Int a)
a <> :: ExitcodeT f a -> ExitcodeT f a -> ExitcodeT f a
<> ExitcodeT f (Either Int a)
b =
    f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int a)
a f (Either Int a)
-> (Either Int a -> f (Either Int a)) -> f (Either Int a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> f (Either Int a))
-> (a -> f (Either Int a)) -> Either Int a -> f (Either Int a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (f (Either Int a) -> Int -> f (Either Int a)
forall a b. a -> b -> a
const f (Either Int a)
b) (f (Either Int a) -> a -> f (Either Int a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure f (Either Int a)
a))

-- |
--
-- >>> 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 f a -> ExitcodeT f (ExitcodeT f a)
duplicated (ExitcodeT f (Either Int a)
x) =
    f (Either Int (ExitcodeT f a)) -> ExitcodeT f (ExitcodeT f a)
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT ((f (Either Int a) -> Either Int (ExitcodeT f a))
-> f (Either Int a) -> f (Either Int (ExitcodeT f a))
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (ExitcodeT f a -> Either Int (ExitcodeT f a)
forall a b. b -> Either a b
Right (ExitcodeT f a -> Either Int (ExitcodeT f a))
-> (f (Either Int a) -> ExitcodeT f a)
-> f (Either Int a)
-> Either Int (ExitcodeT f a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT) f (Either Int a)
x)

instance (Eq1 f, Eq a) => Eq (ExitcodeT f a) where
  ExitcodeT f (Either Int a)
a == :: ExitcodeT f a -> ExitcodeT f a -> Bool
== ExitcodeT f (Either Int a)
b =
    f (Either Int a)
a f (Either Int a) -> f (Either Int a) -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
`eq1` f (Either Int a)
b

instance Eq1 f => Eq1 (ExitcodeT f) where
  liftEq :: (a -> b -> Bool) -> ExitcodeT f a -> ExitcodeT f b -> Bool
liftEq a -> b -> Bool
f (ExitcodeT f (Either Int a)
a) (ExitcodeT f (Either Int b)
b) =
    (Either Int a -> Either Int b -> Bool)
-> f (Either Int a) -> f (Either Int b) -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool) -> Either Int a -> Either Int b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f) f (Either Int a)
a f (Either Int b)
b

instance (Ord1 f, Ord a) => Ord (ExitcodeT f a) where
  ExitcodeT f (Either Int a)
a compare :: ExitcodeT f a -> ExitcodeT f a -> Ordering
`compare` ExitcodeT f (Either Int a)
b =
    f (Either Int a)
a f (Either Int a) -> f (Either Int a) -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
`compare1` f (Either Int a)
b

instance (Ord1 f) => Ord1 (ExitcodeT f) where
  liftCompare :: (a -> b -> Ordering) -> ExitcodeT f a -> ExitcodeT f b -> Ordering
liftCompare a -> b -> Ordering
f (ExitcodeT f (Either Int a)
a) (ExitcodeT f (Either Int b)
b) =
    (Either Int a -> Either Int b -> Ordering)
-> f (Either Int a) -> f (Either Int b) -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering) -> Either Int a -> Either Int b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f) f (Either Int a)
a f (Either Int b)
b

instance (Show1 f, Show a) => Show (ExitcodeT f a) where
  showsPrec :: Int -> ExitcodeT f a -> ShowS
showsPrec Int
d (ExitcodeT f (Either Int a)
m) =
    (Int -> f (Either Int a) -> ShowS)
-> String -> Int -> f (Either Int a) -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> f (Either Int a) -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 String
"ExitcodeT" Int
d f (Either Int a)
m

instance Show1 f => Show1 (ExitcodeT f) where
  liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExitcodeT f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (ExitcodeT f (Either Int a)
fa) =
    let showsPrecF :: Int -> f (Either Int a) -> ShowS
showsPrecF = ((Int -> Either Int a -> ShowS)
 -> ([Either Int a] -> ShowS) -> Int -> f (Either Int a) -> ShowS)
-> ((Int -> a -> ShowS, [a] -> ShowS)
    -> Int -> Either Int a -> ShowS)
-> ((Int -> a -> ShowS, [a] -> ShowS) -> [Either Int a] -> ShowS)
-> (Int -> a -> ShowS, [a] -> ShowS)
-> Int
-> f (Either Int a)
-> ShowS
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Int -> Either Int a -> ShowS)
-> ([Either Int a] -> ShowS) -> Int -> f (Either Int a) -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec (((Int -> a -> ShowS)
 -> ([a] -> ShowS) -> Int -> Either Int a -> ShowS)
-> (Int -> a -> ShowS, [a] -> ShowS)
-> Int
-> Either Int a
-> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Either Int a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec) (((Int -> a -> ShowS) -> ([a] -> ShowS) -> [Either Int a] -> ShowS)
-> (Int -> a -> ShowS, [a] -> ShowS) -> [Either Int a] -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Either Int a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList) (Int -> a -> ShowS
sp, [a] -> ShowS
sl)
    in (Int -> f (Either Int a) -> ShowS)
-> String -> Int -> f (Either Int a) -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> f (Either Int a) -> ShowS
showsPrecF String
"ExitcodeT" Int
d f (Either Int a)
fa

instance Foldable f => Foldable (ExitcodeT f) where
  foldr :: (a -> b -> b) -> b -> ExitcodeT f a -> b
foldr a -> b -> b
f b
z (ExitcodeT f (Either Int a)
x) =
    (Either Int a -> b -> b) -> b -> f (Either Int a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((b -> Either Int a -> b) -> Either Int a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> b -> b) -> b -> Either Int a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f)) b
z f (Either Int a)
x

-- |
--
-- >>> 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 :: (a -> f b) -> ExitcodeT f a -> f (ExitcodeT f b)
traverse a -> f b
f (ExitcodeT f (Either Int a)
x) =
    f (Either Int b) -> ExitcodeT f b
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int b) -> ExitcodeT f b)
-> f (f (Either Int b)) -> f (ExitcodeT f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either Int a -> f (Either Int b))
-> f (Either Int a) -> f (f (Either Int b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> Either Int a -> f (Either Int b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) f (Either Int a)
x

instance MonadIO f => MonadIO (ExitcodeT f) where
  liftIO :: IO a -> ExitcodeT f a
liftIO IO a
io =
    f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (a -> Either Int a
forall a b. b -> Either a b
Right (a -> Either Int a) -> f a -> f (Either Int a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> f a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io)

instance MonadTrans ExitcodeT where
  lift :: m a -> ExitcodeT m a
lift =
    m (Either Int a) -> ExitcodeT m a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (m (Either Int a) -> ExitcodeT m a)
-> (m a -> m (Either Int a)) -> m a -> ExitcodeT m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (m a -> (a -> m (Either Int a)) -> m (Either Int a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Int a -> m (Either Int a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Int a -> m (Either Int a))
-> (a -> Either Int a) -> a -> m (Either Int a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Either Int a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

instance MonadReader r f => MonadReader r (ExitcodeT f) where
  ask :: ExitcodeT f r
ask =
    f r -> ExitcodeT f r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift f r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: (r -> r) -> ExitcodeT f a -> ExitcodeT f a
local r -> r
f (ExitcodeT f (Either Int a)
m) =
    f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT ((r -> r) -> f (Either Int a) -> f (Either Int a)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f f (Either Int a)
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 :: (a, w) -> ExitcodeT f a
writer (a, w)
t =
    f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int a) -> ExitcodeT f a)
-> (f a -> f (Either Int a)) -> f a -> ExitcodeT f a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> Either Int a) -> f a -> f (Either Int a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either Int a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a -> ExitcodeT f a) -> f a -> ExitcodeT f a
forall a b. (a -> b) -> a -> b
$ (a, w) -> f a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer (a, w)
t
  listen :: ExitcodeT f a -> ExitcodeT f (a, w)
listen (ExitcodeT f (Either Int a)
m) =
    f (Either Int (a, w)) -> ExitcodeT f (a, w)
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT ((\(Either Int a
e, w
w) -> (,w
w) (a -> (a, w)) -> Either Int a -> Either Int (a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Int a
e) ((Either Int a, w) -> Either Int (a, w))
-> f (Either Int a, w) -> f (Either Int (a, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Either Int a) -> f (Either Int a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen f (Either Int a)
m)
  tell :: w -> ExitcodeT f ()
tell =
    f (Either Int ()) -> ExitcodeT f ()
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int ()) -> ExitcodeT f ())
-> (w -> f (Either Int ())) -> w -> ExitcodeT f ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (() -> Either Int ()) -> f () -> f (Either Int ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap () -> Either Int ()
forall a b. b -> Either a b
Right (f () -> f (Either Int ()))
-> (w -> f ()) -> w -> f (Either Int ())
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. w -> f ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  pass :: ExitcodeT f (a, w -> w) -> ExitcodeT f a
pass ExitcodeT f (a, w -> w)
e =
    do  ((a
a, w -> w
f), w
w) <- ExitcodeT f (a, w -> w) -> ExitcodeT f ((a, w -> w), w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen ExitcodeT f (a, w -> w)
e
        w -> ExitcodeT f ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> w
f w
w)
        a -> ExitcodeT f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

instance MonadState s f => MonadState s (ExitcodeT f) where
  get :: ExitcodeT f s
get =
    f (Either Int s) -> ExitcodeT f s
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT ((s -> Either Int s) -> f s -> f (Either Int s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> Either Int s
forall a b. b -> Either a b
Right f s
forall s (m :: * -> *). MonadState s m => m s
get)
  put :: s -> ExitcodeT f ()
put =
    f (Either Int ()) -> ExitcodeT f ()
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int ()) -> ExitcodeT f ())
-> (s -> f (Either Int ())) -> s -> ExitcodeT f ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (() -> Either Int ()) -> f () -> f (Either Int ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap () -> Either Int ()
forall a b. b -> Either a b
Right (f () -> f (Either Int ()))
-> (s -> f ()) -> s -> f (Either Int ())
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> f ()
forall s (m :: * -> *). MonadState s m => s -> m ()
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 :: e -> ExitcodeT f a
throwError =
    f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int a) -> ExitcodeT f a)
-> (e -> f (Either Int a)) -> e -> ExitcodeT f a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> Either Int a) -> f a -> f (Either Int a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either Int a
forall a b. b -> Either a b
Right (f a -> f (Either Int a)) -> (e -> f a) -> e -> f (Either Int a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> f a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: ExitcodeT f a -> (e -> ExitcodeT f a) -> ExitcodeT f a
catchError (ExitcodeT f (Either Int a)
f) e -> ExitcodeT f a
h =
     f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int a) -> (e -> f (Either Int a)) -> f (Either Int a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError f (Either Int a)
f (ExitcodeT f a -> f (Either Int a)
forall (f :: * -> *) a. ExitcodeT f a -> f (Either Int a)
runExitcode (ExitcodeT f a -> f (Either Int a))
-> (e -> ExitcodeT f a) -> e -> f (Either Int a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> ExitcodeT f a
h))

instance MonadRWS r w s f => MonadRWS r w s (ExitcodeT f)

-- Given the embedded `Either` we can only handle computations that use `Either`.
-- 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 :: ((a -> ExitcodeT f b) -> ExitcodeT f a) -> ExitcodeT f a
callCC =
    let liftCallCC :: (((Either a a -> f (Either Int a)) -> f (Either Int a))
 -> f (Either Int a))
-> ((a -> ExitcodeT f a) -> ExitcodeT f a) -> ExitcodeT f a
liftCallCC ((Either a a -> f (Either Int a)) -> f (Either Int a))
-> f (Either Int a)
callCC' (a -> ExitcodeT f a) -> ExitcodeT f a
f =
          f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int a) -> ExitcodeT f a)
-> (((Either a a -> f (Either Int a)) -> f (Either Int a))
    -> f (Either Int a))
-> ((Either a a -> f (Either Int a)) -> f (Either Int a))
-> ExitcodeT f a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Either a a -> f (Either Int a)) -> f (Either Int a))
-> f (Either Int a)
callCC' (((Either a a -> f (Either Int a)) -> f (Either Int a))
 -> ExitcodeT f a)
-> ((Either a a -> f (Either Int a)) -> f (Either Int a))
-> ExitcodeT f a
forall a b. (a -> b) -> a -> b
$
            \Either a a -> f (Either Int a)
c -> ExitcodeT f a -> f (Either Int a)
forall (f :: * -> *) a. ExitcodeT f a -> f (Either Int a)
runExitcode ((a -> ExitcodeT f a) -> ExitcodeT f a
f (f (Either Int a) -> ExitcodeT f a
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (f (Either Int a) -> ExitcodeT f a)
-> (a -> f (Either Int a)) -> a -> ExitcodeT f a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either a a -> f (Either Int a)
c (Either a a -> f (Either Int a))
-> (a -> Either a a) -> a -> f (Either Int a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Either a a
forall a b. b -> Either a b
Right))
    in  (((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
forall a a (f :: * -> *) a (f :: * -> *) a (f :: * -> *) a.
(((Either a a -> f (Either Int a)) -> f (Either Int a))
 -> f (Either Int a))
-> ((a -> ExitcodeT f a) -> ExitcodeT f a) -> ExitcodeT f a
liftCallCC ((Either Int a -> f (Either Int b)) -> f (Either Int a))
-> f (Either Int a)
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
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 :: (forall a. m a -> n a) -> ExitcodeT m b -> ExitcodeT n b
hoist forall a. m a -> n a
nat (ExitcodeT m (Either Int b)
x) =
    n (Either Int b) -> ExitcodeT n b
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (m (Either Int b) -> n (Either Int b)
forall a. m a -> n a
nat m (Either Int b)
x)

instance MMonad ExitcodeT where
  embed :: (forall a. m a -> ExitcodeT n a) -> ExitcodeT m b -> ExitcodeT n b
embed forall a. m a -> ExitcodeT n a
nat (ExitcodeT m (Either Int b)
x) =
    n (Either Int b) -> ExitcodeT n b
forall (f :: * -> *) a. f (Either Int a) -> ExitcodeT f a
ExitcodeT (Either Int (Either Int b) -> Either Int b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either Int (Either Int b) -> Either Int b)
-> n (Either Int (Either Int b)) -> n (Either Int b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExitcodeT n (Either Int b) -> n (Either Int (Either Int b))
forall (f :: * -> *) a. ExitcodeT f a -> f (Either Int a)
runExitcode (m (Either Int b) -> ExitcodeT n (Either Int b)
forall a. m a -> ExitcodeT n a
nat m (Either Int b)
x))