{-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Inventory.Imprint (Imprint (..), Traceable) where import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($)) import Pandora.Pattern.Functor.Covariant (Covariant ((<$>))) import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<))) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=))) import Pandora.Pattern.Functor.Comonad (Comonad) import Pandora.Pattern.Functor.Divariant (Divariant ((>->))) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Paradigm.Primary.Algebraic.Exponential () import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite, (||=))) 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 g = (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 (m a b) (m a b) $ a -> b f (a -> b) -> (e -> a) -> e -> b forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . e -> a g instance Contravariant (->) (->) (Flip Imprint a) where a -> b f >$< :: (a -> b) -> Flip Imprint a b -> Flip Imprint a a >$< Flip (Imprint b -> a g) = Imprint a a -> Flip Imprint a a forall (v :: * -> * -> *) a e. v e a -> Flip v a e Flip (Imprint a a -> Flip Imprint a a) -> ((a -> a) -> Imprint a a) -> (a -> a) -> Flip Imprint a a forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . (a -> a) -> Imprint a a forall e a. (e -> a) -> Imprint e a Imprint ((a -> a) -> Flip Imprint a a) -> (a -> a) -> Flip Imprint a a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ b -> a g (b -> a) -> (a -> b) -> a -> a forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . a -> b f instance Distributive (->) (->) (Imprint e) where a -> Imprint e b f -<< :: (a -> Imprint e b) -> u a -> Imprint e (u b) -<< u a g = (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 (m a b) (m a b) $ (forall (t :: * -> *) a. Interpreted (->) t => t a -> Primary t a forall (m :: * -> * -> *) (t :: * -> *) a. Interpreted m t => m (t a) (Primary t a) run @(->) (Imprint e b -> e -> b) -> (a -> Imprint e b) -> a -> e -> b forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) <$> a -> Imprint e b f) (a -> e -> b) -> u a -> e -> u b forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) (u :: * -> *) a b. (Distributive source target t, Covariant source target u) => source a (t b) -> target (u a) (t (u b)) -<< u a g instance Divariant (->) (->) (->) Imprint where >-> :: (a -> b) -> (c -> d) -> Imprint b c -> Imprint a d (>->) a -> b ab c -> d cd Imprint b c bc = a -> b ab (a -> b) -> (c -> d) -> (b -> c) -> a -> d forall (left :: * -> * -> *) (right :: * -> * -> *) (target :: * -> * -> *) (v :: * -> * -> *) a b c d. Divariant left right target v => left a b -> right c d -> target (v b c) (v a d) >-> c -> d cd (Primary (Imprint b) c -> Primary (Imprint a) d) -> Imprint b c -> Imprint a d forall (m :: * -> * -> *) (t :: * -> *) (u :: * -> *) a b. (Interpreted m t, Semigroupoid m, Interpreted m u) => m (Primary t a) (Primary u b) -> m (t a) (u b) ||= Imprint b c bc instance Semigroup e => Extendable (->) (Imprint e) where Imprint e a -> b f <<= :: (Imprint e 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 (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 (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 (m a b) (m a b) $ e -> a x (e -> a) -> (e -> e) -> e -> a forall (m :: * -> * -> *) b c a. Semigroupoid 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 {-# OVERLAPS #-} (Semigroup e, Extendable (->) u) => Extendable (->) ((->) e <.:> u) where (<.:>) ((->) e) u a -> b f <<= :: ((<.:>) ((->) e) u a -> b) -> (<.:>) ((->) e) u a -> (<.:>) ((->) e) u b <<= UT (u :. (->) e) := a x = ((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 (m a b) (m a 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. Semigroupoid 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. Semigroupoid m => m b c -> m a b -> m a c . ((e -> a) -> e -> a) -> ((u :. (->) e) := a) -> (u :. (->) e) := a forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) (<$>) ((e -> a) -> (e -> e) -> e -> a forall (m :: * -> * -> *) b c a. Semigroupoid 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 (m a b) (m a b) $ (u :. (->) e) := a x') (((u :. (->) e) := a) -> e -> b) -> ((u :. (->) e) := a) -> (u :. (->) e) := b forall (source :: * -> * -> *) (t :: * -> *) a b. Extendable source t => source (t a) b -> source (t a) (t b) <<= (u :. (->) e) := a x type Traceable e t = Adaptable t (Imprint e)