{-# OPTIONS -fno-warn-orphans #-}

module Control.Monad.Ology.General.Inner where

import Control.Monad.Ology.General.Exception.Class
import Control.Monad.Ology.Specific.Result
import Import

-- | Monads that can compose as the inner monad with any outer monad to make a monad.
-- See 'Control.Monad.Ology.Specific.ComposeInner.ComposeInner'.
-- Instances of this type are isomorphic to @Either P (Q,a)@ for some types @P@ and @Q@ (with @Monoid Q@).
--
-- Must satisfy:
--
-- * @retrieveInner (fmap f w) = fmap f (retrieveInner w)@
--
-- * @case retrieveInner w of {Left w' -> fmap absurd w'; Right a -> fmap (\\_ -> a) w;} = w@
class (Traversable m, MonadException m) => MonadInner m where
    retrieveInner :: forall a. m a -> Result (Exc m) a

instance MonadInner Identity where
    retrieveInner :: forall a. Identity a -> Result (Exc Identity) a
retrieveInner (Identity a
a) = a -> Result Void a
forall e a. a -> Result e a
SuccessResult a
a

instance MonadInner Maybe where
    retrieveInner :: forall a. Maybe a -> Result (Exc Maybe) a
retrieveInner (Just a
a) = a -> Result () a
forall e a. a -> Result e a
SuccessResult a
a
    retrieveInner Maybe a
Nothing = () -> Result () a
forall e a. e -> Result e a
FailureResult ()

instance MonadInner (Either p) where
    retrieveInner :: forall a. Either p a -> Result (Exc (Either p)) a
retrieveInner (Right a
b) = a -> Result p a
forall e a. a -> Result e a
SuccessResult a
b
    retrieveInner (Left p
a) = p -> Result p a
forall e a. e -> Result e a
FailureResult p
a

instance Monoid p => MonadInner ((,) p) where
    retrieveInner :: forall a. (p, a) -> Result (Exc ((,) p)) a
retrieveInner (p
_, a
a) = a -> Result Void a
forall e a. a -> Result e a
SuccessResult a
a

instance MonadInner (Result e) where
    retrieveInner :: forall a. Result e a -> Result (Exc (Result e)) a
retrieveInner Result e a
ra = Result e a
Result (Exc (Result e)) a
ra

mToMaybe ::
       forall m a. MonadInner m
    => m a
    -> Maybe a
mToMaybe :: forall (m :: Type -> Type) a. MonadInner m => m a -> Maybe a
mToMaybe = Result (Exc m) a -> Maybe a
forall e a. Result e a -> Maybe a
resultToMaybe (Result (Exc m) a -> Maybe a)
-> (m a -> Result (Exc m) a) -> m a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m a -> Result (Exc m) a
forall a. m a -> Result (Exc m) a
forall (m :: Type -> Type) a.
MonadInner m =>
m a -> Result (Exc m) a
retrieveInner

commuteInner ::
       forall m f a. (MonadInner m, Applicative f)
    => m (f a)
    -> f (m a)
commuteInner :: forall (m :: Type -> Type) (f :: Type -> Type) a.
(MonadInner m, Applicative f) =>
m (f a) -> f (m a)
commuteInner m (f a)
mfa =
    case m (f a) -> Result (Exc m) (f a)
forall a. m a -> Result (Exc m) a
forall (m :: Type -> Type) a.
MonadInner m =>
m a -> Result (Exc m) a
retrieveInner m (f a)
mfa of
        SuccessResult f a
fa -> (a -> m a) -> f a -> f (m a)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m a
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure f a
fa
        FailureResult Exc m
ex -> m a -> f (m a)
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (m a -> f (m a)) -> m a -> f (m a)
forall a b. (a -> b) -> a -> b
$ Exc m -> m a
forall a. Exc m -> m a
forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc m
ex