packages feed

exitcode-0.3.0.0: src/Control/Exitcode/Exitcode.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
-- Required for instances like MonadReader r (Exitcode e f) where the
-- constraint MonadReader r f does not structurally decrease.
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}

module Control.Exitcode.Exitcode
  ( -- * Types
    Exitcode (..),
    Exitcode',
    ExitcodeBifunctor (..),
    ExitcodeBifunctor',

    -- * Construction
    mkExitcode,
    mkExitcode',
    mkExitSuccess,
    mkExitSuccess',
    mkExitFailure,
    mkExitFailure',
    mkExitFailure1,
    mkExitFailure1',
    mkExitFailure_1,
    mkExitFailure_1',
    fromExitCode,
    fromExitCode',
    toExitCode,
    toExitCode',
    hoistExitcode,
    embedExitcode,
    bimapExitcode,

    -- * Extraction
    runExitcode,
    maybeExitcode,
    maybeExitcode',

    -- * Exceptions
    tryExitcode,
    liftTryExitcode,

    -- * Optics
    exitCode,
    _Exitcode1,
    _Exitcode1',
    _ExitFailure,
    _ExitFailure',
    _ExitFailureCode,
    _ExitFailureCode',
    _ExitFailureValue,
    _ExitFailureValue',
    _ExitSuccess,
    _ExitSuccess',
  )
where

import Control.Applicative (Applicative (pure, (<*>)))
import Control.DeepSeq (NFData (rnf), NFData1 (liftRnf))
import Control.Exception (Exception, try)
import Control.Lens (FoldableWithIndex (ifoldMap), FunctorWithIndex (imap), Iso, Lens, Prism, Prism', Traversal, Traversal', TraversableWithIndex (itraverse), iso, preview, prism, prism', review, _Wrapped)
import Control.Monad (Monad ((>>=)), join)
import Control.Monad.Cont.Class (MonadCont (..))
import Control.Monad.Error.Class (MonadError (..))
import Control.Monad.Except (ExceptT (..))
import Control.Monad.Fix (MonadFix (mfix))
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.RWS.Class (MonadRWS)
import Control.Monad.Reader (MonadReader (ask, local), asks)
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 (..))
import Data.Bifoldable (Bifoldable (bifoldMap))
import Data.Bifunctor (Bifunctor (bimap))
import Data.Bitraversable (Bitraversable (bitraverse))
import Data.Either (Either (..), either)
import Data.Eq (Eq ((==)))
import Data.Foldable (Foldable (foldMap, toList))
import Data.Function (const, id, ($), (.))
import Data.Functor (Functor (fmap), (<$>))
import Data.Functor.Alt (Alt ((<!>)))
import Data.Functor.Apply (Apply ((<.>)))
import Data.Functor.Bind (Bind ((>>-)))
import Data.Functor.Bind.Trans (BindTrans (..))
import Data.Functor.Classes
  ( Eq1 (liftEq),
    Ord1 (liftCompare),
    Show1 (liftShowList, liftShowsPrec),
  )
import Data.Functor.Extend (Extend (duplicated, extended))
import Data.Functor.Identity (Identity (Identity, runIdentity))
import Data.Int (Int)
import Data.Maybe (Maybe (Just, Nothing))
import Data.Monoid (Monoid (mempty))
import Data.Ord (Ord (compare), (>))
import Data.Semigroup (Semigroup ((<>)))
import Data.Traversable (Traversable (traverse), mapAccumL)
import Data.Tuple (fst, snd)
import GHC.Generics (Generic)
import GHC.Show (Show (showsPrec), showParen, showString)
import Natural (NotZero, _NotZero, notZeroOr)
import Prelude (seq)
import System.Exit (ExitCode (ExitFailure, ExitSuccess))
import System.IO (IO)

-- $setup
-- >>> import Prelude
-- >>> import Control.Lens
-- >>> import Natural
-- >>> let nz1 = positiveNotZero one'
-- >>> let nz2 = positiveNotZero (successor1' one')

-- | An exit code status where failing with a value @0@ cannot be represented.
--
-- Wraps @f (Either (e, NotZero) a)@ where the @NotZero@ in the @Left@ branch
-- is a proven non-zero integer.
newtype Exitcode e f a
  = Exitcode (f (Either (e, NotZero) a))
  deriving stock (Generic)

-- | @Exitcode@ specialised to @Identity@.
type Exitcode' e a =
  Exitcode e Identity a

-- * Extraction

-- | Extract the underlying @f (Either (e, NotZero) a)@.
--
-- >>> runExitcode (mkExitSuccess' "abc")
-- Identity (Right "abc")
-- >>> runExitcode (mkExitFailure1' 'x')
-- Identity (Left ('x',NotZero True (Positive 1)))
{-# INLINE runExitcode #-}
runExitcode ::
  Exitcode e f a ->
  f (Either (e, NotZero) a)
runExitcode (Exitcode x) =
  x

-- | Extract the exit code as @Maybe NotZero@: @Nothing@ for success, @Just n@ for failure.
--
-- >>> maybeExitcode (mkExitSuccess (Identity ())) :: Identity (Maybe NotZero)
-- Identity Nothing
-- >>> maybeExitcode (mkExitFailure1 (Identity ())) :: Identity (Maybe NotZero)
-- Identity (Just (NotZero True (Positive 1)))
{-# INLINE maybeExitcode #-}
maybeExitcode ::
  (Functor f) =>
  Exitcode e f a ->
  f (Maybe NotZero)
maybeExitcode (Exitcode x) =
  fmap (either (Just . snd) (const Nothing)) x

-- | @maybeExitcode@ specialised to @Identity@.
--
-- >>> maybeExitcode' (mkExitSuccess' ())
-- Nothing
-- >>> maybeExitcode' (mkExitFailure1' ())
-- Just (NotZero True (Positive 1))
{-# INLINE maybeExitcode' #-}
maybeExitcode' ::
  Exitcode' e a ->
  Maybe NotZero
maybeExitcode' (Exitcode x) =
  either (Just . snd) (const Nothing) (runIdentity x)

-- * Optics

-- | Iso between @f ExitCode@ and @Exitcode () (MaybeT f) ()@.
--
-- @ExitFailure 0@ maps to @MaybeT Nothing@ (neither success nor failure).
-- @ExitSuccess@ maps to a success exitcode.
-- @ExitFailure n@ (where @n /= 0@) maps to a failure exitcode.
--
-- >>> import Control.Monad.Trans.Maybe
-- >>> view exitCode (Identity ExitSuccess)
-- Exitcode (MaybeT (Identity (Just (Right ()))))
-- >>> view exitCode (Identity (ExitFailure 99))
-- Exitcode (MaybeT (Identity (Just (Left ((),NotZero True (Positive 99))))))
-- >>> view exitCode (Identity (ExitFailure 0))
-- Exitcode (MaybeT (Identity Nothing))
-- >>> review exitCode (mkExitSuccess (MaybeT (Identity (Just ()))))
-- Identity ExitSuccess
-- >>> review exitCode (mkExitFailure1 (MaybeT (Identity (Just ()))))
-- Identity (ExitFailure 1)
{-# INLINE exitCode #-}
exitCode ::
  (Functor f, Functor g) =>
  Iso
    (f ExitCode)
    (g ExitCode)
    (Exitcode () (MaybeT f) ())
    (Exitcode () (MaybeT g) ())
exitCode =
  iso
    ( Exitcode
        . MaybeT
        . fmap
          ( \case
              ExitSuccess -> Just (Right ())
              ExitFailure n -> fmap (Left . ((),)) (preview _NotZero n)
          )
    )
    ( \(Exitcode (MaybeT x)) ->
        fmap
          ( \case
              Just (Right ()) -> ExitSuccess
              Nothing -> ExitFailure 0
              Just (Left ((), nz)) -> ExitFailure (review _NotZero nz)
          )
          x
    )

-- | Lens into the value of an @Exitcode' a a@, regardless of success or failure.
-- The exit code is preserved.
--
-- >>> over _Exitcode1 reverse (mkExitcode' "abc" nz1 :: Exitcode' String String)
-- Exitcode (Identity (Left ("cba",NotZero True (Positive 1))))
-- >>> over _Exitcode1 reverse (mkExitSuccess' "def")
-- Exitcode (Identity (Right "fed"))
{-# INLINE _Exitcode1 #-}
_Exitcode1 ::
  Lens
    (Exitcode' a a)
    (Exitcode' a' a')
    a
    a'
_Exitcode1 g (Exitcode (Identity x)) =
  fmap
    (\a' -> Exitcode (Identity (either (\(_, n) -> Left (a', n)) (const (Right a')) x)))
    (g (either fst id x))

-- | @_Exitcode1@ generalised to @Traversable f@.
--
-- >>> over _Exitcode1' (fmap reverse) (mkExitcode (Identity "abc") (Identity nz1) :: Exitcode String Identity String)
-- Exitcode (Identity (Left ("cba",NotZero True (Positive 1))))
-- >>> over _Exitcode1' (fmap reverse) (mkExitSuccess (Identity "def"))
-- Exitcode (Identity (Right "fed"))
{-# INLINE _Exitcode1' #-}
_Exitcode1' ::
  (Traversable f) =>
  Traversal' (Exitcode a f a) (f a)
_Exitcode1' g (Exitcode x) =
  fmap
    ( \fa' ->
        let (_, result) =
              mapAccumL
                ( \as' struct -> case as' of
                    (a' : rest) -> (rest, either (\(_, n) -> Left (a', n)) (const (Right a')) struct)
                    [] -> ([], struct)
                )
                (toList fa')
                x
         in Exitcode result
    )
    (g (fmap (either fst id) x))

-- | Prism into all-failure exitcodes.
--
-- >>> preview _ExitFailure (mkExitFailure1' 'x' :: Exitcode' Char ())
-- Just (Identity ('x',NotZero True (Positive 1)))
-- >>> preview _ExitFailure (mkExitSuccess' () :: Exitcode' Char ())
-- Nothing
{-# INLINE _ExitFailure #-}
_ExitFailure :: (Traversable f) => Prism' (Exitcode e f a) (f (e, NotZero))
_ExitFailure =
  prism'
    (Exitcode . fmap Left)
    (\(Exitcode x) -> traverse (either Just (const Nothing)) x)

-- | Type-changing prism into the failure case, specialised to @Identity@.
--
-- >>> preview _ExitFailure' (mkExitFailure1' 'x' :: Exitcode' Char ())
-- Just ('x',NotZero True (Positive 1))
-- >>> preview _ExitFailure' (mkExitSuccess' () :: Exitcode' Char ())
-- Nothing
-- >>> review _ExitFailure' ('y', nz2) :: Exitcode' Char ()
-- Exitcode (Identity (Left ('y',NotZero True (Positive 2))))
{-# INLINE _ExitFailure' #-}
_ExitFailure' :: Prism (Exitcode' e a) (Exitcode' e' a) (e, NotZero) (e', NotZero)
_ExitFailure' =
  prism
    (\(e', nz) -> Exitcode (Identity (Left (e', nz))))
    (\(Exitcode (Identity x)) -> case x of
      Left (e, nz) -> Right (e, nz)
      Right a -> Left (Exitcode (Identity (Right a))))

-- | Traversal into the @NotZero@ exit code values when all elements are failures.
--
-- >>> over _ExitFailureCode' (const nz1) (mkExitFailure' nz2 'x')
-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))
{-# INLINE _ExitFailureCode #-}
_ExitFailureCode :: (Traversable f) => Traversal' (Exitcode e f a) (f NotZero)
_ExitFailureCode g (Exitcode x) =
  case traverse (either Just (const Nothing)) x of
    Nothing -> pure (Exitcode x)
    Just pairs ->
      let rebuild newNZs =
            let (_, result) =
                  mapAccumL
                    ( \ns (e, nz) -> case ns of
                        n : rest -> (rest, (e, n))
                        [] -> ([], (e, nz))
                    )
                    (toList newNZs)
                    pairs
             in Exitcode (fmap Left result)
       in rebuild <$> g (fmap snd pairs)

-- | @_ExitFailureCode@ specialised to @Identity@.
{-# INLINE _ExitFailureCode' #-}
_ExitFailureCode' :: Traversal' (Exitcode' e a) NotZero
_ExitFailureCode' = _ExitFailureCode . _Wrapped

-- | Traversal into the error values when all elements are failures.
--
-- >>> over _ExitFailureValue' (const 'y') (mkExitFailure1' 'x')
-- Exitcode (Identity (Left ('y',NotZero True (Positive 1))))
-- >>> over _ExitFailureValue' (const 'y') (mkExitSuccess' () :: Exitcode' Char ())
-- Exitcode (Identity (Right ()))
{-# INLINE _ExitFailureValue #-}
_ExitFailureValue :: (Traversable f) => Traversal' (Exitcode e f a) (f e)
_ExitFailureValue g (Exitcode x) =
  case traverse (either Just (const Nothing)) x of
    Nothing -> pure (Exitcode x)
    Just pairs ->
      let rebuild newEs =
            let (_, result) =
                  mapAccumL
                    ( \es (e, nz) -> case es of
                        e' : rest -> (rest, (e', nz))
                        [] -> ([], (e, nz))
                    )
                    (toList newEs)
                    pairs
             in Exitcode (fmap Left result)
       in rebuild <$> g (fmap fst pairs)

-- | @_ExitFailureValue@ specialised to @Identity@.
{-# INLINE _ExitFailureValue' #-}
_ExitFailureValue' :: Traversal (Exitcode' e a) (Exitcode' e' a) e e'
_ExitFailureValue' g (Exitcode (Identity x)) =
  case x of
    Left (e, nz) -> fmap (\e' -> Exitcode (Identity (Left (e', nz)))) (g e)
    Right a -> pure (Exitcode (Identity (Right a)))

-- | Prism into all-success exitcodes.
--
-- >>> preview _ExitSuccess (mkExitSuccess' "abc" :: Exitcode' () String)
-- Just (Identity "abc")
-- >>> preview _ExitSuccess (mkExitFailure1' () :: Exitcode' () String)
-- Nothing
{-# INLINE _ExitSuccess #-}
_ExitSuccess :: (Traversable f) => Prism' (Exitcode e f a) (f a)
_ExitSuccess =
  prism'
    (Exitcode . fmap Right)
    (\(Exitcode x) -> traverse (either (const Nothing) Just) x)

-- | @_ExitSuccess@ specialised to @Identity@.
--
-- >>> preview _ExitSuccess' (mkExitSuccess' "abc" :: Exitcode' () String)
-- Just "abc"
-- >>> preview _ExitSuccess' (mkExitFailure1' () :: Exitcode' () String)
-- Nothing
{-# INLINE _ExitSuccess' #-}
_ExitSuccess' :: Prism (Exitcode' e a) (Exitcode' e a') a a'
_ExitSuccess' =
  prism
    (Exitcode . Identity . Right)
    ( \(Exitcode (Identity x)) -> case x of
        Right a -> Right a
        Left (e, i) -> Left (Exitcode (Identity (Left (e, i))))
    )

-- | Construct a failure exitcode with an error value and a non-zero exit code.
--
-- >>> mkExitcode (Identity 'x') (Identity nz1) :: Exitcode' Char ()
-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))
{-# INLINE mkExitcode #-}
mkExitcode :: (Applicative f) => f e -> f NotZero -> Exitcode e f a
mkExitcode e nz = Exitcode ((\e' nz' -> Left (e', nz')) <$> e <*> nz)

-- | @mkExitcode@ specialised to @Identity@.
--
-- >>> mkExitcode' 'x' nz1 :: Exitcode' Char ()
-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))
{-# INLINE mkExitcode' #-}
mkExitcode' :: e -> NotZero -> Exitcode' e a
mkExitcode' e nz = mkExitcode (Identity e) (Identity nz)

-- | Construct a success exitcode.
--
-- >>> mkExitSuccess (Identity "abc") :: Exitcode' () String
-- Exitcode (Identity (Right "abc"))
{-# INLINE mkExitSuccess #-}
mkExitSuccess :: (Functor f) => f a -> Exitcode e f a
mkExitSuccess = Exitcode . fmap Right

-- | @mkExitSuccess@ specialised to @Identity@.
--
-- >>> mkExitSuccess' "abc" :: Exitcode' () String
-- Exitcode (Identity (Right "abc"))
{-# INLINE mkExitSuccess' #-}
mkExitSuccess' :: a -> Exitcode' e a
mkExitSuccess' = mkExitSuccess . Identity

-- | Construct a failure exitcode with a proven non-zero exit code.
--
-- >>> mkExitFailure (Identity nz1) (Identity 'x') :: Exitcode' Char ()
-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))
{-# INLINE mkExitFailure #-}
mkExitFailure :: (Applicative f) => f NotZero -> f e -> Exitcode e f a
mkExitFailure n e = Exitcode ((\n' e' -> Left (e', n')) <$> n <*> e)

-- | @mkExitFailure@ specialised to @Identity@.
--
-- >>> mkExitFailure' nz1 'x' :: Exitcode' Char ()
-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))
{-# INLINE mkExitFailure' #-}
mkExitFailure' :: NotZero -> e -> Exitcode' e a
mkExitFailure' n e = mkExitFailure (Identity n) (Identity e)

-- | Construct a failure exitcode with exit code @1@.
--
-- >>> mkExitFailure1 (Identity 'x') :: Exitcode' Char ()
-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))
{-# INLINE mkExitFailure1 #-}
mkExitFailure1 :: (Functor f) => f e -> Exitcode e f a
mkExitFailure1 = Exitcode . fmap (\e' -> Left (e', notZeroOr (1 :: Int)))

-- | @mkExitFailure1@ specialised to @Identity@.
--
-- >>> mkExitFailure1' 'x' :: Exitcode' Char ()
-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))
{-# INLINE mkExitFailure1' #-}
mkExitFailure1' :: e -> Exitcode' e a
mkExitFailure1' = mkExitFailure1 . Identity

-- | Construct a failure exitcode with exit code @-1@.
--
-- >>> mkExitFailure_1 (Identity 'x') :: Exitcode' Char ()
-- Exitcode (Identity (Left ('x',NotZero False (Positive 1))))
{-# INLINE mkExitFailure_1 #-}
mkExitFailure_1 :: (Functor f) => f e -> Exitcode e f a
mkExitFailure_1 = Exitcode . fmap (\e' -> Left (e', notZeroOr (-1 :: Int)))

-- | @mkExitFailure_1@ specialised to @Identity@.
--
-- >>> mkExitFailure_1' 'x' :: Exitcode' Char ()
-- Exitcode (Identity (Left ('x',NotZero False (Positive 1))))
{-# INLINE mkExitFailure_1' #-}
mkExitFailure_1' :: e -> Exitcode' e a
mkExitFailure_1' = mkExitFailure_1 . Identity

-- | Convert from a base @ExitCode@. @ExitFailure 0@ is treated as success.
--
-- >>> fromExitCode (Identity ExitSuccess)
-- Exitcode (Identity (Right ()))
-- >>> fromExitCode (Identity (ExitFailure 99))
-- Exitcode (Identity (Left ((),NotZero True (Positive 99))))
-- >>> fromExitCode (Identity (ExitFailure 0))
-- Exitcode (Identity (Right ()))
{-# INLINE fromExitCode #-}
fromExitCode ::
  (Functor f) =>
  f ExitCode ->
  Exitcode () f ()
fromExitCode =
  Exitcode
    . fmap
      ( \case
          ExitSuccess -> Right ()
          ExitFailure n -> case preview _NotZero n of
            Just nz -> Left ((), nz)
            Nothing -> Right ()
      )

-- | @fromExitCode@ specialised to @Identity@.
--
-- >>> fromExitCode' ExitSuccess
-- Exitcode (Identity (Right ()))
-- >>> fromExitCode' (ExitFailure 99)
-- Exitcode (Identity (Left ((),NotZero True (Positive 99))))
-- >>> fromExitCode' (ExitFailure 0)
-- Exitcode (Identity (Right ()))
{-# INLINE fromExitCode' #-}
fromExitCode' ::
  ExitCode ->
  Exitcode' () ()
fromExitCode' =
  fromExitCode . Identity

-- | Convert an exitcode back to @f ExitCode@.
--
-- >>> toExitCode (mkExitSuccess (Identity ()))
-- Identity ExitSuccess
-- >>> toExitCode (mkExitFailure1 (Identity ()))
-- Identity (ExitFailure 1)
{-# INLINE toExitCode #-}
toExitCode ::
  (Functor f) =>
  Exitcode () f () ->
  f ExitCode
toExitCode (Exitcode x) =
  fmap (either (\((), nz) -> ExitFailure (review _NotZero nz)) (const ExitSuccess)) x

-- | @toExitCode@ specialised to @Identity@.
--
-- >>> toExitCode' (mkExitSuccess' ())
-- ExitSuccess
-- >>> toExitCode' (mkExitFailure1' ())
-- ExitFailure 1
{-# INLINE toExitCode' #-}
toExitCode' ::
  Exitcode' () () ->
  ExitCode
toExitCode' =
  runIdentity . toExitCode

-- | Apply a natural transformation to the base functor.
--
-- >>> hoistExitcode (Just . runIdentity) (mkExitSuccess' "abc") :: Exitcode () Maybe String
-- Exitcode (Just (Right "abc"))
{-# INLINE hoistExitcode #-}
hoistExitcode ::
  (forall x. f x -> g x) ->
  Exitcode e f a ->
  Exitcode e g a
hoistExitcode nat (Exitcode x) =
  Exitcode (nat x)

-- | Embed a natural transformation that returns an @Exitcode@.
--
-- >>> embedExitcode (\(Identity a) -> mkExitSuccess (Just a)) (mkExitSuccess' "abc") :: Exitcode () Maybe String
-- Exitcode (Just (Right "abc"))
-- >>> embedExitcode (\(Identity a) -> mkExitSuccess (Just a)) (mkExitFailure1' ()) :: Exitcode () Maybe ()
-- Exitcode (Just (Left ((),NotZero True (Positive 1))))
{-# INLINE embedExitcode #-}
embedExitcode ::
  (Functor g) =>
  (forall x. f x -> Exitcode e g x) ->
  Exitcode e f a ->
  Exitcode e g a
embedExitcode nat (Exitcode x) =
  Exitcode (join <$> runExitcode (nat x))

-- | Map both the error and success values via @Bifunctor@ on @ExitcodeBifunctor@.
--
-- >>> bimapExitcode (+1) (+10) (mkExitFailure1' 5 :: Exitcode' Int Int)
-- Exitcode (Identity (Left (6,NotZero True (Positive 1))))
-- >>> bimapExitcode (+1) (+10) (mkExitSuccess' 5 :: Exitcode' Int Int)
-- Exitcode (Identity (Right 15))
{-# INLINE bimapExitcode #-}
bimapExitcode ::
  (Functor f) =>
  (e -> e') ->
  (a -> a') ->
  Exitcode e f a ->
  Exitcode e' f a'
bimapExitcode f g (Exitcode x) =
  Exitcode (fmap (either (\(e, n) -> Left (f e, n)) (Right . g)) x)

-- * Exceptions

-- | Try the IO action producing the exitcode, catching exceptions into @ExceptT@.
{-# INLINE tryExitcode #-}
tryExitcode ::
  (Exception e') =>
  Exitcode e IO a ->
  Exitcode e (ExceptT e' IO) a
tryExitcode (Exitcode x) =
  Exitcode (ExceptT (try x))

-- | Lift an IO action into @Exitcode (ExceptT e' IO)@, catching exceptions.
{-# INLINE liftTryExitcode #-}
liftTryExitcode ::
  (Exception e') =>
  IO a ->
  Exitcode e (ExceptT e' IO) a
liftTryExitcode x =
  Exitcode (ExceptT (fmap (fmap Right) (try x)))

-- * RULES

{-# INLINE [0] exitcodeMap #-}
exitcodeMap :: (Functor f) => (a -> b) -> Exitcode e f a -> Exitcode e f b
exitcodeMap f (Exitcode x) = Exitcode (fmap (fmap f) x)

{-# INLINE [0] exitcodeFoldMap #-}
exitcodeFoldMap :: (Foldable f, Monoid m) => (a -> m) -> Exitcode e f a -> m
exitcodeFoldMap f (Exitcode x) = foldMap (either (const mempty) f) x

{-# RULES
"exitcodeMap/exitcodeMap" [~0] forall f g xs.
  exitcodeMap f (exitcodeMap g xs) =
    exitcodeMap (f . g) xs
"exitcodeFoldMap/exitcodeMap" [~0] forall f g xs.
  exitcodeFoldMap f (exitcodeMap g xs) =
    exitcodeFoldMap (f . g) xs
  #-}

-- * Exitcode Instances

-- |
--
-- >>> fmap (+1) (mkExitSuccess' 3) :: Exitcode' () Int
-- Exitcode (Identity (Right 4))
-- >>> fmap (+1) (mkExitFailure1' ()) :: Exitcode' () Int
-- Exitcode (Identity (Left ((),NotZero True (Positive 1))))
instance (Functor f) => Functor (Exitcode e f) where
  {-# INLINE fmap #-}
  fmap = exitcodeMap

-- |
--
-- >>> foldMap show (mkExitSuccess' 42) :: String
-- "42"
-- >>> foldMap show (mkExitFailure1' () :: Exitcode' () Int) :: String
-- ""
instance (Foldable f) => Foldable (Exitcode e f) where
  {-# INLINE foldMap #-}
  foldMap = exitcodeFoldMap

-- |
--
-- >>> traverse Just (mkExitSuccess' 42) :: Maybe (Exitcode' () Int)
-- Just (Exitcode (Identity (Right 42)))
-- >>> traverse (const Nothing) (mkExitSuccess' 42) :: Maybe (Exitcode' () Int)
-- Nothing
-- >>> traverse Just (mkExitFailure1' () :: Exitcode' () Int) :: Maybe (Exitcode' () Int)
-- Just (Exitcode (Identity (Left ((),NotZero True (Positive 1)))))
instance (Traversable f) => Traversable (Exitcode e f) where
  {-# INLINE traverse #-}
  traverse f (Exitcode x) =
    Exitcode <$> traverse (either (pure . Left) (fmap Right . f)) x

-- |
--
-- >>> imap (\_ a -> a + 1) (mkExitSuccess' 3) :: Exitcode' () Int
-- Exitcode (Identity (Right 4))
instance (FunctorWithIndex i f) => FunctorWithIndex i (Exitcode e f) where
  {-# INLINE imap #-}
  imap f (Exitcode x) = Exitcode (imap (\i -> fmap (f i)) x)

-- |
--
-- >>> ifoldMap (\_ a -> show a) (mkExitSuccess' 42) :: String
-- "42"
instance (FoldableWithIndex i f) => FoldableWithIndex i (Exitcode e f) where
  {-# INLINE ifoldMap #-}
  ifoldMap f (Exitcode x) = ifoldMap (\i -> either (const mempty) (f i)) x

-- |
--
-- >>> itraverse (\_ a -> Just (a + 1)) (mkExitSuccess' 42) :: Maybe (Exitcode' () Int)
-- Just (Exitcode (Identity (Right 43)))
instance (TraversableWithIndex i f) => TraversableWithIndex i (Exitcode e f) where
  {-# INLINE itraverse #-}
  itraverse f (Exitcode x) = Exitcode <$> itraverse (\i -> either (pure . Left) (fmap Right . f i)) x

-- |
--
-- >>> mkExitSuccess' (+1) <*> mkExitSuccess' 3 :: Exitcode' () Int
-- Exitcode (Identity (Right 4))
-- >>> mkExitFailure1' () <*> mkExitSuccess' 3 :: Exitcode' () Int
-- Exitcode (Identity (Left ((),NotZero True (Positive 1))))
instance (Monad f) => Apply (Exitcode e f) where
  {-# INLINE (<.>) #-}
  Exitcode f <.> Exitcode a =
    Exitcode (f >>= either (pure . Left) (\f' -> fmap (fmap f') a))

-- |
--
-- >>> pure 42 :: Exitcode' () Int
-- Exitcode (Identity (Right 42))
-- >>> mkExitSuccess' (+1) <*> mkExitSuccess' 3 :: Exitcode' () Int
-- Exitcode (Identity (Right 4))
-- >>> mkExitFailure1' () <*> mkExitSuccess' 3 :: Exitcode' () Int
-- Exitcode (Identity (Left ((),NotZero True (Positive 1))))
instance (Monad f) => Applicative (Exitcode e f) where
  {-# INLINE pure #-}
  pure = Exitcode . pure . Right
  {-# INLINE (<*>) #-}
  Exitcode f <*> Exitcode a =
    Exitcode (f >>= either (pure . Left) (\f' -> fmap (fmap f') a))

-- |
--
-- >>> mkExitSuccess' 3 >>- (\x -> mkExitSuccess' (x + 1)) :: Exitcode' () Int
-- Exitcode (Identity (Right 4))
instance (Monad f) => Bind (Exitcode e f) where
  {-# INLINE (>>-) #-}
  (>>-) = (>>=)

-- |
--
-- >>> mkExitSuccess' 3 >>= (\x -> mkExitSuccess' (x + 1)) :: Exitcode' () Int
-- Exitcode (Identity (Right 4))
-- >>> mkExitFailure1' () >>= (\x -> mkExitSuccess' (x + 1)) :: Exitcode' () Int
-- Exitcode (Identity (Left ((),NotZero True (Positive 1))))
instance (Monad f) => Monad (Exitcode e f) where
  {-# INLINE (>>=) #-}
  Exitcode x >>= f =
    Exitcode (x >>= either (pure . Left) (runExitcode . f))

-- |
--
-- >>> import Control.Monad.Fix (mfix)
-- >>> runExitcode (mfix (const (mkExitSuccess' 42)) :: Exitcode' () Int)
-- Identity (Right 42)
-- >>> runExitcode (mfix (const (mkExitFailure1' ())) :: Exitcode' () Int)
-- Identity (Left ((),NotZero True (Positive 1)))
instance (MonadFix f) => MonadFix (Exitcode e f) where
  {-# INLINE mfix #-}
  mfix f = Exitcode (mfix (runExitcode . f . either (const (let a = a in a)) id))

-- |
--
-- >>> mkExitFailure1' () <!> mkExitSuccess' 42 :: Exitcode' () Int
-- Exitcode (Identity (Right 42))
-- >>> mkExitSuccess' 1 <!> mkExitSuccess' 2 :: Exitcode' () Int
-- Exitcode (Identity (Right 1))
instance (Monad f) => Alt (Exitcode e f) where
  {-# INLINE (<!>) #-}
  Exitcode a <!> Exitcode b =
    Exitcode (a >>= either (const b) (pure . Right))

-- |
--
-- >>> mkExitSuccess' "abc" <> mkExitSuccess' "def" :: Exitcode' () String
-- Exitcode (Identity (Right "abcdef"))
-- >>> mkExitSuccess' "abc" <> mkExitFailure1' () :: Exitcode' () String
-- Exitcode (Identity (Right "abc"))
-- >>> mkExitFailure1' () <> mkExitSuccess' "def" :: Exitcode' () String
-- Exitcode (Identity (Right "def"))
-- >>> (mkExitFailure1' () :: Exitcode' () String) <> mkExitFailure_1' ()
-- Exitcode (Identity (Left ((),NotZero False (Positive 1))))
instance (Semigroup a, Monad f) => Semigroup (Exitcode e f a) where
  {-# INLINE (<>) #-}
  Exitcode a <> Exitcode b =
    Exitcode
      ( a
          >>= either
            (\_ -> b >>= either (pure . Left) (pure . Right))
            (\a1 -> b >>= either (\_ -> pure (Right a1)) (\a2 -> pure (Right (a1 <> a2))))
      )

-- |
--
-- >>> mempty :: Exitcode' () String
-- Exitcode (Identity (Right ""))
instance (Monoid a, Monad f) => Monoid (Exitcode e f a) where
  {-# INLINE mempty #-}
  mempty = Exitcode (pure (Right mempty))

-- |
--
-- >>> duplicated (mkExitFailure1' ()) :: Exitcode' () (Exitcode' () ())
-- Exitcode (Identity (Right (Exitcode (Identity (Left ((),NotZero True (Positive 1)))))))
-- >>> duplicated (mkExitSuccess' "abc") :: Exitcode' () (Exitcode' () String)
-- Exitcode (Identity (Right (Exitcode (Identity (Right "abc")))))
instance (Extend f) => Extend (Exitcode e f) where
  {-# INLINE duplicated #-}
  duplicated (Exitcode x) =
    Exitcode (extended (Right . Exitcode) x)

-- |
--
-- >>> mkExitSuccess' 1 == mkExitSuccess' 1 :: Bool
-- True
-- >>> mkExitSuccess' 1 == (mkExitFailure1' () :: Exitcode' () Int) :: Bool
-- False
instance (Eq (f (Either (e, NotZero) a))) => Eq (Exitcode e f a) where
  {-# INLINE (==) #-}
  Exitcode a == Exitcode b = a == b

-- |
--
-- >>> liftEq (==) (mkExitSuccess' 1) (mkExitSuccess' 1 :: Exitcode' () Int)
-- True
-- >>> liftEq (==) (mkExitSuccess' 1) (mkExitSuccess' 2 :: Exitcode' () Int)
-- False
instance (Eq1 f, Eq e) => Eq1 (Exitcode e f) where
  {-# INLINE liftEq #-}
  liftEq f (Exitcode a) (Exitcode b) =
    liftEq (liftEq f) a b

-- |
--
-- >>> compare (mkExitSuccess' 1 :: Exitcode' () Int) (mkExitSuccess' 2)
-- LT
-- >>> compare (mkExitSuccess' 1 :: Exitcode' () Int) (mkExitFailure1' ())
-- GT
instance (Ord (f (Either (e, NotZero) a))) => Ord (Exitcode e f a) where
  {-# INLINE compare #-}
  Exitcode a `compare` Exitcode b = compare a b

-- |
--
-- >>> liftCompare compare (mkExitSuccess' 1) (mkExitSuccess' 2 :: Exitcode' () Int)
-- LT
instance (Ord1 f, Ord e) => Ord1 (Exitcode e f) where
  {-# INLINE liftCompare #-}
  liftCompare f (Exitcode a) (Exitcode b) =
    liftCompare (liftCompare f) a b

-- |
--
-- >>> show (mkExitSuccess' "abc" :: Exitcode' () String)
-- "Exitcode (Identity (Right \"abc\"))"
-- >>> show (mkExitFailure1' 'x' :: Exitcode' Char ())
-- "Exitcode (Identity (Left ('x',NotZero True (Positive 1))))"
instance (Show (f (Either (e, NotZero) a))) => Show (Exitcode e f a) where
  {-# INLINE showsPrec #-}
  showsPrec d (Exitcode m) =
    showParen (d > 10) $
      showString "Exitcode " . showsPrec 11 m

-- |
--
-- >>> liftShowsPrec showsPrec showList 0 (mkExitSuccess' 42 :: Exitcode' () Int) ""
-- "Exitcode (Identity (Right 42))"
instance (Show1 f, Show e) => Show1 (Exitcode e f) where
  {-# INLINE liftShowsPrec #-}
  liftShowsPrec sp sl d (Exitcode fa) =
    showParen (d > 10) $
      showString "Exitcode "
        . liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl) 11 fa

instance (NFData1 f, NFData e, NFData a) => NFData (Exitcode e f a) where
  {-# INLINE rnf #-}
  rnf = liftRnf rnf

instance (NFData1 f, NFData e) => NFData1 (Exitcode e f) where
  {-# INLINE liftRnf #-}
  liftRnf r (Exitcode x) = liftRnf rnfEither x
    where
      rnfEither (Right a) = r a
      rnfEither (Left (e, n)) = rnf e `seq` rnf (review _NotZero n :: Int)

-- |
--
-- >>> import Control.Monad.IO.Class (liftIO)
-- >>> runExitcode (liftIO (pure 42) :: Exitcode () IO Int)
-- Right 42
instance (MonadIO f) => MonadIO (Exitcode e f) where
  {-# INLINE liftIO #-}
  liftIO io = Exitcode (Right <$> liftIO io)

-- |
--
-- >>> import Control.Monad.Reader (runReader)
-- >>> runReader (runExitcode (ask :: Exitcode () (Control.Monad.Reader.Reader Int) Int)) 42
-- Right 42
-- >>> runReader (runExitcode (local (+1) ask :: Exitcode () (Control.Monad.Reader.Reader Int) Int)) 42
-- Right 43
instance (MonadReader r f) => MonadReader r (Exitcode e f) where
  {-# INLINE ask #-}
  ask = Exitcode (asks Right)
  {-# INLINE local #-}
  local f (Exitcode m) = Exitcode (local f m)

-- |
--
-- >>> import Control.Monad.Writer (runWriter)
-- >>> runWriter (runExitcode (tell "hello" :: Exitcode () (Control.Monad.Writer.Lazy.Writer String) ()))
-- (Right (),"hello")
instance (MonadWriter w f) => MonadWriter w (Exitcode e f) where
  {-# INLINE writer #-}
  writer t = Exitcode . fmap pure $ writer t
  {-# INLINE listen #-}
  listen (Exitcode m) = Exitcode ((\(e, w) -> (,w) <$> e) <$> listen m)
  {-# INLINE tell #-}
  tell = Exitcode . fmap Right . tell
  {-# INLINE pass #-}
  pass e =
    do
      ((a, f), w) <- listen e
      tell (f w)
      pure a

-- |
--
-- >>> import Control.Monad.State (runState)
-- >>> runState (runExitcode (get :: Exitcode () (Control.Monad.State.Lazy.State Int) Int)) 7
-- (Right 7,7)
-- >>> runState (runExitcode (put 99 :: Exitcode () (Control.Monad.State.Lazy.State Int) ())) 7
-- (Right (),99)
instance (MonadState s f) => MonadState s (Exitcode e f) where
  {-# INLINE get #-}
  get = Exitcode (fmap Right get)
  {-# INLINE put #-}
  put = Exitcode . fmap Right . put

-- | @throwError@ and @catchError@ operate on the error channel of the base
-- functor @f@, not on the exit code failure.
--
-- >>> import Control.Monad.Except (runExcept)
-- >>> runExcept (runExitcode (throwError "oops" :: Exitcode () (Control.Monad.Except.Except String) Int))
-- Left "oops"
instance (MonadError e f) => MonadError e (Exitcode e' f) where
  {-# INLINE throwError #-}
  throwError = Exitcode . fmap Right . throwError
  {-# INLINE catchError #-}
  catchError (Exitcode f) h = Exitcode (catchError f (runExitcode . h))

instance (MonadRWS r w s f) => MonadRWS r w s (Exitcode e f)

-- |
--
-- >>> import Control.Monad.Cont (runCont)
-- >>> runCont (runExitcode (callCC (\k -> k 42) :: Exitcode () (Control.Monad.Cont.Cont (Either ((), NotZero) Int)) Int)) id
-- Right 42
instance (MonadCont f) => MonadCont (Exitcode e f) where
  callCC f =
    Exitcode (callCC (\c -> runExitcode (f (Exitcode . c . Right))))

-- |
--
-- >>> import Control.Monad.Trans.Class (lift)
-- >>> runExitcode (lift (Identity 42) :: Exitcode' () Int)
-- Identity (Right 42)
instance MonadTrans (Exitcode e) where
  {-# INLINE lift #-}
  lift = Exitcode . fmap Right

-- |
--
-- >>> import Data.Functor.Bind.Trans (liftB)
-- >>> runExitcode (liftB (Identity 42) :: Exitcode' () Int)
-- Identity (Right 42)
instance BindTrans (Exitcode e) where
  {-# INLINE liftB #-}
  liftB = Exitcode . fmap Right

-- * ExitcodeBifunctor

-- | @ExitcodeBifunctor@ reorders the type parameters of @Exitcode@ so that
-- @e@ and @a@ are last, enabling @Bifunctor@, @Bifoldable@, and @Bitraversable@
-- instances.
newtype ExitcodeBifunctor f e a = ExitcodeBifunctor (Exitcode e f a)
  deriving stock (Generic)

-- | @ExitcodeBifunctor@ specialised to @Identity@.
type ExitcodeBifunctor' e a = ExitcodeBifunctor Identity e a

-- * ExitcodeBifunctor Instances

-- |
--
-- >>> bimap (+1) (+10) (ExitcodeBifunctor (mkExitFailure1' 5) :: ExitcodeBifunctor' Int Int)
-- ExitcodeBifunctor (Exitcode (Identity (Left (6,NotZero True (Positive 1)))))
-- >>> bimap (+1) (+10) (ExitcodeBifunctor (mkExitSuccess' 5) :: ExitcodeBifunctor' Int Int)
-- ExitcodeBifunctor (Exitcode (Identity (Right 15)))
instance (Functor f) => Bifunctor (ExitcodeBifunctor f) where
  {-# INLINE bimap #-}
  bimap f g (ExitcodeBifunctor x) = ExitcodeBifunctor (bimapExitcode f g x)

-- |
--
-- >>> bifoldMap show show (ExitcodeBifunctor (mkExitFailure1' 'x') :: ExitcodeBifunctor' Char Int)
-- "'x'"
-- >>> bifoldMap show show (ExitcodeBifunctor (mkExitSuccess' 42) :: ExitcodeBifunctor' Char Int)
-- "42"
instance (Foldable f) => Bifoldable (ExitcodeBifunctor f) where
  {-# INLINE bifoldMap #-}
  bifoldMap f g (ExitcodeBifunctor (Exitcode x)) =
    foldMap (either (\(e, _) -> f e) g) x

-- |
--
-- >>> bitraverse (Just . (+1)) (Just . (+10)) (ExitcodeBifunctor (mkExitFailure1' 5) :: ExitcodeBifunctor' Int Int)
-- Just (ExitcodeBifunctor (Exitcode (Identity (Left (6,NotZero True (Positive 1))))))
-- >>> bitraverse (Just . (+1)) (Just . (+10)) (ExitcodeBifunctor (mkExitSuccess' 5) :: ExitcodeBifunctor' Int Int)
-- Just (ExitcodeBifunctor (Exitcode (Identity (Right 15))))
instance (Traversable f) => Bitraversable (ExitcodeBifunctor f) where
  {-# INLINE bitraverse #-}
  bitraverse f g (ExitcodeBifunctor (Exitcode x)) =
    ExitcodeBifunctor . Exitcode <$> traverse (either (\(e, n) -> fmap (\e' -> Left (e', n)) (f e)) (fmap Right . g)) x

-- |
--
-- >>> fmap (+1) (ExitcodeBifunctor (mkExitSuccess' 3) :: ExitcodeBifunctor' () Int)
-- ExitcodeBifunctor (Exitcode (Identity (Right 4)))
instance (Functor f) => Functor (ExitcodeBifunctor f e) where
  {-# INLINE fmap #-}
  fmap f (ExitcodeBifunctor x) = ExitcodeBifunctor (fmap f x)

-- |
--
-- >>> foldMap show (ExitcodeBifunctor (mkExitSuccess' 42) :: ExitcodeBifunctor' () Int)
-- "42"
instance (Foldable f) => Foldable (ExitcodeBifunctor f e) where
  {-# INLINE foldMap #-}
  foldMap f (ExitcodeBifunctor x) = foldMap f x

-- |
--
-- >>> traverse Just (ExitcodeBifunctor (mkExitSuccess' 42) :: ExitcodeBifunctor' () Int)
-- Just (ExitcodeBifunctor (Exitcode (Identity (Right 42))))
instance (Traversable f) => Traversable (ExitcodeBifunctor f e) where
  {-# INLINE traverse #-}
  traverse f (ExitcodeBifunctor x) = ExitcodeBifunctor <$> traverse f x

instance (FunctorWithIndex i f) => FunctorWithIndex i (ExitcodeBifunctor f e) where
  {-# INLINE imap #-}
  imap f (ExitcodeBifunctor x) = ExitcodeBifunctor (imap f x)

instance (FoldableWithIndex i f) => FoldableWithIndex i (ExitcodeBifunctor f e) where
  {-# INLINE ifoldMap #-}
  ifoldMap f (ExitcodeBifunctor x) = ifoldMap f x

instance (TraversableWithIndex i f) => TraversableWithIndex i (ExitcodeBifunctor f e) where
  {-# INLINE itraverse #-}
  itraverse f (ExitcodeBifunctor x) = ExitcodeBifunctor <$> itraverse f x

instance (Monad f) => Apply (ExitcodeBifunctor f e) where
  {-# INLINE (<.>) #-}
  ExitcodeBifunctor f <.> ExitcodeBifunctor a = ExitcodeBifunctor (f <.> a)

-- |
--
-- >>> pure 42 :: ExitcodeBifunctor' () Int
-- ExitcodeBifunctor (Exitcode (Identity (Right 42)))
instance (Monad f) => Applicative (ExitcodeBifunctor f e) where
  {-# INLINE pure #-}
  pure = ExitcodeBifunctor . pure
  {-# INLINE (<*>) #-}
  ExitcodeBifunctor f <*> ExitcodeBifunctor a = ExitcodeBifunctor (f <*> a)

instance (Monad f) => Bind (ExitcodeBifunctor f e) where
  {-# INLINE (>>-) #-}
  (>>-) = (>>=)

instance (Monad f) => Monad (ExitcodeBifunctor f e) where
  {-# INLINE (>>=) #-}
  ExitcodeBifunctor x >>= f = ExitcodeBifunctor (x >>= (\a -> let ExitcodeBifunctor y = f a in y))

instance (MonadFix f) => MonadFix (ExitcodeBifunctor f e) where
  {-# INLINE mfix #-}
  mfix f = ExitcodeBifunctor (mfix (\a -> let ExitcodeBifunctor y = f a in y))

-- |
--
-- >>> (ExitcodeBifunctor (mkExitFailure1' ()) :: ExitcodeBifunctor' () Int) <!> ExitcodeBifunctor (mkExitSuccess' 42)
-- ExitcodeBifunctor (Exitcode (Identity (Right 42)))
instance (Monad f) => Alt (ExitcodeBifunctor f e) where
  {-# INLINE (<!>) #-}
  ExitcodeBifunctor a <!> ExitcodeBifunctor b = ExitcodeBifunctor (a <!> b)

instance (Semigroup a, Monad f) => Semigroup (ExitcodeBifunctor f e a) where
  {-# INLINE (<>) #-}
  ExitcodeBifunctor a <> ExitcodeBifunctor b = ExitcodeBifunctor (a <> b)

instance (Monoid a, Monad f) => Monoid (ExitcodeBifunctor f e a) where
  {-# INLINE mempty #-}
  mempty = ExitcodeBifunctor mempty

instance (Extend f) => Extend (ExitcodeBifunctor f e) where
  {-# INLINE duplicated #-}
  duplicated (ExitcodeBifunctor x) = ExitcodeBifunctor (fmap ExitcodeBifunctor (duplicated x))

instance (Eq (f (Either (e, NotZero) a))) => Eq (ExitcodeBifunctor f e a) where
  {-# INLINE (==) #-}
  ExitcodeBifunctor (Exitcode a) == ExitcodeBifunctor (Exitcode b) = a == b

instance (Eq1 f, Eq e) => Eq1 (ExitcodeBifunctor f e) where
  {-# INLINE liftEq #-}
  liftEq f (ExitcodeBifunctor (Exitcode a)) (ExitcodeBifunctor (Exitcode b)) =
    liftEq (liftEq f) a b

instance (Ord (f (Either (e, NotZero) a))) => Ord (ExitcodeBifunctor f e a) where
  {-# INLINE compare #-}
  ExitcodeBifunctor (Exitcode a) `compare` ExitcodeBifunctor (Exitcode b) = compare a b

instance (Ord1 f, Ord e) => Ord1 (ExitcodeBifunctor f e) where
  {-# INLINE liftCompare #-}
  liftCompare f (ExitcodeBifunctor (Exitcode a)) (ExitcodeBifunctor (Exitcode b)) =
    liftCompare (liftCompare f) a b

-- |
--
-- >>> show (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)
-- "ExitcodeBifunctor (Exitcode (Identity (Right \"abc\")))"
-- >>> show (ExitcodeBifunctor (mkExitFailure1' 'x') :: ExitcodeBifunctor' Char ())
-- "ExitcodeBifunctor (Exitcode (Identity (Left ('x',NotZero True (Positive 1)))))"
instance (Show (f (Either (e, NotZero) a))) => Show (ExitcodeBifunctor f e a) where
  {-# INLINE showsPrec #-}
  showsPrec d (ExitcodeBifunctor (Exitcode m)) =
    showParen (d > 10) $
      showString "ExitcodeBifunctor (Exitcode " . showsPrec 11 m . showString ")"

instance (Show1 f, Show e) => Show1 (ExitcodeBifunctor f e) where
  {-# INLINE liftShowsPrec #-}
  liftShowsPrec sp sl d (ExitcodeBifunctor (Exitcode fa)) =
    showParen (d > 10) $
      showString "ExitcodeBifunctor (Exitcode "
        . liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl) 11 fa
        . showString ")"

instance (NFData1 f, NFData e, NFData a) => NFData (ExitcodeBifunctor f e a) where
  {-# INLINE rnf #-}
  rnf = liftRnf rnf

instance (NFData1 f, NFData e) => NFData1 (ExitcodeBifunctor f e) where
  {-# INLINE liftRnf #-}
  liftRnf r (ExitcodeBifunctor (Exitcode x)) = liftRnf rnfEither x
    where
      rnfEither (Right a) = r a
      rnfEither (Left (e, n)) = rnf e `seq` rnf (review _NotZero n :: Int)

instance (MonadIO f) => MonadIO (ExitcodeBifunctor f e) where
  {-# INLINE liftIO #-}
  liftIO = ExitcodeBifunctor . liftIO

instance (MonadReader r f) => MonadReader r (ExitcodeBifunctor f e) where
  {-# INLINE ask #-}
  ask = ExitcodeBifunctor ask
  {-# INLINE local #-}
  local f (ExitcodeBifunctor x) = ExitcodeBifunctor (local f x)

instance (MonadWriter w f) => MonadWriter w (ExitcodeBifunctor f e) where
  {-# INLINE writer #-}
  writer t = ExitcodeBifunctor (writer t)
  {-# INLINE listen #-}
  listen (ExitcodeBifunctor x) = ExitcodeBifunctor (listen x)
  {-# INLINE tell #-}
  tell = ExitcodeBifunctor . tell
  {-# INLINE pass #-}
  pass (ExitcodeBifunctor x) = ExitcodeBifunctor (pass x)

instance (MonadState s f) => MonadState s (ExitcodeBifunctor f e) where
  {-# INLINE get #-}
  get = ExitcodeBifunctor get
  {-# INLINE put #-}
  put = ExitcodeBifunctor . put

instance (MonadError e f) => MonadError e (ExitcodeBifunctor f e') where
  {-# INLINE throwError #-}
  throwError = ExitcodeBifunctor . throwError
  {-# INLINE catchError #-}
  catchError (ExitcodeBifunctor x) h = ExitcodeBifunctor (catchError x (\e -> let ExitcodeBifunctor y = h e in y))

instance (MonadRWS r w s f) => MonadRWS r w s (ExitcodeBifunctor f e)

instance (MonadCont f) => MonadCont (ExitcodeBifunctor f e) where
  callCC f = ExitcodeBifunctor (callCC (\c -> let ExitcodeBifunctor x = f (ExitcodeBifunctor . c) in x))