{-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Controlflow.Effect.Transformer.Monadic (Monadic (..), (:>) (..)) where import Pandora.Core.Functor (type (~>)) import Pandora.Pattern.Semigroupoid ((.)) 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.Semimonoidal (Semimonoidal (multiply_)) 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 ((/|\))) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:)((:*:))) 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 (m a b) (m a b) $ a -> b f (a -> b) -> Schematic Monad t u a -> Schematic Monad t u b forall (t :: * -> *) (source :: * -> * -> *) (target :: * -> * -> *) a b. Covariant t source target => source a b -> target (t a) (t b) -<$>- Schematic Monad t u a x instance Pointable (Schematic Monad t u) (->) => Pointable (t :> u) (->) where point :: a -> (:>) t u a 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 a forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . a -> Schematic Monad t u a forall (t :: * -> *) (source :: * -> * -> *) a. Pointable t source => source a (t a) point instance Extractable (Schematic Monad t u) (->) => Extractable (t :> u) (->) where extract :: (:>) t u a -> a extract = Schematic Monad t u a -> a forall (t :: * -> *) (source :: * -> * -> *) a. Extractable t source => source (t a) a extract (Schematic Monad t u a -> a) -> ((:>) t u a -> Schematic Monad t u a) -> (:>) t u a -> a forall (m :: * -> * -> *) b c a. Semigroupoid 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 Semimonoidal (Schematic Monad t u) (->) (:*:) (:*:) => Semimonoidal (t :> u) (->) (:*:) (:*:) where multiply_ :: ((:>) t u a :*: (:>) t u b) -> (:>) t u (a :*: b) multiply_ (TM Schematic Monad t u a f :*: TM Schematic Monad t u b x) = Schematic Monad t u (a :*: b) -> (:>) t u (a :*: b) forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM (Schematic Monad t u (a :*: b) -> (:>) t u (a :*: b)) -> Schematic Monad t u (a :*: b) -> (:>) t u (a :*: b) forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ (Schematic Monad t u a :*: Schematic Monad t u b) -> Schematic Monad t u (a :*: b) forall k (t :: k -> *) (p :: * -> * -> *) (source :: * -> * -> *) (target :: k -> k -> k) (a :: k) (b :: k). Semimonoidal t p source target => p (source (t a) (t b)) (t (target a b)) multiply_ ((Schematic Monad t u a :*: Schematic Monad t u b) -> Schematic Monad t u (a :*: b)) -> (Schematic Monad t u a :*: Schematic Monad t u b) -> Schematic Monad t u (a :*: b) forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ Schematic Monad t u a f Schematic Monad t u a -> Schematic Monad t u b -> Schematic Monad t u a :*: Schematic Monad t u b forall s a. s -> a -> s :*: a :*: Schematic Monad t u b x instance Traversable (Schematic Monad t u) (->) (->) => Traversable (t :> u) (->) (->) where a -> u b f <<- :: (a -> u b) -> (:>) t u a -> u ((:>) 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) -> u (Schematic Monad t u b) -> u ((:>) t u b) forall (t :: * -> *) (source :: * -> * -> *) (target :: * -> * -> *) a b. Covariant t source target => source a b -> target (t a) (t b) -<$>- a -> u b f (a -> u b) -> Schematic Monad t u a -> u (Schematic Monad t u b) forall (t :: * -> *) (source :: * -> * -> *) (target :: * -> * -> *) (u :: * -> *) a b. (Traversable t source target, Covariant u source target, Pointable u target, Semimonoidal u target (:*:) (:*:)) => source a (u b) -> target (t a) (u (t b)) <<- Schematic Monad t u a x instance Distributive (Schematic Monad t u) (->) (->) => Distributive (t :> u) (->) (->) where a -> (:>) t u b f -<< :: (a -> (:>) t u b) -> u a -> (:>) t u (u b) -<< u a x = 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 (m a b) (m a 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. Semigroupoid m => m b c -> m a b -> m a c . a -> (:>) t u b f (a -> Schematic Monad t u b) -> u a -> Schematic Monad t u (u b) forall (t :: * -> *) (source :: * -> * -> *) (target :: * -> * -> *) (u :: * -> *) a b. (Distributive t source target, Covariant u source target) => source a (t b) -> target (u a) (t (u b)) -<< u a x instance Bindable (Schematic Monad t u) (->) => Bindable (t :> u) (->) where a -> (:>) t u b f =<< :: (a -> (:>) t u 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 (m a b) (m a 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. Semigroupoid m => m b c -> m a b -> m a c . a -> (:>) t u b f (a -> Schematic Monad t u b) -> Schematic Monad t u a -> Schematic Monad t u b forall (t :: * -> *) (source :: * -> * -> *) a b. Bindable t source => source a (t b) -> source (t a) (t b) =<< Schematic Monad t u a x instance Extendable (Schematic Monad t u) (->) => Extendable (t :> u) (->) where (:>) 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 (m a b) (m a 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. Semigroupoid 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 (Schematic Monad t u a -> b) -> Schematic Monad t u a -> Schematic Monad t u b forall (t :: * -> *) (source :: * -> * -> *) a b. Extendable t source => source (t a) b -> source (t a) (t b) <<= Schematic Monad t u a x instance (Covariant (Schematic Monad t u) (->) (->), 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. Semigroupoid 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 u ~> v f /|\ :: (u ~> v) -> (t :> u) ~> (t :> v) /|\ 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 (m a b) (m a b) $ u ~> v f (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 /|\ 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. Semigroupoid 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