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 forall outer inner. (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) = (m -> m) -> outer m -> m forall m a. Monoid m => (a -> m) -> outer a -> m forall (t :: Type -> Type) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap m -> m forall a. a -> a forall {k} (cat :: k -> k -> Type) (a :: k). Category cat => cat a a id (outer m -> m) -> outer m -> m forall a b. (a -> b) -> a -> b $ (inner a -> m) -> outer (inner a) -> outer m forall a b. (a -> b) -> outer a -> outer b forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap ((a -> m) -> inner a -> m forall m a. Monoid m => (a -> m) -> inner a -> m forall (t :: Type -> Type) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap a -> m am) outer (inner a) oia instance forall outer inner. (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) = (outer (inner b) -> ComposeOuter outer inner b) -> f (outer (inner b)) -> f (ComposeOuter outer inner b) forall a b. (a -> b) -> f a -> f b forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap outer (inner b) -> ComposeOuter outer inner b forall (outer :: Type -> Type) (inner :: Type -> Type) a. outer (inner a) -> ComposeOuter outer inner a MkComposeOuter (f (outer (inner b)) -> f (ComposeOuter outer inner b)) -> f (outer (inner b)) -> f (ComposeOuter outer inner b) forall a b. (a -> b) -> a -> b $ (inner a -> f (inner b)) -> outer (inner a) -> f (outer (inner b)) forall (t :: Type -> Type) (f :: Type -> Type) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) forall (f :: Type -> Type) a b. Applicative f => (a -> f b) -> outer a -> f (outer b) traverse ((a -> f b) -> inner a -> f (inner b) forall (t :: Type -> Type) (f :: Type -> Type) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) forall (f :: Type -> Type) a b. Applicative f => (a -> f b) -> inner a -> f (inner b) traverse a -> f b afb) outer (inner a) oia instance forall outer. Traversable outer => TransConstraint Traversable (ComposeOuter outer) where hasTransConstraint :: forall (m :: Type -> Type). Traversable m => Dict (Traversable (ComposeOuter outer m)) hasTransConstraint = Dict (Traversable (ComposeOuter outer m)) forall (a :: Constraint). a => Dict a Dict instance forall outer inner. (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) = outer (inner b) -> ComposeOuter outer inner b forall (outer :: Type -> Type) (inner :: Type -> Type) a. outer (inner a) -> ComposeOuter outer inner a MkComposeOuter (outer (inner b) -> ComposeOuter outer inner b) -> outer (inner b) -> ComposeOuter outer inner b forall a b. (a -> b) -> a -> b $ (inner a -> inner b) -> outer (inner a) -> outer (inner b) forall a b. (a -> b) -> outer a -> outer b forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap ((a -> b) -> inner a -> inner b forall a b. (a -> b) -> inner a -> inner b forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b ab) outer (inner a) oia instance forall outer. Functor outer => TransConstraint Functor (ComposeOuter outer) where hasTransConstraint :: forall (m :: Type -> Type). Functor m => Dict (Functor (ComposeOuter outer m)) hasTransConstraint = Dict (Functor (ComposeOuter outer m)) forall (a :: Constraint). a => Dict a Dict instance forall outer inner. (Applicative inner, Applicative outer) => Applicative (ComposeOuter outer inner) where pure :: forall a. a -> ComposeOuter outer inner a pure a a = outer (inner a) -> ComposeOuter outer inner a forall (outer :: Type -> Type) (inner :: Type -> Type) a. outer (inner a) -> ComposeOuter outer inner a MkComposeOuter (outer (inner a) -> ComposeOuter outer inner a) -> outer (inner a) -> ComposeOuter outer inner a forall a b. (a -> b) -> a -> b $ inner a -> outer (inner a) forall a. a -> outer a forall (f :: Type -> Type) a. Applicative f => a -> f a pure (inner a -> outer (inner a)) -> inner a -> outer (inner a) forall a b. (a -> b) -> a -> b $ a -> inner a forall a. a -> inner a 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 = outer (inner b) -> ComposeOuter outer inner b forall (outer :: Type -> Type) (inner :: Type -> Type) a. outer (inner a) -> ComposeOuter outer inner a MkComposeOuter (outer (inner b) -> ComposeOuter outer inner b) -> outer (inner b) -> ComposeOuter outer inner b forall a b. (a -> b) -> a -> b $ (inner (a -> b) -> inner a -> inner b) -> outer (inner (a -> b)) -> outer (inner a) -> outer (inner b) forall a b c. (a -> b -> c) -> outer a -> outer b -> outer c forall (f :: Type -> Type) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 inner (a -> b) -> inner a -> inner b forall a b. inner (a -> b) -> inner a -> inner b 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 forall outer. Applicative outer => TransConstraint Applicative (ComposeOuter outer) where hasTransConstraint :: forall (m :: Type -> Type). Applicative m => Dict (Applicative (ComposeOuter outer m)) hasTransConstraint = Dict (Applicative (ComposeOuter outer m)) forall (a :: Constraint). a => Dict a Dict instance forall outer inner. (Monad inner, MonadOuter outer) => Monad (ComposeOuter outer inner) where return :: forall a. a -> ComposeOuter outer inner a return = a -> ComposeOuter outer inner a forall a. a -> ComposeOuter outer inner a 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 = outer (inner b) -> ComposeOuter outer inner b forall (outer :: Type -> Type) (inner :: Type -> Type) a. outer (inner a) -> ComposeOuter outer inner a MkComposeOuter (outer (inner b) -> ComposeOuter outer inner b) -> outer (inner b) -> ComposeOuter outer inner b forall a b. (a -> b) -> a -> b $ do inner a ia <- outer (inner a) oia MkWExtract Extract outer oaa <- outer (WExtract outer) forall (m :: Type -> Type). MonadOuter m => m (WExtract m) getExtract inner b -> outer (inner b) forall a. a -> outer a forall (m :: Type -> Type) a. Monad m => a -> m a return (inner b -> outer (inner b)) -> inner b -> outer (inner b) forall a b. (a -> b) -> a -> b $ do a a <- inner a ia outer (inner b) -> inner b Extract outer oaa (outer (inner b) -> inner b) -> outer (inner b) -> inner b forall a b. (a -> b) -> a -> b $ ComposeOuter outer inner b -> outer (inner b) forall (outer :: Type -> Type) (inner :: Type -> Type) a. ComposeOuter outer inner a -> outer (inner a) unComposeOuter (ComposeOuter outer inner b -> outer (inner b)) -> ComposeOuter outer inner b -> outer (inner b) forall a b. (a -> b) -> a -> b $ a -> ComposeOuter outer inner b f a a instance forall outer. MonadOuter outer => TransConstraint Monad (ComposeOuter outer) where hasTransConstraint :: forall (m :: Type -> Type). Monad m => Dict (Monad (ComposeOuter outer m)) hasTransConstraint = Dict (Monad (ComposeOuter outer m)) forall (a :: Constraint). a => Dict a Dict liftOuter :: forall outer inner. (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 = outer (inner a) -> ComposeOuter outer inner a forall (outer :: Type -> Type) (inner :: Type -> Type) a. outer (inner a) -> ComposeOuter outer inner a MkComposeOuter (outer (inner a) -> ComposeOuter outer inner a) -> outer (inner a) -> ComposeOuter outer inner a forall a b. (a -> b) -> a -> b $ (a -> inner a) -> outer a -> outer (inner a) forall a b. (a -> b) -> outer a -> outer b forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap a -> inner a forall a. a -> inner a forall (f :: Type -> Type) a. Applicative f => a -> f a pure outer a oa instance forall outer. MonadOuter outer => MonadTrans (ComposeOuter outer) where lift :: forall (m :: Type -> Type) a. Monad m => m a -> ComposeOuter outer m a lift m a ma = outer (m a) -> ComposeOuter outer m a forall (outer :: Type -> Type) (inner :: Type -> Type) a. outer (inner a) -> ComposeOuter outer inner a MkComposeOuter (outer (m a) -> ComposeOuter outer m a) -> outer (m a) -> ComposeOuter outer m a forall a b. (a -> b) -> a -> b $ m a -> outer (m a) forall a. a -> outer a forall (f :: Type -> Type) a. Applicative f => a -> f a pure m a ma instance forall outer inner. (MonadOuter outer, MonadIO inner) => MonadIO (ComposeOuter outer inner) where liftIO :: forall a. IO a -> ComposeOuter outer inner a liftIO IO a ioa = inner a -> ComposeOuter outer inner a forall (m :: Type -> Type) a. Monad m => m a -> ComposeOuter outer m a forall (t :: TransKind) (m :: Type -> Type) a. (MonadTrans t, Monad m) => m a -> t m a lift (inner a -> ComposeOuter outer inner a) -> inner a -> ComposeOuter outer inner a forall a b. (a -> b) -> a -> b $ IO a -> inner a forall a. IO a -> inner a forall (m :: Type -> Type) a. MonadIO m => IO a -> m a liftIO IO a ioa instance forall outer. MonadOuter outer => TransConstraint MonadIO (ComposeOuter outer) where hasTransConstraint :: forall (m :: Type -> Type). MonadIO m => Dict (MonadIO (ComposeOuter outer m)) hasTransConstraint = Dict (MonadIO (ComposeOuter outer m)) forall (a :: Constraint). a => Dict a Dict instance forall outer inner. (MonadOuter outer, MonadFail inner) => MonadFail (ComposeOuter outer inner) where fail :: forall a. String -> ComposeOuter outer inner a fail String e = outer (inner a) -> ComposeOuter outer inner a forall (outer :: Type -> Type) (inner :: Type -> Type) a. outer (inner a) -> ComposeOuter outer inner a MkComposeOuter (outer (inner a) -> ComposeOuter outer inner a) -> outer (inner a) -> ComposeOuter outer inner a forall a b. (a -> b) -> a -> b $ inner a -> outer (inner a) forall a. a -> outer a forall (m :: Type -> Type) a. Monad m => a -> m a return (inner a -> outer (inner a)) -> inner a -> outer (inner a) forall a b. (a -> b) -> a -> b $ String -> inner a forall a. String -> inner a forall (m :: Type -> Type) a. MonadFail m => String -> m a fail String e instance forall outer. MonadOuter outer => TransConstraint MonadFail (ComposeOuter outer) where hasTransConstraint :: forall (m :: Type -> Type). MonadFail m => Dict (MonadFail (ComposeOuter outer m)) hasTransConstraint = Dict (MonadFail (ComposeOuter outer m)) forall (a :: Constraint). a => Dict a Dict instance forall outer inner. (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 = outer (inner a) -> ComposeOuter outer inner a forall (outer :: Type -> Type) (inner :: Type -> Type) a. outer (inner a) -> ComposeOuter outer inner a MkComposeOuter (outer (inner a) -> ComposeOuter outer inner a) -> outer (inner a) -> ComposeOuter outer inner a forall a b. (a -> b) -> a -> b $ do MkWExtract Extract outer extract <- outer (WExtract outer) forall (m :: Type -> Type). MonadOuter m => m (WExtract m) getExtract inner a -> outer (inner a) forall a. a -> outer a forall (m :: Type -> Type) a. Monad m => a -> m a return (inner a -> outer (inner a)) -> inner a -> outer (inner a) forall a b. (a -> b) -> a -> b $ (a -> inner a) -> inner a forall a. (a -> inner a) -> inner a forall (m :: Type -> Type) a. MonadFix m => (a -> m a) -> m a mfix ((a -> inner a) -> inner a) -> (a -> inner a) -> inner a forall a b. (a -> b) -> a -> b $ \a a -> outer (inner a) -> inner a Extract outer extract (outer (inner a) -> inner a) -> outer (inner a) -> inner a forall a b. (a -> b) -> a -> b $ ComposeOuter outer inner a -> outer (inner a) forall (outer :: Type -> Type) (inner :: Type -> Type) a. ComposeOuter outer inner a -> outer (inner a) unComposeOuter (ComposeOuter outer inner a -> outer (inner a)) -> ComposeOuter outer inner a -> outer (inner a) forall a b. (a -> b) -> a -> b $ a -> ComposeOuter outer inner a f a a instance forall outer. MonadOuter outer => TransConstraint MonadFix (ComposeOuter outer) where hasTransConstraint :: forall (m :: Type -> Type). MonadFix m => Dict (MonadFix (ComposeOuter outer m)) hasTransConstraint = Dict (MonadFix (ComposeOuter outer m)) forall (a :: Constraint). a => Dict a Dict instance forall outer m. (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 = m a -> ComposeOuter outer m a forall (m :: Type -> Type) a. Monad m => m a -> ComposeOuter outer m a forall (t :: TransKind) (m :: Type -> Type) a. (MonadTrans t, Monad m) => m a -> t m a lift (m a -> ComposeOuter outer m a) -> m a -> ComposeOuter outer 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 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 (m1 :: Type -> Type) a. Monad m1 => ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a)) -> m (Tunnel (ComposeOuter outer) a)) -> ComposeOuter outer m a 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 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 (m1 :: Type -> Type) a. Monad m1 => ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a)) -> m (Tunnel (ComposeOuter outer) a)) -> ComposeOuter outer m a) -> ((forall (m1 :: Type -> Type) a. Monad m1 => ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a)) -> m (Tunnel (ComposeOuter outer) a)) -> ComposeOuter outer m a forall a b. (a -> b) -> a -> b $ \forall (m1 :: Type -> Type) a. Monad m1 => ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a) unlift -> m (Tunnel (ComposeOuter outer) a) -> (Exc m -> m (Tunnel (ComposeOuter outer) a)) -> m (Tunnel (ComposeOuter outer) a) forall a. m a -> (Exc m -> m a) -> m a forall (m :: Type -> Type) a. MonadException m => m a -> (Exc m -> m a) -> m a catchExc (ComposeOuter outer m a -> m (Tunnel (ComposeOuter outer) a) forall (m1 :: Type -> Type) a. Monad m1 => ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a) unlift ComposeOuter outer m a tma) ((Exc m -> m (Tunnel (ComposeOuter outer) a)) -> m (Tunnel (ComposeOuter outer) a)) -> (Exc m -> m (Tunnel (ComposeOuter outer) a)) -> m (Tunnel (ComposeOuter outer) a) forall a b. (a -> b) -> a -> b $ \Exc m e -> ComposeOuter outer m a -> m (Tunnel (ComposeOuter outer) a) forall (m1 :: Type -> Type) a. Monad m1 => ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a) unlift (ComposeOuter outer m a -> m (Tunnel (ComposeOuter outer) a)) -> ComposeOuter outer m a -> m (Tunnel (ComposeOuter outer) a) forall a b. (a -> b) -> a -> b $ Exc (ComposeOuter outer m) -> ComposeOuter outer m a handler Exc m Exc (ComposeOuter outer m) e instance forall outer. 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 = (m1 --> m2) -> ComposeOuter outer m1 --> ComposeOuter outer m2 forall (t :: TransKind) (m1 :: Type -> Type) (m2 :: Type -> Type). (MonadTransTunnel t, Monad m1, Monad m2) => (m1 --> m2) -> t m1 --> t m2 tunnelHoist instance forall outer. 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 = outer (m r) -> ComposeOuter outer m r forall (outer :: Type -> Type) (inner :: Type -> Type) a. outer (inner a) -> ComposeOuter outer inner a MkComposeOuter (outer (m r) -> ComposeOuter outer m r) -> outer (m r) -> ComposeOuter outer m r forall a b. (a -> b) -> a -> b $ do MkWExtract Extract outer oaa <- outer (WExtract outer) forall (m :: Type -> Type). MonadOuter m => m (WExtract m) getExtract m r -> outer (m r) forall a. a -> outer a forall (m :: Type -> Type) a. Monad m => a -> m a return (m r -> outer (m r)) -> m r -> outer (m r) forall a b. (a -> b) -> a -> b $ (Identity r -> r) -> m (Identity r) -> m r forall a b. (a -> b) -> m a -> m b forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap Identity r -> r forall a. Identity a -> a runIdentity (m (Identity r) -> m r) -> m (Identity r) -> m r 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 (m1 :: Type -> Type) a. Monad m1 => ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a)) -> m (Tunnel (ComposeOuter outer) r)) -> (forall (m1 :: Type -> Type) a. Monad m1 => ComposeOuter outer m1 a -> m1 (Tunnel (ComposeOuter outer) a)) -> m (Tunnel (ComposeOuter outer) r) forall a b. (a -> b) -> a -> b $ (a -> Identity a) -> m1 a -> m1 (Identity a) forall a b. (a -> b) -> m1 a -> m1 b forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap a -> Identity a forall a. a -> Identity a Identity (m1 a -> m1 (Identity a)) -> (ComposeOuter outer m1 a -> m1 a) -> ComposeOuter outer m1 a -> m1 (Identity 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 . outer (m1 a) -> m1 a Extract outer oaa (outer (m1 a) -> m1 a) -> (ComposeOuter outer m1 a -> outer (m1 a)) -> ComposeOuter outer m1 a -> m1 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 . ComposeOuter outer m1 a -> outer (m1 a) forall (outer :: Type -> Type) (inner :: Type -> Type) a. ComposeOuter outer inner a -> outer (inner a) unComposeOuter