{-# LANGUAGE CPP, ScopedTypeVariables #-}

module Propellor.Exception where

import Propellor.Types
import Propellor.Types.Exception
import Propellor.Message
import Utility.Exception

import Control.Exception (AsyncException)
#if MIN_VERSION_base(4,7,0)
import Control.Exception (SomeAsyncException)
#endif
import Control.Monad.Catch
import Control.Monad.IO.Class (MonadIO)
import Prelude

-- | Catches all exceptions (except for `StopPropellorException` and
-- `AsyncException` and `SomeAsyncException`) and returns FailedChange.
catchPropellor :: (MonadIO m, MonadCatch m) => m Result -> m Result
catchPropellor :: m Result -> m Result
catchPropellor m Result
a = (SomeException -> m Result)
-> (Result -> m Result) -> Either SomeException Result -> m Result
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> m Result
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m Result
err Result -> m Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException Result -> m Result)
-> m (Either SomeException Result) -> m Result
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Result -> m (Either SomeException Result)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryPropellor m Result
a
  where
	err :: a -> m Result
err a
e =  String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
warningMessage (a -> String
forall a. Show a => a -> String
show a
e) m () -> m Result -> m Result
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Result -> m Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange

catchPropellor' :: MonadCatch m => m a -> (SomeException -> m a) -> m a
catchPropellor' :: m a -> (SomeException -> m a) -> m a
catchPropellor' m a
a SomeException -> m a
onerr = m a
a m a -> [Handler m a] -> m a
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadCatch m) =>
m a -> f (Handler m a) -> m a
`catches`
	[ (AsyncException -> m a) -> Handler m a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (\ (AsyncException
e :: AsyncException) -> AsyncException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM AsyncException
e)
#if MIN_VERSION_base(4,7,0)
	, (SomeAsyncException -> m a) -> Handler m a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (\ (SomeAsyncException
e :: SomeAsyncException) -> SomeAsyncException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeAsyncException
e)
#endif
	, (StopPropellorException -> m a) -> Handler m a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (\ (StopPropellorException
e :: StopPropellorException) -> StopPropellorException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM StopPropellorException
e)
	, (SomeException -> m a) -> Handler m a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (\ (SomeException
e :: SomeException) -> SomeException -> m a
onerr SomeException
e)
	]

-- | Catches all exceptions (except for `StopPropellorException` and
-- `AsyncException`).
tryPropellor :: MonadCatch m => m a -> m (Either SomeException a)
tryPropellor :: m a -> m (Either SomeException a)
tryPropellor m a
a = (Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a -> m (Either SomeException a))
-> (a -> Either SomeException a) -> a -> m (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either SomeException a
forall a b. b -> Either a b
Right (a -> m (Either SomeException a))
-> m a -> m (Either SomeException a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m a
a) m (Either SomeException a)
-> (SomeException -> m (Either SomeException a))
-> m (Either SomeException a)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
`catchPropellor'` (Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a -> m (Either SomeException a))
-> (SomeException -> Either SomeException a)
-> SomeException
-> m (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Either SomeException a
forall a b. a -> Either a b
Left)