-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- Extra glue functions to work with "MonadUnliftIO" exception types.  We need
-- this because the @retry@ package uses the generalized exception handler type
-- from 'Control.Monad.Catch.Handler'. But the 'UnliftIO.Exceptions' module has
-- its own definition of exactly the same type.

module UnliftIO.Compat
     ( -- * Handler conversion
       coerceHandler
     , coerceHandlers
     , mkRetryHandler

       -- * Missing combinators
     , handleIf

       -- * Re-export unsafe things
     , AsyncCancelled (..)
     ) where

import Prelude

import Control.Concurrent.Async
    ( AsyncCancelled (..) )
import Control.Exception.Base
    ( Exception )
import Control.Monad.IO.Unlift
    ( MonadUnliftIO (..) )

import qualified Control.Monad.Catch as Exceptions
import qualified UnliftIO.Exception as UnliftIO

-- | Convert the generalized handler from 'UnliftIO.Exception' type to 'Control.Monad.Catch' type
coerceHandler :: UnliftIO.Handler IO b -> Exceptions.Handler IO b
coerceHandler :: Handler IO b -> Handler IO b
coerceHandler (UnliftIO.Handler e -> IO b
h) = (e -> IO b) -> Handler IO b
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Exceptions.Handler e -> IO b
h

-- | Convert a list of handler factories from the 'UnliftIO.Exception' type to
-- 'Control.Monad.Catch' type. Such handlers are used in
-- 'Control.Retry.Recovering' for example.
coerceHandlers
    :: [a -> UnliftIO.Handler IO b]
    -> [a -> Exceptions.Handler IO b]
coerceHandlers :: [a -> Handler IO b] -> [a -> Handler IO b]
coerceHandlers = ((a -> Handler IO b) -> a -> Handler IO b)
-> [a -> Handler IO b] -> [a -> Handler IO b]
forall a b. (a -> b) -> [a] -> [b]
map (Handler IO b -> Handler IO b
forall b. Handler IO b -> Handler IO b
coerceHandler (Handler IO b -> Handler IO b)
-> (a -> Handler IO b) -> a -> Handler IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

-- | Shortcut for creating a single 'Control.Retry' handler, which doesn't use
-- the 'Control.Retry.RetryStatus' info.
mkRetryHandler
    :: Exception e
    => (e -> m Bool)
    -> [a -> Exceptions.Handler m Bool]
mkRetryHandler :: (e -> m Bool) -> [a -> Handler m Bool]
mkRetryHandler e -> m Bool
shouldRetry = [Handler m Bool -> a -> Handler m Bool
forall a b. a -> b -> a
const (Handler m Bool -> a -> Handler m Bool)
-> Handler m Bool -> a -> Handler m Bool
forall a b. (a -> b) -> a -> b
$ (e -> m Bool) -> Handler m Bool
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Exceptions.Handler e -> m Bool
shouldRetry]

-- | A 'MonadUnliftIO' version of 'Control.Monad.Catch.handleIf'.
handleIf
    :: (MonadUnliftIO m, Exception e)
    => (e -> Bool)
    -> (e -> m a)
    -> m a
    -> m a
handleIf :: (e -> Bool) -> (e -> m a) -> m a -> m a
handleIf e -> Bool
f e -> m a
h = (e -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
UnliftIO.handle
    (\e
e -> if e -> Bool
f e
e then e -> m a
h e
e else e -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
UnliftIO.throwIO e
e)