{-# OPTIONS_GHC -fno-warn-orphans #-}

module Pandora.Paradigm.Inventory.Environment (Environment (..), Configured, env) where

import Pandora.Pattern.Category (identity, (.), ($))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), Covariant_ ((-<$>-)))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
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.Functor.Function ((!.), (%))
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.
Category m =>
m b c -> m a b -> m a c
. e -> a
x

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.
Category m =>
m b c -> m a b -> m a c
. e -> a
x

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 Applicative (Environment e) where
	Environment e (a -> b)
f <*> :: Environment e (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)
$ Environment e (a -> b) -> Primary (Environment e) (a -> b)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run Environment e (a -> b)
f (e -> a -> b) -> (e -> a) -> e -> b
forall (t :: * -> *) a b. Applicative t => t (a -> b) -> 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

instance Distributive (Environment e) where
	u a
g >>- :: u a -> (a -> Environment e b) -> (Environment e :. u) := b
>>- a -> Environment e b
f = (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)
$ 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
>>- (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 :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> a -> Environment e b
f)

instance Bindable (Environment e) where
	Environment e -> a
x >>= :: Environment e a -> (a -> Environment e b) -> Environment e b
>>= a -> Environment e b
f = (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.
Category 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.
Category 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 :: * -> * -> *) a b c d.
Divariant v =>
(a -> b) -> (c -> d) -> 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.
Category 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)
$ 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 :: * -> *) a b. Covariant t => (a -> b) -> 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