{-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Controlflow.Effect.Transformer.Monadic (Monadic (..), (:>) (..)) where import Pandora.Core.Functor (type (~>)) import Pandora.Pattern.Category ((.), ($)) import Pandora.Pattern.Functor.Covariant (Covariant ((<$>))) import Pandora.Pattern.Functor.Pointable (Pointable (point)) import Pandora.Pattern.Functor.Extractable (Extractable (extract)) import Pandora.Pattern.Functor.Applicative (Applicative ((<*>))) import Pandora.Pattern.Functor.Alternative (Alternative ((<+>))) import Pandora.Pattern.Functor.Avoidable (Avoidable (empty)) import Pandora.Pattern.Functor.Distributive (Distributive ((>>-))) import Pandora.Pattern.Functor.Traversable (Traversable ((->>))) import Pandora.Pattern.Functor.Bindable (Bindable ((>>=))) import Pandora.Pattern.Functor.Extendable (Extendable ((=>>))) import Pandora.Pattern.Functor.Monad (Monad) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite)) class Interpreted t => Monadic t where {-# MINIMAL wrap #-} wrap :: Pointable u => t ~> t :> u infixr 3 :> newtype (:>) t u a = TM { (:>) t u a -> Schematic Monad t u a tm :: Schematic Monad t u a } instance Covariant (Schematic Monad t u) => Covariant (t :> u) where a -> b f <$> :: (a -> b) -> (:>) t u a -> (:>) t u b <$> TM Schematic Monad t u a x = Schematic Monad t u b -> (:>) t u b forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM (Schematic Monad t u b -> (:>) t u b) -> Schematic Monad t u b -> (:>) t u b forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ a -> b f (a -> b) -> Schematic Monad t u a -> Schematic Monad t u b forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b <$> Schematic Monad t u a x instance Pointable (Schematic Monad t u) => Pointable (t :> u) where point :: a |-> (t :> u) point = Schematic Monad t u a -> (:>) t u a forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM (Schematic Monad t u a -> (:>) t u a) -> (a -> Schematic Monad t u a) -> a |-> (t :> u) forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . a -> Schematic Monad t u a forall (t :: * -> *) a. Pointable t => a |-> t point instance Extractable (Schematic Monad t u) => Extractable (t :> u) where extract :: a <-| (t :> u) extract = a <-| Schematic Monad t u forall (t :: * -> *) a. Extractable t => a <-| t extract (a <-| Schematic Monad t u) -> ((:>) t u a -> Schematic Monad t u a) -> a <-| (t :> u) forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . (:>) t u a -> Schematic Monad t u a forall (t :: * -> *) (u :: * -> *) a. (:>) t u a -> Schematic Monad t u a tm instance Applicative (Schematic Monad t u) => Applicative (t :> u) where TM Schematic Monad t u (a -> b) f <*> :: (:>) t u (a -> b) -> (:>) t u a -> (:>) t u b <*> TM Schematic Monad t u a x = Schematic Monad t u b -> (:>) t u b forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM (Schematic Monad t u b -> (:>) t u b) -> Schematic Monad t u b -> (:>) t u b forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ Schematic Monad t u (a -> b) f Schematic Monad t u (a -> b) -> Schematic Monad t u a -> Schematic Monad t u b forall (t :: * -> *) a b. Applicative t => t (a -> b) -> t a -> t b <*> Schematic Monad t u a x instance Alternative (Schematic Monad t u) => Alternative (t :> u) where TM Schematic Monad t u a x <+> :: (:>) t u a -> (:>) t u a -> (:>) t u a <+> TM Schematic Monad t u a y = Schematic Monad t u a -> (:>) t u a forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM (Schematic Monad t u a -> (:>) t u a) -> Schematic Monad t u a -> (:>) t u a forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ Schematic Monad t u a x Schematic Monad t u a -> Schematic Monad t u a -> Schematic Monad t u a forall (t :: * -> *) a. Alternative t => t a -> t a -> t a <+> Schematic Monad t u a y instance Avoidable (Schematic Monad t u) => Avoidable (t :> u) where empty :: (:>) t u a empty = Schematic Monad t u a -> (:>) t u a forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM Schematic Monad t u a forall (t :: * -> *) a. Avoidable t => t a empty instance Traversable (Schematic Monad t u) => Traversable (t :> u) where TM Schematic Monad t u a x ->> :: (:>) t u a -> (a -> u b) -> (u :. (t :> u)) := b ->> a -> u b f = Schematic Monad t u b -> (:>) t u b forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM (Schematic Monad t u b -> (:>) t u b) -> u (Schematic Monad t u b) -> (u :. (t :> u)) := b forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b <$> (Schematic Monad t u a x Schematic Monad t u a -> (a -> u b) -> u (Schematic Monad t u b) forall (t :: * -> *) (u :: * -> *) a b. (Traversable t, Pointable u, Applicative u) => t a -> (a -> u b) -> (u :. t) := b ->> a -> u b f) instance Distributive (Schematic Monad t u) => Distributive (t :> u) where u a x >>- :: u a -> (a -> (:>) t u b) -> ((t :> u) :. u) := b >>- a -> (:>) t u b f = Schematic Monad t u (u b) -> ((t :> u) :. u) := b forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM (Schematic Monad t u (u b) -> ((t :> u) :. u) := b) -> Schematic Monad t u (u b) -> ((t :> u) :. u) := b forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ u a x u a -> (a -> Schematic Monad t u b) -> Schematic Monad t u (u b) forall (t :: * -> *) (u :: * -> *) a b. (Distributive t, Covariant u) => u a -> (a -> t b) -> (t :. u) := b >>- (:>) t u b -> Schematic Monad t u b forall (t :: * -> *) (u :: * -> *) a. (:>) t u a -> Schematic Monad t u a tm ((:>) t u b -> Schematic Monad t u b) -> (a -> (:>) t u b) -> a -> Schematic Monad t u b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . a -> (:>) t u b f instance Bindable (Schematic Monad t u) => Bindable (t :> u) where TM Schematic Monad t u a x >>= :: (:>) t u a -> (a -> (:>) t u b) -> (:>) t u b >>= a -> (:>) t u b f = Schematic Monad t u b -> (:>) t u b forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM (Schematic Monad t u b -> (:>) t u b) -> Schematic Monad t u b -> (:>) t u b forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ Schematic Monad t u a x Schematic Monad t u a -> (a -> Schematic Monad t u b) -> Schematic Monad t u b forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b >>= (:>) t u b -> Schematic Monad t u b forall (t :: * -> *) (u :: * -> *) a. (:>) t u a -> Schematic Monad t u a tm ((:>) t u b -> Schematic Monad t u b) -> (a -> (:>) t u b) -> a -> Schematic Monad t u b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . a -> (:>) t u b f instance Extendable (Schematic Monad t u) => Extendable (t :> u) where TM Schematic Monad t u a x =>> :: (:>) t u a -> ((:>) t u a -> b) -> (:>) t u b =>> (:>) t u a -> b f = Schematic Monad t u b -> (:>) t u b forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM (Schematic Monad t u b -> (:>) t u b) -> Schematic Monad t u b -> (:>) t u b forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ Schematic Monad t u a x Schematic Monad t u a -> (Schematic Monad t u a -> b) -> Schematic Monad t u b forall (t :: * -> *) a b. Extendable t => t a -> (t a -> b) -> t b =>> (:>) t u a -> b f ((:>) t u a -> b) -> (Schematic Monad t u a -> (:>) t u a) -> Schematic Monad t u a -> b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . Schematic Monad t u a -> (:>) t u a forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM instance (Pointable (t :> u), Bindable (t :> u)) => Monad (t :> u) where instance Liftable (Schematic Monad t) => Liftable ((:>) t) where lift :: u ~> (t :> u) lift = Schematic Monad t u a -> (:>) t u a forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM (Schematic Monad t u a -> (:>) t u a) -> (u a -> Schematic Monad t u a) -> u a -> (:>) t u a forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . u a -> Schematic Monad t u a forall (t :: (* -> *) -> * -> *) (u :: * -> *). (Liftable t, Covariant u) => u ~> t u lift instance Hoistable (Schematic Monad t) => Hoistable ((:>) t) where hoist :: (u ~> v) -> (t :> u) ~> (t :> v) hoist u ~> v f (TM Schematic Monad t u a x) = Schematic Monad t v a -> (:>) t v a forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM (Schematic Monad t v a -> (:>) t v a) -> Schematic Monad t v a -> (:>) t v a forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ (u ~> v) -> Schematic Monad t u a -> Schematic Monad t v a forall k (t :: (* -> *) -> k -> *) (u :: * -> *) (v :: * -> *). (Hoistable t, Covariant u) => (u ~> v) -> t u ~> t v hoist u ~> v f Schematic Monad t u a x instance (Interpreted (Schematic Monad t u)) => Interpreted (t :> u) where type Primary (t :> u) a = Primary (Schematic Monad t u) a run :: (:>) t u a -> Primary (t :> u) a run ~(TM Schematic Monad t u a x) = Schematic Monad t u a -> Primary (Schematic Monad t u) a forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run Schematic Monad t u a x unite :: Primary (t :> u) a -> (:>) t u a unite = Schematic Monad t u a -> (:>) t u a forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM (Schematic Monad t u a -> (:>) t u a) -> (Primary (Schematic Monad t u) a -> Schematic Monad t u a) -> Primary (Schematic Monad t u) a -> (:>) t u a forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . Primary (Schematic Monad t u) a -> Schematic Monad t u a forall (t :: * -> *) a. Interpreted t => Primary t a -> t a unite