module Control.Monad.Ology.Specific.ComposeInner where

import Control.Monad.Ology.General.Exception.Class
import Control.Monad.Ology.General.Extract
import Control.Monad.Ology.General.Function
import Control.Monad.Ology.General.IO
import Control.Monad.Ology.General.Identity
import Control.Monad.Ology.General.Inner
import Control.Monad.Ology.General.Outer
import Control.Monad.Ology.General.Trans.Constraint
import Control.Monad.Ology.General.Trans.Hoist
import Control.Monad.Ology.General.Trans.Trans
import Control.Monad.Ology.Specific.Result
import Import

type ComposeInner :: (Type -> Type) -> (Type -> Type) -> Type -> Type
newtype ComposeInner inner outer a = MkComposeInner
    { forall (inner :: Type -> Type) (outer :: Type -> Type) a.
ComposeInner inner outer a -> outer (inner a)
unComposeInner :: outer (inner a)
    }

instance (Foldable inner, Foldable outer, Functor outer) => Foldable (ComposeInner inner outer) where
    foldMap :: forall m a. Monoid m => (a -> m) -> ComposeInner inner outer a -> m
foldMap a -> m
am (MkComposeInner outer (inner a)
oia) = forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {k} (cat :: k -> k -> Type) (a :: k).
Category cat =>
cat a a
id forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
am) outer (inner a)
oia

instance (Traversable inner, Traversable outer) => Traversable (ComposeInner inner outer) where
    traverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b)
-> ComposeInner inner outer a -> f (ComposeInner inner outer b)
traverse a -> f b
afb (MkComposeInner outer (inner a)
oia) = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (inner :: Type -> Type) (outer :: Type -> Type) a.
outer (inner a) -> ComposeInner inner outer a
MkComposeInner forall a b. (a -> b) -> a -> b
$ forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
afb) outer (inner a)
oia

instance Traversable inner => TransConstraint Traversable (ComposeInner inner) where
    hasTransConstraint :: forall (m :: Type -> Type).
Traversable m =>
Dict (Traversable (ComposeInner inner m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (Functor inner, Functor outer) => Functor (ComposeInner inner outer) where
    fmap :: forall a b.
(a -> b)
-> ComposeInner inner outer a -> ComposeInner inner outer b
fmap a -> b
ab (MkComposeInner outer (inner a)
oia) = forall (inner :: Type -> Type) (outer :: Type -> Type) a.
outer (inner a) -> ComposeInner inner outer a
MkComposeInner forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
ab) outer (inner a)
oia

instance Functor inner => TransConstraint Functor (ComposeInner inner) where
    hasTransConstraint :: forall (m :: Type -> Type).
Functor m =>
Dict (Functor (ComposeInner inner m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadInner inner, Monad outer) => Applicative (ComposeInner inner outer) where
    pure :: forall a. a -> ComposeInner inner outer a
pure a
a = forall (inner :: Type -> Type) (outer :: Type -> Type) a.
outer (inner a) -> ComposeInner inner outer a
MkComposeInner forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a
    -- cannot use obvious definition for <*>, because that would incorrectly execute the outer part of ma even if mab fails
    ComposeInner inner outer (a -> b)
mab <*> :: forall a b.
ComposeInner inner outer (a -> b)
-> ComposeInner inner outer a -> ComposeInner inner outer b
<*> ComposeInner inner outer a
ma = do
        a -> b
ab <- ComposeInner inner outer (a -> b)
mab
        a
a <- ComposeInner inner outer a
ma
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b
ab a
a

instance (MonadInner inner, Monad outer, Alternative inner) => Alternative (ComposeInner inner outer) where
    empty :: forall a. ComposeInner inner outer a
empty = forall (inner :: Type -> Type) (outer :: Type -> Type) a.
outer (inner a) -> ComposeInner inner outer a
MkComposeInner forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall (f :: Type -> Type) a. Alternative f => f a
empty
    -- cannot use obvious definition for <|> for similar reasons as in <*>
    (MkComposeInner outer (inner a)
oia) <|> :: forall a.
ComposeInner inner outer a
-> ComposeInner inner outer a -> ComposeInner inner outer a
<|> ComposeInner inner outer a
cb = do
        Maybe a
ma <-
            forall (inner :: Type -> Type) (outer :: Type -> Type) a.
outer (inner a) -> ComposeInner inner outer a
MkComposeInner forall a b. (a -> b) -> a -> b
$ do
                inner a
ia <- outer (inner a)
oia
                forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just inner a
ia forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        case Maybe a
ma of
            Just a
a -> forall (m :: Type -> Type) a. Monad m => a -> m a
return a
a
            Maybe a
Nothing -> ComposeInner inner outer a
cb

instance (MonadInner inner, Monad outer) => Monad (ComposeInner inner outer) where
    return :: forall a. a -> ComposeInner inner outer a
return = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
    (MkComposeInner outer (inner a)
oia) >>= :: forall a b.
ComposeInner inner outer a
-> (a -> ComposeInner inner outer b) -> ComposeInner inner outer b
>>= a -> ComposeInner inner outer b
p =
        forall (inner :: Type -> Type) (outer :: Type -> Type) a.
outer (inner a) -> ComposeInner inner outer a
MkComposeInner forall a b. (a -> b) -> a -> b
$ do
            inner a
ia <- outer (inner a)
oia
            case forall (m :: Type -> Type) a.
MonadInner m =>
m a -> Result (Exc m) a
retrieveInner inner a
ia of
                SuccessResult a
a -> do
                    inner b
ib <- forall (inner :: Type -> Type) (outer :: Type -> Type) a.
ComposeInner inner outer a -> outer (inner a)
unComposeInner forall a b. (a -> b) -> a -> b
$ a -> ComposeInner inner outer b
p a
a
                    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ inner a
ia forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> inner b
ib
                FailureResult Exc inner
e -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc inner
e

instance MonadInner inner => TransConstraint Monad (ComposeInner inner) where
    hasTransConstraint :: forall (m :: Type -> Type).
Monad m =>
Dict (Monad (ComposeInner inner m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadInner inner, MonadFail outer) => MonadFail (ComposeInner inner outer) where
    fail :: forall a. String -> ComposeInner inner outer a
fail String
s = forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
s

instance MonadInner inner => TransConstraint MonadFail (ComposeInner inner) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadFail m =>
Dict (MonadFail (ComposeInner inner m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadInner inner, MonadInner outer) => MonadInner (ComposeInner inner outer) where
    retrieveInner :: forall a.
ComposeInner inner outer a
-> Result (Exc (ComposeInner inner outer)) a
retrieveInner (MkComposeInner outer (inner a)
oia) =
        case forall (m :: Type -> Type) a.
MonadInner m =>
m a -> Result (Exc m) a
retrieveInner outer (inner a)
oia of
            SuccessResult inner a
ia ->
                case forall (m :: Type -> Type) a.
MonadInner m =>
m a -> Result (Exc m) a
retrieveInner inner a
ia of
                    SuccessResult a
a -> forall e a. a -> Result e a
SuccessResult a
a
                    FailureResult Exc inner
e -> forall e a. e -> Result e a
FailureResult forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Exc inner
e
            FailureResult Exc outer
e -> forall e a. e -> Result e a
FailureResult forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Exc outer
e

instance MonadInner inner => TransConstraint MonadInner (ComposeInner inner) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadInner m =>
Dict (MonadInner (ComposeInner inner m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadInner inner, MonadOuter inner, MonadOuter outer) => MonadOuter (ComposeInner inner outer) where
    getExtract :: ComposeInner inner outer (WExtract (ComposeInner inner outer))
getExtract =
        forall (inner :: Type -> Type) (outer :: Type -> Type) a.
outer (inner a) -> ComposeInner inner outer a
MkComposeInner forall a b. (a -> b) -> a -> b
$ do
            MkWExtract Extract outer
oaa <- forall (m :: Type -> Type). MonadOuter m => m (WExtract m)
getExtract
            forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
                MkWExtract Extract inner
iaa <- forall (m :: Type -> Type). MonadOuter m => m (WExtract m)
getExtract
                forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type). Extract m -> WExtract m
MkWExtract forall a b. (a -> b) -> a -> b
$ \(MkComposeInner outer (inner a)
oia) -> Extract inner
iaa forall a b. (a -> b) -> a -> b
$ Extract outer
oaa outer (inner a)
oia

instance (MonadInner inner, MonadOuter inner) => TransConstraint MonadOuter (ComposeInner inner) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadOuter m =>
Dict (MonadOuter (ComposeInner inner m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadInner inner, MonadFix outer) => MonadFix (ComposeInner inner outer) where
    mfix :: forall a.
(a -> ComposeInner inner outer a) -> ComposeInner inner outer a
mfix a -> ComposeInner inner outer a
ama =
        forall (inner :: Type -> Type) (outer :: Type -> Type) a.
outer (inner a) -> ComposeInner inner outer a
MkComposeInner forall a b. (a -> b) -> a -> b
$
        forall (m :: Type -> Type) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \inner a
ia ->
            forall (inner :: Type -> Type) (outer :: Type -> Type) a.
ComposeInner inner outer a -> outer (inner a)
unComposeInner forall a b. (a -> b) -> a -> b
$
            a -> ComposeInner inner outer a
ama forall a b. (a -> b) -> a -> b
$
            case forall (m :: Type -> Type) a.
MonadInner m =>
m a -> Result (Exc m) a
retrieveInner inner a
ia of
                SuccessResult a
a -> a
a
                FailureResult Exc inner
_ -> forall a. HasCallStack => String -> a
error String
"bad ComposeInner mfix"

instance MonadInner inner => TransConstraint MonadFix (ComposeInner inner) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadFix m =>
Dict (MonadFix (ComposeInner inner m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadInner inner, Monad outer, Alternative inner) => MonadPlus (ComposeInner inner outer)

instance (MonadExtract inner, MonadExtract outer) => MonadExtract (ComposeInner inner outer) where
    mToValue :: Extract (ComposeInner inner outer)
mToValue (MkComposeInner outer (inner a)
oia) = forall (m :: Type -> Type). MonadExtract m => Extract m
mToValue forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type). MonadExtract m => Extract m
mToValue outer (inner a)
oia

instance MonadExtract inner => TransConstraint MonadExtract (ComposeInner inner) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadExtract m =>
Dict (MonadExtract (ComposeInner inner m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadIdentity inner, MonadIdentity outer) => MonadIdentity (ComposeInner inner outer)

instance MonadIdentity inner => TransConstraint MonadIdentity (ComposeInner inner) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadIdentity m =>
Dict (MonadIdentity (ComposeInner inner m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadInner inner, MonadIO outer) => MonadIO (ComposeInner inner outer) where
    liftIO :: forall a. IO a -> ComposeInner inner outer a
liftIO IO a
ioa = forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO a
ioa

instance MonadInner inner => TransConstraint MonadIO (ComposeInner inner) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadIO m =>
Dict (MonadIO (ComposeInner inner m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

liftInner :: Applicative outer => inner --> ComposeInner inner outer
liftInner :: forall (outer :: Type -> Type) (inner :: Type -> Type).
Applicative outer =>
inner --> ComposeInner inner outer
liftInner inner a
na = forall (inner :: Type -> Type) (outer :: Type -> Type) a.
outer (inner a) -> ComposeInner inner outer a
MkComposeInner forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a. Applicative f => a -> f a
pure inner a
na

instance (MonadInner inner, MonadException inner, MonadException m) => MonadException (ComposeInner inner m) where
    type Exc (ComposeInner inner m) = Either (Exc inner) (Exc m)
    throwExc :: forall a. Exc (ComposeInner inner m) -> ComposeInner inner m a
throwExc (Left Exc inner
e) = forall (outer :: Type -> Type) (inner :: Type -> Type).
Applicative outer =>
inner --> ComposeInner inner outer
liftInner forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc inner
e
    throwExc (Right Exc m
e) = forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc m
e
    catchExc :: forall a.
ComposeInner inner m a
-> (Exc (ComposeInner inner m) -> ComposeInner inner m a)
-> ComposeInner inner m a
catchExc (MkComposeInner m (inner a)
mia) Exc (ComposeInner inner m) -> ComposeInner inner m a
handler =
        forall (inner :: Type -> Type) (outer :: Type -> Type) a.
outer (inner a) -> ComposeInner inner outer a
MkComposeInner forall a b. (a -> b) -> a -> b
$ do
            Result (Exc m) (inner a)
ira <- forall (m :: Type -> Type) a.
MonadException m =>
m a -> m (Result (Exc m) a)
tryExc m (inner a)
mia
            case forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: Type -> Type) a.
MonadInner m =>
m a -> Result (Exc m) a
retrieveInner Result (Exc m) (inner a)
ira of
                FailureResult Exc m
e -> forall (inner :: Type -> Type) (outer :: Type -> Type) a.
ComposeInner inner outer a -> outer (inner a)
unComposeInner forall a b. (a -> b) -> a -> b
$ Exc (ComposeInner inner m) -> ComposeInner inner m a
handler forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Exc m
e
                SuccessResult (FailureResult Exc inner
e) -> forall (inner :: Type -> Type) (outer :: Type -> Type) a.
ComposeInner inner outer a -> outer (inner a)
unComposeInner forall a b. (a -> b) -> a -> b
$ Exc (ComposeInner inner m) -> ComposeInner inner m a
handler forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Exc inner
e
                SuccessResult (SuccessResult a
a) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. Monad m => a -> m a
return a
a

instance (MonadInner inner, MonadException inner) => TransConstraint MonadException (ComposeInner inner) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadException m =>
Dict (MonadException (ComposeInner inner m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance MonadInner inner => MonadTrans (ComposeInner inner) where
    lift :: forall (m :: Type -> Type) a.
Monad m =>
m a -> ComposeInner inner m a
lift m a
ma = forall (inner :: Type -> Type) (outer :: Type -> Type) a.
outer (inner a) -> ComposeInner inner outer a
MkComposeInner forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: Type -> Type) a. Applicative f => a -> f a
pure m a
ma

instance MonadInner inner => MonadTransHoist (ComposeInner inner) where
    hoist :: forall (m1 :: Type -> Type) (m2 :: Type -> Type).
(Monad m1, Monad m2) =>
(m1 --> m2) -> ComposeInner inner m1 --> ComposeInner inner m2
hoist m1 --> m2
ii (MkComposeInner m1 (inner a)
ma) = forall (inner :: Type -> Type) (outer :: Type -> Type) a.
outer (inner a) -> ComposeInner inner outer a
MkComposeInner forall a b. (a -> b) -> a -> b
$ m1 --> m2
ii m1 (inner a)
ma