{-# 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