MiscHelper.hs

module Data.HttpSpec.MiscHelper
    (errorToMaybe, errorToDefault, maybeToM, eitherToM, safeMain)
where

----------------------------------------
-- STDLIB
----------------------------------------
import Prelude hiding (catch)

import Control.Monad (liftM)
import Control.Monad.Error (MonadError, catchError)
import Control.Exception (catch,SomeException)

import System.IO (hPutStrLn,stderr)
import System.Exit (exitFailure)
import System.Environment (getProgName)


maybeToM :: Monad m => String -> Maybe a -> m a
maybeToM _msg (Just x) = return x
maybeToM msg Nothing = fail msg

errorToMaybe :: MonadError e m => m a -> m (Maybe a)
errorToMaybe ma = catchError (liftM Just ma) (\_ -> return Nothing)

errorToDefault :: MonadError e m => a -> m a -> m a
errorToDefault a ma = catchError ma (\_ -> return a)

eitherToM :: (Show a, Monad m) => Either a b -> m b
eitherToM (Left err) = fail (show err)
eitherToM (Right ok) = return ok

safeMain :: IO () -> IO ()
safeMain io = io `catch` handle
    where
      handle :: SomeException -> IO ()
      handle e =
          do s <- getProgName
             hPutStrLn stderr ("Caught exception while running " ++ s ++ ": " ++ show e)
             exitFailure