module Hercules.CLI.Exception where

import qualified Control.Exception.Safe
import Hercules.UserException (UserException (UserException))
import Protolude hiding (handle, show)
import System.IO (hIsTerminalDevice)

handleUserException :: IO a -> IO a
handleUserException :: forall a. IO a -> IO a
handleUserException =
  forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
Control.Exception.Safe.handle
    ( \(UserException Text
msg) -> do
        Bool
stderrIsTerminal <- Handle -> IO Bool
hIsTerminalDevice Handle
stderr
        if Bool
stderrIsTerminal
          then forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText forall a b. (a -> b) -> a -> b
$ Text
"hci: \ESC[31;1merror:\ESC[m " forall a. Semigroup a => a -> a -> a
<> Text
msg
          else forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText forall a b. (a -> b) -> a -> b
$ Text
"hci: error: " forall a. Semigroup a => a -> a -> a
<> Text
msg
        forall a. IO a
exitFailure
    )

exitMsg :: MonadIO m => Text -> m a
exitMsg :: forall (m :: * -> *) a. MonadIO m => Text -> m a
exitMsg = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UserException
UserException