-- | Functions to exit the program anywhere in MonadThrow monads.
module System.Exit.MonadThrow
  ( exitWith
  , exitFailure
  , exitSuccess
  -- * Re-export from the original @System.Exit@ module.
  , ExitCode (ExitSuccess, ExitFailure)
  ) where


import           Control.Monad.Catch (MonadThrow, throwM)
import           GHC.IO.Exception    (IOErrorType (InvalidArgument),
                                      IOException (IOError))
import           System.Exit         (ExitCode (ExitFailure, ExitSuccess))


-- | A version of 'System.Exit.exitWith' available in any 'MonadThrow' context.
--   See 'System.Exit.exitWith' for details
exitWith :: MonadThrow m => ExitCode -> m a
exitWith :: ExitCode -> m a
exitWith ExitCode
ExitSuccess = ExitCode -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ExitCode
ExitSuccess
exitWith code :: ExitCode
code@(ExitFailure Int
n)
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = ExitCode -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ExitCode
code
  | Bool
otherwise = IOException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"exitWith" String
"ExitFailure 0" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)


-- | A version of 'System.Exit.exitFailure' available in any 'MonadThrow' context.
--   See 'System.Exit.exitFailure' for details
exitFailure :: MonadThrow m => m a
exitFailure :: m a
exitFailure = ExitCode -> m a
forall (m :: * -> *) a. MonadThrow m => ExitCode -> m a
exitWith (Int -> ExitCode
ExitFailure Int
1)


-- | A version of 'System.Exit.exitSuccess' available in any 'MonadThrow' context.
--   See 'System.Exit.exitSuccess' for details
exitSuccess :: MonadThrow m => m a
exitSuccess :: m a
exitSuccess = ExitCode -> m a
forall (m :: * -> *) a. MonadThrow m => ExitCode -> m a
exitWith ExitCode
ExitSuccess