Util.hs

-----------------------------------------------------------------------------
--
-- Module      :  Control.Monad.Except.Util
-- Copyright   :  (c) 2016 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <consult@brianwbush.info>
-- Stability   :  Stable
-- Portability :  Portable
--
-- | Utilities related to the <https://hackage.haskell.org/package/mtl mtl> package.
--
-----------------------------------------------------------------------------


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Safe             #-}


module Control.Monad.Except.Util (
-- * Assertions
  assert
, deny
-- * Input/Output
, tryIO
, guardIO
, eitherError
, runToIO
) where


import Control.Exception (IOException, throw, try)
import Control.Monad (unless, when)
import Control.Monad.Except (ExceptT, MonadError, MonadIO, liftIO, runExceptT, throwError)
import Data.String (IsString(..))
import System.IO.Error (tryIOError)


-- | Attempt an IO action.
tryIO :: (IsString e, MonadError e m, MonadIO m) => IO a -> m a
tryIO = (>>= either (\e -> throwError . fromString $ show (e :: IOException)) return) . liftIO . try


-- | Catch 'Control.Exception.IOException' and throw it into 'MonadError String'.  Derived from <http://chromaticleaves.com/posts/guard-io-with-errort.html>.
guardIO :: (MonadIO m, MonadError String m) => IO a -> m a
guardIO =
  (either (throwError . show) return =<<)
    . liftIO
    . tryIOError


-- | Throw 'Data.Either.Left' into 'Control.Exception.IOException'.
eitherError :: (a -> b) -> Either String a -> IO b
eitherError f = either (throw . userError) (return . f)


-- | Run 'Control.Monad.Except.ExceptT' to 'System.IO'.
runToIO :: ExceptT String IO a -> IO a
runToIO = (eitherError id =<<) . runExceptT


-- | Make an assertion.
assert :: (IsString e, MonadError e m) => e -> Bool -> m ()
assert = flip unless . throwError


-- | Make a denial.
deny :: (IsString e, MonadError e m) => e -> Bool -> m ()
deny = flip when . throwError