module Control.Monad.Trans.Except.Exit (
    orDie
  , orDieWithCode
  ) where

import           Data.Text (Text)
import qualified Data.Text as T

import           System.Exit (ExitCode(..), exitWith)
import           System.IO (stderr, hPutStrLn)

import           Control.Monad.Trans.Except (ExceptT, runExceptT)

-- | orDieWithCode with an exit code of 1 in case of an error
--
orDie :: (e -> Text) -> ExceptT e IO a -> IO a
orDie :: (e -> Text) -> ExceptT e IO a -> IO a
orDie = Int -> (e -> Text) -> ExceptT e IO a -> IO a
forall e a. Int -> (e -> Text) -> ExceptT e IO a -> IO a
orDieWithCode Int
1

-- | An idiom for failing hard on EitherT errors.
--
-- *This really dies*. There is no other way to say it.
--
-- The reason it lives with command line parser tooling, is that it is
-- the only valid place to actually exit like this. Be appropriately
-- wary.
--
orDieWithCode :: Int -> (e -> Text) -> ExceptT e IO a -> IO a
orDieWithCode :: Int -> (e -> Text) -> ExceptT e IO a -> IO a
orDieWithCode Int
code e -> Text
render ExceptT e IO a
e =
  ExceptT e IO a -> IO (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e IO a
e IO (Either e a) -> (Either e a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (e -> IO a) -> (a -> IO a) -> Either e a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e
err -> (Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> (e -> String) -> e -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (e -> Text) -> e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Text
render) e
err IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
code)) a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure