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