{-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Inventory.Environment (Environment (..), Configured, env) where 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.Pointable (Pointable (point)) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (multiply_)) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Monad (Monad) import Pandora.Pattern.Functor.Divariant (Divariant ((>->))) import Pandora.Paradigm.Primary.Algebraic.Exponential ((!.), (%)) import Pandora.Paradigm.Primary.Algebraic () import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Primary.Transformer.Flip (Flip (Flip)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite)) import Pandora.Paradigm.Controlflow.Effect.Transformer.Monadic (Monadic (wrap), (:>) (TM)) import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable (adapt)) import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>)) newtype Environment e a = Environment (e -> a) instance Covariant (Environment e) (->) (->) where a -> b f -<$>- :: (a -> b) -> Environment e a -> Environment e b -<$>- Environment e -> a x = (e -> b) -> Environment e b forall e a. (e -> a) -> Environment e a Environment ((e -> b) -> Environment e b) -> (e -> b) -> Environment 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 Environment a) (->) (->) where a -> b f ->$<- :: (a -> b) -> Flip Environment a b -> Flip Environment a a ->$<- Flip (Environment b -> a g) = Environment a a -> Flip Environment a a forall (v :: * -> * -> *) a e. v e a -> Flip v a e Flip (Environment a a -> Flip Environment a a) -> ((a -> a) -> Environment a a) -> (a -> a) -> Flip Environment a a forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . (a -> a) -> Environment a a forall e a. (e -> a) -> Environment e a Environment ((a -> a) -> Flip Environment a a) -> (a -> a) -> Flip Environment 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 Pointable (Environment e) (->) where point :: a -> Environment e a point a x = (e -> a) -> Environment e a forall e a. (e -> a) -> Environment e a Environment (a x a -> e -> a forall a b. a -> b -> a !.) instance Semimonoidal (Environment e) (->) (:*:) (:*:) where multiply_ :: (Environment e a :*: Environment e b) -> Environment e (a :*: b) multiply_ (Environment e a x :*: Environment e b y) = (e -> a :*: b) -> Environment e (a :*: b) forall (t :: * -> *) a. Interpreted t => Primary t a -> t a unite ((e -> a :*: b) -> Environment e (a :*: b)) -> (e -> a :*: b) -> Environment e (a :*: b) forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ ((e -> a) :*: (e -> b)) -> e -> 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_ (((e -> a) :*: (e -> b)) -> e -> a :*: b) -> ((e -> a) :*: (e -> b)) -> e -> a :*: b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ Environment e a -> Primary (Environment e) a forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run Environment e a x (e -> a) -> (e -> b) -> (e -> a) :*: (e -> b) forall s a. s -> a -> s :*: a :*: Environment e b -> Primary (Environment e) b forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run Environment e b y instance Distributive (Environment e) (->) (->) where a -> Environment e b f -<< :: (a -> Environment e b) -> u a -> Environment e (u b) -<< u a g = (e -> u b) -> Environment e (u b) forall e a. (e -> a) -> Environment e a Environment ((e -> u b) -> Environment e (u b)) -> (e -> u b) -> Environment e (u b) forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ (Environment e b -> e -> b forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run (Environment e b -> e -> b) -> (a -> Environment e b) -> a -> e -> b forall (t :: * -> *) (source :: * -> * -> *) (target :: * -> * -> *) a b. Covariant t source target => source a b -> target (t a) (t b) -<$>- a -> Environment e b f) (a -> e -> b) -> u a -> e -> 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 g instance Bindable (Environment e) (->) where a -> Environment e b f =<< :: (a -> Environment e b) -> Environment e a -> Environment e b =<< Environment e -> a x = (e -> b) -> Environment e b forall e a. (e -> a) -> Environment e a Environment ((e -> b) -> Environment e b) -> (e -> b) -> Environment e b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ \e e -> (Environment e b -> e -> b forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run (Environment e b -> e -> b) -> e -> Environment e b -> b forall a b c. (a -> b -> c) -> b -> a -> c % e e) (Environment e b -> b) -> (e -> Environment e b) -> e -> b forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . a -> Environment e b f (a -> Environment e b) -> (e -> a) -> e -> Environment 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 (Environment e) where instance Divariant Environment (->) (->) (->) where >-> :: (a -> b) -> (c -> d) -> Environment b c -> Environment a d (>->) a -> b ab c -> d cd Environment b c bc = (a -> d) -> Environment a d forall e a. (e -> a) -> Environment e a Environment ((a -> d) -> Environment a d) -> (a -> d) -> Environment a d forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ a -> b ab (a -> b) -> (c -> d) -> (b -> c) -> a -> d forall (v :: * -> * -> *) (left :: * -> * -> *) (right :: * -> * -> *) (target :: * -> * -> *) a b c d. Divariant v left right target => left a b -> right c d -> target (v b c) (v a d) >-> c -> d cd ((b -> c) -> a -> d) -> (b -> c) -> a -> d forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ Environment b c -> Primary (Environment b) c forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run Environment b c bc instance Interpreted (Environment e) where type Primary (Environment e) a = (->) e a run :: Environment e a -> Primary (Environment e) a run ~(Environment e -> a x) = Primary (Environment e) a e -> a x unite :: Primary (Environment e) a -> Environment e a unite = Primary (Environment e) a -> Environment e a forall e a. (e -> a) -> Environment e a Environment type instance Schematic Monad (Environment e) = (<:.>) ((->) e) instance Monadic (Environment e) where wrap :: Environment e ~> (Environment e :> u) wrap Environment e a x = (<:.>) ((->) e) u a -> (:>) (Environment e) u a forall (t :: * -> *) (u :: * -> *) a. Schematic Monad t u a -> (:>) t u a TM ((<:.>) ((->) e) u a -> (:>) (Environment e) u a) -> ((((->) e :. u) := a) -> (<:.>) ((->) e) u a) -> (((->) e :. u) := a) -> (:>) (Environment 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) -> (:>) (Environment e) u a) -> (((->) e :. u) := a) -> (:>) (Environment e) u a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ forall a. Pointable u (->) => a -> u a forall (t :: * -> *) (source :: * -> * -> *) a. Pointable t source => source a (t a) point @_ @(->) (a -> u a) -> (e -> a) -> ((->) e :. u) := a forall (t :: * -> *) (source :: * -> * -> *) (target :: * -> * -> *) a b. Covariant t source target => source a b -> target (t a) (t b) -<$>- Environment e a -> Primary (Environment e) a forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run Environment e a x type Configured e = Adaptable (Environment e) env :: Configured e t => t e env :: t e env = Environment e e -> t e forall k (t :: k -> *) (u :: k -> *). Adaptable t u => t ~> u adapt (Environment e e -> t e) -> Environment e e -> t e forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ (e -> e) -> Environment e e forall e a. (e -> a) -> Environment e a Environment e -> e forall (m :: * -> * -> *) a. Category m => m a a identity