{-# 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 = (SomeException -> Maybe a) -> m r -> (a -> m r) -> m r
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust (Getting (First a) SomeException a -> SomeException -> Maybe a
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 = (SomeException -> Maybe a) -> m r -> (a -> m r) -> m r
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust (Getting (First a) SomeException a -> SomeException -> Maybe a
forall a s. Getting (First a) s a -> s -> Maybe a
preview Getting (First a) SomeException a
l) m r
a (m r -> a -> m r
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 = (m r -> (a -> m r) -> m r) -> (a -> m r) -> m r -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Getting (First a) SomeException a -> m r -> (a -> m r) -> m r
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 = (m r -> m r -> m r) -> m r -> m r -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Getting (First a) SomeException a -> m r -> m r -> m r
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 = (SomeException -> Maybe a) -> m r -> m (Either a r)
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust (Getting (First a) SomeException a -> SomeException -> Maybe a
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 = Getting (First r) (Either a r) r -> Either a r -> Maybe r
forall a s. Getting (First a) s a -> s -> Maybe a
preview Getting (First r) (Either a r) r
forall a b b' (f :: * -> *).
Applicative f =>
(b -> f b') -> Either a b -> f (Either a b')
_Right (Either a r -> Maybe r) -> m (Either a r) -> m (Maybe r)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Getting (First a) SomeException a -> m r -> m (Either a r)
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' (f :: * -> *).
Applicative f =>
(b -> f b') -> Either a b -> f (Either a b')
_Right b -> f b'
f (Right b
b) = b' -> Either a b'
forall a b. b -> Either a b
Right (b' -> Either a b') -> f b' -> f (Either a b')
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) = Either a b' -> f (Either a b')
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either a b'
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 = First a -> Maybe a
forall a. First a -> Maybe a
getFirst (First a -> Maybe a) -> (s -> First a) -> s -> Maybe a
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. Getting (First a) s a -> (a -> First a) -> s -> First a
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf Getting (First a) s a
l (Maybe a -> First a
forall a. Maybe a -> First a
First (Maybe a -> First a) -> (a -> Maybe a) -> a -> First a
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. a -> Maybe a
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 = Const r s -> r
forall {k} a (b :: k). Const a b -> a
getConst (Const r s -> r) -> (s -> Const r s) -> s -> r
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. Getting r s a
l (r -> Const r a
forall {k} a (b :: k). a -> Const a b
Const (r -> Const r a) -> (a -> r) -> a -> Const r a
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
_ = (b -> b) -> a -> b
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 #.