{-# LANGUAGE FlexibleContexts #-}

module HsDev.Error (
	hsdevError, hsdevOtherError, hsdevLift, hsdevLiftWith, hsdevCatch, hsdevLiftIO, hsdevLiftIOWith, hsdevIgnore,
	hsdevHandle,

	module HsDev.Types
	) where

import Prelude

import Control.Exception (IOException)
import Control.Monad.Catch
import Control.Monad.Except

import HsDev.Types

-- | Throw `HsDevError`
hsdevError :: MonadThrow m => HsDevError -> m a
hsdevError :: HsDevError -> m a
hsdevError = HsDevError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

-- | Throw as `OtherError`
hsdevOtherError :: (Exception e, MonadThrow m) => e -> m a
hsdevOtherError :: e -> m a
hsdevOtherError = HsDevError -> m a
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> m a) -> (e -> HsDevError) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsDevError
OtherError (String -> HsDevError) -> (e -> String) -> e -> HsDevError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
forall e. Exception e => e -> String
displayException

-- | Throw as `OtherError`
hsdevLift :: MonadThrow m => ExceptT String m a -> m a
hsdevLift :: ExceptT String m a -> m a
hsdevLift = (String -> HsDevError) -> ExceptT String m a -> m a
forall (m :: * -> *) a.
MonadThrow m =>
(String -> HsDevError) -> ExceptT String m a -> m a
hsdevLiftWith String -> HsDevError
OtherError

-- | Throw as some `HsDevError`
hsdevLiftWith :: MonadThrow m => (String -> HsDevError) -> ExceptT String m a -> m a
hsdevLiftWith :: (String -> HsDevError) -> ExceptT String m a -> m a
hsdevLiftWith String -> HsDevError
ctor ExceptT String m a
act = ExceptT String m a -> m (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT String m a
act m (Either String a) -> (Either String a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (HsDevError -> m a
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> m a) -> (String -> HsDevError) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsDevError
ctor) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

hsdevCatch :: MonadCatch m => m a -> m (Either HsDevError a)
hsdevCatch :: m a -> m (Either HsDevError a)
hsdevCatch = m a -> m (Either HsDevError a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try

-- | Rethrow IO exceptions as `HsDevError`
hsdevLiftIO :: MonadCatch m => m a -> m a
hsdevLiftIO :: m a -> m a
hsdevLiftIO = (String -> HsDevError) -> m a -> m a
forall (m :: * -> *) a.
MonadCatch m =>
(String -> HsDevError) -> m a -> m a
hsdevLiftIOWith String -> HsDevError
IOFailed

-- | Rethrow IO exceptions
hsdevLiftIOWith :: MonadCatch m => (String -> HsDevError) -> m a -> m a
hsdevLiftIOWith :: (String -> HsDevError) -> m a -> m a
hsdevLiftIOWith String -> HsDevError
ctor m a
act = m a -> (IOException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
act IOException -> m a
forall (m :: * -> *) a. MonadThrow m => IOException -> m a
onErr where
	onErr :: MonadThrow m => IOException -> m a
	onErr :: IOException -> m a
onErr = HsDevError -> m a
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> m a)
-> (IOException -> HsDevError) -> IOException -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsDevError
ctor (String -> HsDevError)
-> (IOException -> String) -> IOException -> HsDevError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall e. Exception e => e -> String
displayException

-- | Ignore hsdev exception
hsdevIgnore :: MonadCatch m => a -> m a -> m a
hsdevIgnore :: a -> m a -> m a
hsdevIgnore a
v m a
act = m a -> m (Either HsDevError a)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either HsDevError a)
hsdevCatch m a
act m (Either HsDevError a) -> (Either HsDevError a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (HsDevError -> m a) -> (a -> m a) -> Either HsDevError a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m a -> HsDevError -> m a
forall a b. a -> b -> a
const (m a -> HsDevError -> m a) -> m a -> HsDevError -> m a
forall a b. (a -> b) -> a -> b
$ a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Handle hsdev exception
hsdevHandle :: MonadCatch m => (HsDevError -> m a) -> m a -> m a
hsdevHandle :: (HsDevError -> m a) -> m a -> m a
hsdevHandle HsDevError -> m a
h m a
act = m a -> m (Either HsDevError a)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either HsDevError a)
hsdevCatch m a
act m (Either HsDevError a) -> (Either HsDevError a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (HsDevError -> m a) -> (a -> m a) -> Either HsDevError a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsDevError -> m a
h a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return