{-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Inventory.Some.Provision where import Pandora.Core.Interpreted (Interpreted (Primary, run, unite, (<~))) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (identity, (<--), (<---), (<----)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Monad (Monad) import Pandora.Paradigm.Algebraic.Exponential (type (-->), (%)) import Pandora.Paradigm.Algebraic ((<-||-)) import Pandora.Paradigm.Algebraic.Product ((:*:)) import Pandora.Paradigm.Algebraic.One (One (One)) import Pandora.Paradigm.Algebraic (point) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Paradigm.Controlflow.Effect.Transformer.Monadic (Monadic (wrap), (:>) (TM)) import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable (adapt)) import Pandora.Paradigm.Inventory.Ability.Gettable (Gettable (Getting, get)) import Pandora.Paradigm.Schemes (Schematic, TU (TU), type (<:.>)) newtype Provision e a = Provision (e -> a) instance Covariant (->) (->) (Provision e) where a -> b f <-|- :: (a -> b) -> Provision e a -> Provision e b <-|- Provision e -> a x = (e -> b) -> Provision e b forall e a. (e -> a) -> Provision e a Provision ((e -> b) -> Provision e b) -> (e -> b) -> Provision 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 x instance Contravariant (->) (->) (Flip Provision a) where a -> b f >-|- :: (a -> b) -> Flip Provision a b -> Flip Provision a a >-|- Flip (Provision b -> a g) = Provision a a -> Flip Provision a a forall (v :: * -> * -> *) a e. v e a -> Flip v a e Flip (Provision a a -> Flip Provision a a) -> ((a -> a) -> Provision a a) -> (a -> a) -> Flip Provision a a forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . (a -> a) -> Provision a a forall e a. (e -> a) -> Provision e a Provision ((a -> a) -> Flip Provision a a) -> (a -> a) -> Flip Provision 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 Semimonoidal (-->) (:*:) (:*:) (Provision e) where mult :: (Provision e a :*: Provision e b) --> Provision e (a :*: b) mult = ((Provision e a :*: Provision e b) -> Provision e (a :*: b)) -> (Provision e a :*: Provision e b) --> Provision e (a :*: b) forall (v :: * -> * -> *) a e. v a e -> Straight v a e Straight (((Provision e a :*: Provision e b) -> Provision e (a :*: b)) -> (Provision e a :*: Provision e b) --> Provision e (a :*: b)) -> ((Provision e a :*: Provision e b) -> Provision e (a :*: b)) -> (Provision e a :*: Provision e b) --> Provision e (a :*: b) forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- (e -> a :*: b) -> Provision e (a :*: b) forall e a. (e -> a) -> Provision e a Provision ((e -> a :*: b) -> Provision e (a :*: b)) -> ((Provision e a :*: Provision e b) -> e -> a :*: b) -> (Provision e a :*: Provision e b) -> Provision e (a :*: b) forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . (forall k (p :: * -> * -> *) (source :: * -> * -> *) (target :: k -> k -> k) (t :: k -> *) (a :: k) (b :: k). Semimonoidal p source target t => p (source (t a) (t b)) (t (target a b)) forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Semimonoidal (-->) source target t => source (t a) (t b) --> t (target a b) mult @(-->) (((e -> a) :*: (e -> b)) --> (e -> a :*: b)) -> ((e -> a) :*: (e -> b)) -> e -> a :*: b forall (m :: * -> * -> *) (t :: * -> *) a. Interpreted m t => (m < t a) < Primary t a <~) (((e -> a) :*: (e -> b)) -> e -> a :*: b) -> ((Provision e a :*: Provision e b) -> (e -> a) :*: (e -> b)) -> (Provision e a :*: Provision e b) -> e -> a :*: b forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . (Provision e a -> e -> a forall (m :: * -> * -> *) (t :: * -> *) a. Interpreted m t => (m < t a) < Primary t a run (Provision e a -> e -> a) -> (Provision e a :*: (e -> b)) -> (e -> a) :*: (e -> b) forall (m :: * -> * -> *) (p :: * -> * -> *) a b c. (Covariant m m (Flip p c), Interpreted m (Flip p c)) => m a b -> m (p a c) (p b c) <-||-) ((Provision e a :*: (e -> b)) -> (e -> a) :*: (e -> b)) -> ((Provision e a :*: Provision e b) -> Provision e a :*: (e -> b)) -> (Provision e a :*: Provision e b) -> (e -> a) :*: (e -> b) forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . (forall (t :: * -> *) a. Interpreted (->) t => ((->) < t a) < Primary t a forall (m :: * -> * -> *) (t :: * -> *) a. Interpreted m t => (m < t a) < Primary t a run @(->) (Provision e b -> e -> b) -> (Provision e a :*: Provision e b) -> Provision e a :*: (e -> b) forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) <-|-) instance Monoidal (-->) (-->) (:*:) (:*:) (Provision e) where unit :: Proxy (:*:) -> (Unit (:*:) --> a) --> Provision e a unit Proxy (:*:) _ = (Straight (->) One a -> Provision e a) -> Straight (->) (Straight (->) One a) (Provision e a) forall (v :: * -> * -> *) a e. v a e -> Straight v a e Straight ((Straight (->) One a -> Provision e a) -> Straight (->) (Straight (->) One a) (Provision e a)) -> (Straight (->) One a -> Provision e a) -> Straight (->) (Straight (->) One a) (Provision e a) forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- \Straight (->) One a f -> (e -> a) -> Provision e a forall e a. (e -> a) -> Provision e a Provision ((e -> a) -> Provision e a) -> (e -> a) -> Provision e a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- \e _ -> Straight (->) One a -> One -> a forall (m :: * -> * -> *) (t :: * -> *) a. Interpreted m t => (m < t a) < Primary t a run Straight (->) One a f One One instance Distributive (->) (->) (Provision e) where a -> Provision e b f -<< :: (a -> Provision e b) -> u a -> Provision e (u b) -<< u a g = (e -> u b) -> Provision e (u b) forall e a. (e -> a) -> Provision e a Provision ((e -> u b) -> Provision e (u b)) -> (e -> u b) -> Provision 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 @(->) (Provision e b -> e -> b) -> (a -> Provision e b) -> a -> e -> b forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) <-|- a -> Provision 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 Bindable (->) (Provision e) where a -> Provision e b f =<< :: (a -> Provision e b) -> Provision e a -> Provision e b =<< Provision e -> a x = (e -> b) -> Provision e b forall e a. (e -> a) -> Provision e a Provision ((e -> b) -> Provision e b) -> (e -> b) -> Provision e b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- \e e -> (Provision e b -> e -> b forall (m :: * -> * -> *) (t :: * -> *) a. Interpreted m t => (m < t a) < Primary t a run (Provision e b -> e -> b) -> e -> Provision e b -> b forall a b c. (a -> b -> c) -> b -> a -> c % e e) (Provision e b -> b) -> (e -> Provision e b) -> e -> b forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . a -> Provision e b f (a -> Provision e b) -> (e -> a) -> e -> Provision e b forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . e -> a x (e -> b) -> e -> b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- e e instance Monad (->) (Provision e) where instance Interpreted (->) (Provision e) where type Primary (Provision e) a = (->) e a run :: ((->) < Provision e a) < Primary (Provision e) a run ~(Provision e -> a x) = Primary (Provision e) a e -> a x unite :: ((->) < Primary (Provision e) a) < Provision e a unite = ((->) < Primary (Provision e) a) < Provision e a forall e a. (e -> a) -> Provision e a Provision type instance Schematic Monad (Provision e) = (<:.>) ((->) e) instance Monadic (->) (Provision e) where wrap :: ((->) < Provision e a) < (:>) (Provision e) u a wrap Provision e a x = (<:.>) ((->) e) u a -> (:>) (Provision e) u a forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM ((<:.>) ((->) e) u a -> (:>) (Provision e) u a) -> ((((->) e :. u) >>> a) -> (<:.>) ((->) e) u a) -> (((->) e :. u) >>> a) -> (:>) (Provision e) u a forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . (((->) e :. u) >>> a) -> (<:.>) ((->) e) u a forall k k k k (ct :: k) (cu :: k) (t :: k -> *) (u :: k -> k) (a :: k). ((t :. u) >>> a) -> TU ct cu t u a TU ((((->) e :. u) >>> a) -> (:>) (Provision e) u a) -> (((->) e :. u) >>> a) -> (:>) (Provision e) u a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <---- a -> u a forall (t :: * -> *) a. Pointable t => a -> t a point (a -> u a) -> (e -> a) -> ((->) e :. u) >>> a forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) <-|- Provision e a -> e -> a forall (m :: * -> * -> *) (t :: * -> *) a. Interpreted m t => (m < t a) < Primary t a run Provision e a x type Provided e t = Adaptable t (->) (Provision e) provided :: Provided e t => t e provided :: t e provided = ((->) < Provision e e) < t e forall k k k (u :: k -> k) (m :: k -> k -> *) (t :: k -> k) (a :: k). Adaptable u m t => (m < t a) < u a adapt (((->) < Provision e e) < t e) -> ((->) < Provision e e) < t e forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- (e -> e) -> Provision e e forall e a. (e -> a) -> Provision e a Provision e -> e forall (m :: * -> * -> *) a. Category m => m a a identity instance Gettable Provision where type Getting Provision p ouput = Provision p p get :: Getting Provision e r get = (e -> e) -> Provision e e forall e a. (e -> a) -> Provision e a Provision e -> e forall (m :: * -> * -> *) a. Category m => m a a identity