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 =
  (UserException -> IO a) -> IO a -> IO a
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 Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"hci: \ESC[31;1merror:\ESC[m " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
          else Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"hci: error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
        IO a
forall a. IO a
exitFailure
    )

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