{-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Inventory.Imprint (Imprint (..), Traceable) where import Pandora.Pattern.Category ((.), ($)) import Pandora.Pattern.Functor.Covariant (Covariant ((<$>))) import Pandora.Pattern.Functor.Extractable (Extractable (extract)) import Pandora.Pattern.Functor.Distributive (Distributive ((>>-))) import Pandora.Pattern.Functor.Extendable (Extendable ((=>>))) import Pandora.Pattern.Functor.Comonad (Comonad) import Pandora.Pattern.Object.Monoid (Monoid (zero)) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Paradigm.Primary.Functor.Function () import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite)) import Pandora.Paradigm.Controlflow.Effect.Transformer.Comonadic (Comonadic (bring), (:<) (TC)) import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable) import Pandora.Paradigm.Schemes.UT (UT (UT), type (<.:>)) newtype Imprint e a = Imprint (e -> a) instance Covariant (Imprint e) where a -> b f <$> :: (a -> b) -> Imprint e a -> Imprint e b <$> Imprint e -> a x = (e -> b) -> Imprint e b forall e a. (e -> a) -> Imprint e a Imprint ((e -> b) -> Imprint e b) -> (e -> b) -> Imprint e b forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ a -> b f (a -> b) -> (e -> a) -> e -> b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . e -> a x instance Distributive (Imprint e) where u a g >>- :: u a -> (a -> Imprint e b) -> (Imprint e :. u) := b >>- a -> Imprint e b f = (e -> u b) -> (Imprint e :. u) := b forall e a. (e -> a) -> Imprint e a Imprint ((e -> u b) -> (Imprint e :. u) := b) -> (e -> u b) -> (Imprint e :. u) := b forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ u a g u a -> (a -> e -> b) -> e -> u b forall (t :: * -> *) (u :: * -> *) a b. (Distributive t, Covariant u) => u a -> (a -> t b) -> (t :. u) := b >>- (Imprint e b -> e -> b forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run (Imprint e b -> e -> b) -> (a -> Imprint e b) -> a -> e -> b forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b <$> a -> Imprint e b f) instance Monoid e => Extractable (Imprint e) where extract :: a <-| Imprint e extract (Imprint e -> a x) = e -> a x e forall a. Monoid a => a zero instance Semigroup e => Extendable (Imprint e) where Imprint e -> a x =>> :: Imprint e a -> (Imprint e a -> b) -> Imprint e b =>> Imprint e a -> b f = (e -> b) -> Imprint e b forall e a. (e -> a) -> Imprint e a Imprint ((e -> b) -> Imprint e b) -> (e -> b) -> Imprint e b forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ \e e -> Imprint e a -> b f (Imprint e a -> b) -> Imprint e a -> b forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ (e -> a) -> Imprint e a forall e a. (e -> a) -> Imprint e a Imprint ((e -> a) -> Imprint e a) -> (e -> a) -> Imprint e a forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ e -> a x (e -> a) -> (e -> e) -> e -> a forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . (e e e -> e -> e forall a. Semigroup a => a -> a -> a +) instance Interpreted (Imprint e) where type Primary (Imprint e) a = (->) e a run :: Imprint e a -> Primary (Imprint e) a run ~(Imprint e -> a x) = Primary (Imprint e) a e -> a x unite :: Primary (Imprint e) a -> Imprint e a unite = Primary (Imprint e) a -> Imprint e a forall e a. (e -> a) -> Imprint e a Imprint type instance Schematic Comonad (Imprint e) = (<.:>) ((->) e) instance Monoid e => Comonadic (Imprint e) where bring :: (Imprint e :< u) ~> Imprint e bring (TC (UT x)) = (e -> a) -> Imprint e a forall e a. (e -> a) -> Imprint e a Imprint ((e -> a) -> Imprint e a) -> (u (e -> a) -> e -> a) -> u (e -> a) -> Imprint e a forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . u (e -> a) -> e -> a forall (t :: * -> *) a. Extractable t => a <-| t extract (u (e -> a) -> Imprint e a) -> u (e -> a) -> Imprint e a forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ u (e -> a) x instance {-# OVERLAPS #-} (Semigroup e, Extendable u) => Extendable ((->) e <.:> u) where UT (u :. (->) e) := a x =>> :: (<.:>) ((->) e) u a -> ((<.:>) ((->) e) u a -> b) -> (<.:>) ((->) e) u b =>> (<.:>) ((->) e) u a -> b f = ((u :. (->) e) := b) -> (<.:>) ((->) e) u b forall k k k k (ct :: k) (cu :: k) (t :: k -> k) (u :: k -> *) (a :: k). ((u :. t) := a) -> UT ct cu t u a UT (((u :. (->) e) := b) -> (<.:>) ((->) e) u b) -> ((u :. (->) e) := b) -> (<.:>) ((->) e) u b forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ (u :. (->) e) := a x ((u :. (->) e) := a) -> (((u :. (->) e) := a) -> e -> b) -> (u :. (->) e) := b forall (t :: * -> *) a b. Extendable t => t a -> (t a -> b) -> t b =>> (\(u :. (->) e) := a x' e e -> (<.:>) ((->) e) u a -> b f ((<.:>) ((->) e) u a -> b) -> (((u :. (->) e) := a) -> (<.:>) ((->) e) u a) -> ((u :. (->) e) := a) -> b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . ((u :. (->) e) := a) -> (<.:>) ((->) e) u a forall k k k k (ct :: k) (cu :: k) (t :: k -> k) (u :: k -> *) (a :: k). ((u :. t) := a) -> UT ct cu t u a UT (((u :. (->) e) := a) -> (<.:>) ((->) e) u a) -> (((u :. (->) e) := a) -> (u :. (->) e) := a) -> ((u :. (->) e) := a) -> (<.:>) ((->) e) u a forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . ((e -> a) -> e -> a) -> ((u :. (->) e) := a) -> (u :. (->) e) := a forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b (<$>) ((e -> a) -> (e -> e) -> e -> a forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . (e e e -> e -> e forall a. Semigroup a => a -> a -> a +)) (((u :. (->) e) := a) -> b) -> ((u :. (->) e) := a) -> b forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ (u :. (->) e) := a x') type Traceable e t = Adaptable t (Imprint e)