{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Functions from "Control.Exception.Lens", but using 'MonadUnliftIO', not
-- 'MonadCatch'
module UnliftIO.Exception.Lens
  ( catching
  , catching_
  , handling
  , handling_
  , trying
  , trying_
  ) where

import Prelude

import Control.Monad.IO.Unlift (MonadUnliftIO)
import Control.Monad (liftM)
import Data.Monoid (First)
import UnliftIO.Exception (SomeException, catchJust, tryJust)
import Control.Applicative (Const(..))
import Data.Monoid (First(..))

#if __GLASGOW_HASKELL__ >= 708
import Data.Coerce
#else
import Unsafe.Coerce
#endif

-- | 'Control.Exception.Lens.catching' using 'MonadUnliftIO'
--
-- @since 0.2.25.0
catching :: MonadUnliftIO m => Getting (First a) SomeException a -> m r -> (a -> m r) -> m r
catching :: forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> m r -> (a -> m r) -> m r
catching Getting (First a) SomeException a
l = forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust (forall a s. Getting (First a) s a -> s -> Maybe a
preview Getting (First a) SomeException a
l)
{-# INLINE catching #-}

-- | 'Control.Exception.Lens.catching_' using 'MonadUnliftIO'
--
-- @since 0.2.25.0
catching_ :: MonadUnliftIO m => Getting (First a) SomeException a -> m r -> m r -> m r
catching_ :: forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> m r -> m r -> m r
catching_ Getting (First a) SomeException a
l m r
a m r
b = forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust (forall a s. Getting (First a) s a -> s -> Maybe a
preview Getting (First a) SomeException a
l) m r
a (forall a b. a -> b -> a
const m r
b)
{-# INLINE catching_ #-}

-- | 'Control.Exception.Lens.handling' using 'MonadUnliftIO'
--
-- @since 0.2.25.0
handling :: MonadUnliftIO m => Getting (First a) SomeException a -> (a -> m r) -> m r -> m r
handling :: forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> (a -> m r) -> m r -> m r
handling Getting (First a) SomeException a
l = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> m r -> (a -> m r) -> m r
catching Getting (First a) SomeException a
l)
{-# INLINE handling #-}

-- | 'Control.Exception.Lens.handling_' using 'MonadUnliftIO'
--
-- @since 0.2.25.0
handling_ :: MonadUnliftIO m => Getting (First a) SomeException a -> m r -> m r -> m r
handling_ :: forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> m r -> m r -> m r
handling_ Getting (First a) SomeException a
l = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> m r -> m r -> m r
catching_ Getting (First a) SomeException a
l)
{-# INLINE handling_ #-}

-- | 'Control.Exception.Lens.trying' using 'MonadUnliftIO'
--
-- @since 0.2.25.0
trying :: MonadUnliftIO m => Getting (First a) SomeException a -> m r -> m (Either a r)
trying :: forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> m r -> m (Either a r)
trying Getting (First a) SomeException a
l = forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust (forall a s. Getting (First a) s a -> s -> Maybe a
preview Getting (First a) SomeException a
l)
{-# INLINE trying #-}

-- | 'Control.Exception.Lens.trying_' using 'MonadUnliftIO'
--
-- @since 0.2.25.0
trying_ :: MonadUnliftIO m => Getting (First a) SomeException a -> m r -> m (Maybe r)
trying_ :: forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> m r -> m (Maybe r)
trying_ Getting (First a) SomeException a
l m r
m = forall a s. Getting (First a) s a -> s -> Maybe a
preview forall a b b'. Traversal (Either a b) (Either a b') b b'
_Right forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> m r -> m (Either a r)
trying Getting (First a) SomeException a
l m r
m
{-# INLINE trying_ #-}

--------------------------------------------------------------------------------
-- Enough of (micro)lens to accomplish this mondule without any dependencies
--
-- TODO: code review note: should we just bring in microlens?
--------------------------------------------------------------------------------
type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t

_Right :: Traversal (Either a b) (Either a b') b b'
_Right :: forall a b b'. Traversal (Either a b) (Either a b') b b'
_Right b -> f b'
f (Right b
b) = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
f b
b
_Right b -> f b'
_ (Left a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left a
a)
{-# INLINE _Right #-}

type Getting r s a = (a -> Const r a) -> s -> Const r s

preview :: Getting (First a) s a -> s -> Maybe a
preview :: forall a s. Getting (First a) s a -> s -> Maybe a
preview Getting (First a) s a
l = forall a. First a -> Maybe a
getFirst forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf Getting (First a) s a
l (forall a. Maybe a -> First a
First forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. forall a. a -> Maybe a
Just)
{-# INLINE preview #-}

foldMapOf :: Getting r s a -> (a -> r) -> s -> r
foldMapOf :: forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf Getting r s a
l a -> r
f = forall {k} a (b :: k). Const a b -> a
getConst forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. Getting r s a
l (forall {k} a (b :: k). a -> Const a b
Const forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. a -> r
f)
{-# INLINE foldMapOf #-}

#if __GLASGOW_HASKELL__ >= 708
( #. ) :: Coercible c b => (b -> c) -> (a -> b) -> (a -> c)
( #. ) b -> c
_ = coerce :: forall a b. Coercible a b => a -> b
coerce (\b
x -> b
x :: b) :: forall a b. Coercible b a => a -> b
#else
( #. ) :: (b -> c) -> (a -> b) -> (a -> c)
( #. ) _ = unsafeCoerce
#endif

{-# INLINE ( #. ) #-}

infixr 9 #.