cabal-cache-1.0.0.0: src/HaskellWorks/Ci/Assist/IO/Error.hs

{-# LANGUAGE FlexibleContexts #-}

module HaskellWorks.Ci.Assist.IO.Error
  ( exceptFatal
  , exceptWarn
  , maybeToExcept
  , maybeToExceptM
  ) where

import Control.Monad.Except
import Control.Monad.IO.Class

import qualified Data.Text                         as T
import qualified HaskellWorks.Ci.Assist.IO.Console as CIO
import qualified System.Exit                       as IO
import qualified System.IO                         as IO

exceptFatal :: MonadIO m => ExceptT String m a -> ExceptT String m a
exceptFatal f = catchError f handler
  where handler e = do
          liftIO . CIO.hPutStrLn IO.stderr . T.pack $ "Fatal Error: " <> e
          liftIO IO.exitFailure
          throwError e

exceptWarn :: MonadIO m => ExceptT String m a -> ExceptT String m a
exceptWarn f = catchError f handler
  where handler e = do
          liftIO . CIO.hPutStrLn IO.stderr . T.pack $ "Warning: " <> e
          throwError e

maybeToExcept :: Monad m => String -> Maybe a -> ExceptT String m a
maybeToExcept message = maybe (throwError message) pure

maybeToExceptM :: Monad m => String -> m (Maybe a) -> ExceptT String m a
maybeToExceptM message = ExceptT . fmap (maybe (Left message) Right)