module Control.Monad.Ology.Specific.ComposeOuter where

import Control.Monad.Ology.General.Exception.Class
import Control.Monad.Ology.General.Function
import Control.Monad.Ology.General.IO
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.General.Trans.Tunnel
import Import

type ComposeOuter :: (Type -> Type) -> (Type -> Type) -> Type -> Type
newtype ComposeOuter outer inner a = MkComposeOuter
    { forall (outer :: Type -> Type) (inner :: Type -> Type) a.
ComposeOuter outer inner a -> outer (inner a)
unComposeOuter :: outer (inner a)
    }

instance (Foldable inner, Foldable outer, Functor outer) => Foldable (ComposeOuter outer inner) where
    foldMap :: forall m a. Monoid m => (a -> m) -> ComposeOuter outer inner a -> m
foldMap a -> m
am (MkComposeOuter 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 (ComposeOuter outer inner) where
    traverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b)
-> ComposeOuter outer inner a -> f (ComposeOuter outer inner b)
traverse a -> f b
afb (MkComposeOuter outer (inner a)
oia) = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (outer :: Type -> Type) (inner :: Type -> Type) a.
outer (inner a) -> ComposeOuter outer inner a
MkComposeOuter 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 outer => TransConstraint Traversable (ComposeOuter outer) where
    hasTransConstraint :: forall (m :: Type -> Type).
Traversable m =>
Dict (Traversable (ComposeOuter outer m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (Functor inner, Functor outer) => Functor (ComposeOuter outer inner) where
    fmap :: forall a b.
(a -> b)
-> ComposeOuter outer inner a -> ComposeOuter outer inner b
fmap a -> b
ab (MkComposeOuter outer (inner a)
oia) = forall (outer :: Type -> Type) (inner :: Type -> Type) a.
outer (inner a) -> ComposeOuter outer inner a
MkComposeOuter 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 outer => TransConstraint Functor (ComposeOuter outer) where
    hasTransConstraint :: forall (m :: Type -> Type).
Functor m =>
Dict (Functor (ComposeOuter outer m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (Applicative inner, Applicative outer) => Applicative (ComposeOuter outer inner) where
    pure :: forall a. a -> ComposeOuter outer inner a
pure a
a = forall (outer :: Type -> Type) (inner :: Type -> Type) a.
outer (inner a) -> ComposeOuter outer inner a
MkComposeOuter 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
    MkComposeOuter outer (inner (a -> b))
mab <*> :: forall a b.
ComposeOuter outer inner (a -> b)
-> ComposeOuter outer inner a -> ComposeOuter outer inner b
<*> MkComposeOuter outer (inner a)
ma = forall (outer :: Type -> Type) (inner :: Type -> Type) a.
outer (inner a) -> ComposeOuter outer inner a
MkComposeOuter forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
(<*>) outer (inner (a -> b))
mab outer (inner a)
ma

instance Applicative outer => TransConstraint Applicative (ComposeOuter outer) where
    hasTransConstraint :: forall (m :: Type -> Type).
Applicative m =>
Dict (Applicative (ComposeOuter outer m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (Monad inner, MonadOuter outer) => Monad (ComposeOuter outer inner) where
    return :: forall a. a -> ComposeOuter outer inner a
return = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
    MkComposeOuter outer (inner a)
oia >>= :: forall a b.
ComposeOuter outer inner a
-> (a -> ComposeOuter outer inner b) -> ComposeOuter outer inner b
>>= a -> ComposeOuter outer inner b
f =
        forall (outer :: Type -> Type) (inner :: Type -> Type) a.
outer (inner a) -> ComposeOuter outer inner a
MkComposeOuter forall a b. (a -> b) -> a -> b
$ do
            inner a
ia <- outer (inner a)
oia
            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
                a
a <- inner a
ia
                Extract outer
oaa forall a b. (a -> b) -> a -> b
$ forall (outer :: Type -> Type) (inner :: Type -> Type) a.
ComposeOuter outer inner a -> outer (inner a)
unComposeOuter forall a b. (a -> b) -> a -> b
$ a -> ComposeOuter outer inner b
f a
a

instance MonadOuter outer => TransConstraint Monad (ComposeOuter outer) where
    hasTransConstraint :: forall (m :: Type -> Type).
Monad m =>
Dict (Monad (ComposeOuter outer m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

liftOuter :: (Functor outer, Applicative inner) => outer --> ComposeOuter outer inner
liftOuter :: forall (outer :: Type -> Type) (inner :: Type -> Type).
(Functor outer, Applicative inner) =>
outer --> ComposeOuter outer inner
liftOuter outer a
oa = forall (outer :: Type -> Type) (inner :: Type -> Type) a.
outer (inner a) -> ComposeOuter outer inner a
MkComposeOuter 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 outer a
oa

instance MonadOuter outer => MonadTrans (ComposeOuter outer) where
    lift :: forall (m :: Type -> Type) a.
Monad m =>
m a -> ComposeOuter outer m a
lift m a
ma = forall (outer :: Type -> Type) (inner :: Type -> Type) a.
outer (inner a) -> ComposeOuter outer inner a
MkComposeOuter forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a. Applicative f => a -> f a
pure m a
ma

instance (MonadOuter outer, MonadIO inner) => MonadIO (ComposeOuter outer inner) where
    liftIO :: forall a. IO a -> ComposeOuter outer inner 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 MonadOuter outer => TransConstraint MonadIO (ComposeOuter outer) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadIO m =>
Dict (MonadIO (ComposeOuter outer m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadOuter outer, MonadFail inner) => MonadFail (ComposeOuter outer inner) where
    fail :: forall a. String -> ComposeOuter outer inner a
fail String
e = forall (outer :: Type -> Type) (inner :: Type -> Type) a.
outer (inner a) -> ComposeOuter outer inner a
MkComposeOuter forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
e

instance MonadOuter outer => TransConstraint MonadFail (ComposeOuter outer) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadFail m =>
Dict (MonadFail (ComposeOuter outer m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadOuter outer, MonadFix inner) => MonadFix (ComposeOuter outer inner) where
    mfix :: forall a.
(a -> ComposeOuter outer inner a) -> ComposeOuter outer inner a
mfix a -> ComposeOuter outer inner a
f =
        forall (outer :: Type -> Type) (inner :: Type -> Type) a.
outer (inner a) -> ComposeOuter outer inner a
MkComposeOuter forall a b. (a -> b) -> a -> b
$ do
            MkWExtract Extract outer
extract <- 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) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \a
a -> Extract outer
extract forall a b. (a -> b) -> a -> b
$ forall (outer :: Type -> Type) (inner :: Type -> Type) a.
ComposeOuter outer inner a -> outer (inner a)
unComposeOuter forall a b. (a -> b) -> a -> b
$ a -> ComposeOuter outer inner a
f a
a

instance MonadOuter outer => TransConstraint MonadFix (ComposeOuter outer) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadFix m =>
Dict (MonadFix (ComposeOuter outer m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadOuter outer, MonadException m) => MonadException (ComposeOuter outer m) where
    type Exc (ComposeOuter outer m) = Exc m
    throwExc :: forall a. Exc (ComposeOuter outer m) -> ComposeOuter outer m a
throwExc Exc (ComposeOuter outer 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 (ComposeOuter outer m)
e
    catchExc :: forall a.
ComposeOuter outer m a
-> (Exc (ComposeOuter outer m) -> ComposeOuter outer m a)
-> ComposeOuter outer m a
catchExc ComposeOuter outer m a
tma Exc (ComposeOuter outer m) -> ComposeOuter outer m a
handler = forall (t :: TransKind) (m :: Type -> Type) r.
(MonadTransTunnel t, Monad m) =>
((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  t m1 a -> m1 (Tunnel t a))
 -> m (Tunnel t r))
-> t m r
tunnel forall a b. (a -> b) -> a -> b
$ \forall (m1 :: Type -> Type) a.
Monad m1 =>
ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a)
unlift -> forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc (forall (m1 :: Type -> Type) a.
Monad m1 =>
ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a)
unlift ComposeOuter outer m a
tma) forall a b. (a -> b) -> a -> b
$ \Exc m
e -> forall (m1 :: Type -> Type) a.
Monad m1 =>
ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a)
unlift forall a b. (a -> b) -> a -> b
$ Exc (ComposeOuter outer m) -> ComposeOuter outer m a
handler Exc m
e

instance MonadOuter outer => MonadTransHoist (ComposeOuter outer) where
    hoist :: forall (m1 :: Type -> Type) (m2 :: Type -> Type).
(Monad m1, Monad m2) =>
(m1 --> m2) -> ComposeOuter outer m1 --> ComposeOuter outer m2
hoist = forall (t :: TransKind) (m1 :: Type -> Type) (m2 :: Type -> Type).
(MonadTransTunnel t, Monad m1, Monad m2) =>
(m1 --> m2) -> t m1 --> t m2
tunnelHoist

instance MonadOuter outer => MonadTransTunnel (ComposeOuter outer) where
    type Tunnel (ComposeOuter outer) = Identity
    tunnel :: forall (m :: Type -> Type) r.
Monad m =>
((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a))
 -> m (Tunnel (ComposeOuter outer) r))
-> ComposeOuter outer m r
tunnel (forall (m1 :: Type -> Type) a.
 Monad m1 =>
 ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a))
-> m (Tunnel (ComposeOuter outer) r)
call =
        forall (outer :: Type -> Type) (inner :: Type -> Type) a.
outer (inner a) -> ComposeOuter outer inner a
MkComposeOuter 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
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ (forall (m1 :: Type -> Type) a.
 Monad m1 =>
 ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a))
-> m (Tunnel (ComposeOuter outer) r)
call 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 -> Identity a
Identity forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Extract outer
oaa forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (outer :: Type -> Type) (inner :: Type -> Type) a.
ComposeOuter outer inner a -> outer (inner a)
unComposeOuter