{-# OPTIONS_GHC -fno-warn-orphans #-}
module Pandora.Paradigm.Inventory.Some.Equipment (Equipment (..), retrieve) where

import Pandora.Core.Interpreted (Interpreted (Primary, run, unite))
import Pandora.Pattern.Semigroupoid ((.))
import Pandora.Pattern.Category ((<---), (<----))
import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|--)))
import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-)))
import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))
import Pandora.Pattern.Functor.Comonad (Comonad)
import Pandora.Paradigm.Algebraic ()
import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)), attached)
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 Equipment e a = Equipment (e :*: a)

instance Covariant (->) (->) (Equipment e) where
	a -> b
f <-|- :: (a -> b) -> Equipment e a -> Equipment e b
<-|- Equipment e :*: a
x = (e :*: b) -> Equipment e b
forall e a. (e :*: a) -> Equipment e a
Equipment ((e :*: b) -> Equipment e b) -> (e :*: b) -> Equipment 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 (source :: * -> * -> *) (target :: * -> * -> *)
       (t :: * -> *) a b.
Covariant source target t =>
source a b -> target (t a) (t b)
<-|- e :*: a
x

instance Traversable (->) (->) (Equipment e) where
	a -> u b
f <-/- :: (a -> u b) -> Equipment e a -> u (Equipment e b)
<-/- Equipment e :*: a
x = (e :*: b) -> Equipment e b
forall e a. (e :*: a) -> Equipment e a
Equipment ((e :*: b) -> Equipment e b) -> u (e :*: b) -> u (Equipment e b)
forall (source :: * -> * -> *) (target :: * -> * -> *)
       (t :: * -> *) a b.
Covariant source target t =>
source a b -> target (t a) (t b)
<-|-- a -> u b
f (a -> u b) -> (e :*: a) -> u (e :*: b)
forall (source :: * -> * -> *) (target :: * -> * -> *)
       (t :: * -> *) (u :: * -> *) a b.
(Traversable source target t, Covariant source target u,
 Monoidal (Straight source) (Straight target) (:*:) (:*:) u) =>
source a (u b) -> target (t a) (u (t b))
<-/- e :*: a
x

instance Extendable (->) (Equipment e) where
	Equipment e a -> b
f <<= :: (Equipment e a -> b) -> Equipment e a -> Equipment e b
<<= Equipment (e
e :*: a
x) = (e :*: b) -> Equipment e b
forall e a. (e :*: a) -> Equipment e a
Equipment ((e :*: b) -> Equipment e b)
-> ((e :*: a) -> e :*: b) -> (e :*: a) -> Equipment e b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. e -> b -> e :*: b
forall s a. s -> a -> s :*: a
(:*:) e
e (b -> e :*: b) -> ((e :*: a) -> b) -> (e :*: a) -> e :*: b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Equipment e a -> b
f (Equipment e a -> b)
-> ((e :*: a) -> Equipment e a) -> (e :*: a) -> b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (e :*: a) -> Equipment e a
forall e a. (e :*: a) -> Equipment e a
Equipment ((e :*: a) -> Equipment e b) -> (e :*: a) -> Equipment e b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<---- e
e e -> a -> e :*: a
forall s a. s -> a -> s :*: a
:*: a
x

instance Interpreted (->) (Equipment e) where
	type Primary (Equipment e) a = e :*: a
	run :: ((->) < Equipment e a) < Primary (Equipment e) a
run ~(Equipment e :*: a
x) = Primary (Equipment e) a
e :*: a
x
	unite :: ((->) < Primary (Equipment e) a) < Equipment e a
unite = ((->) < Primary (Equipment e) a) < Equipment e a
forall e a. (e :*: a) -> Equipment e a
Equipment

type instance Schematic Comonad (Equipment e) = (<:.>) ((:*:) e)

type Equipped e t = Adaptable (Equipment e) (->) t

instance {-# OVERLAPS #-} Extendable (->) u => Extendable (->) ((:*:) e <:.> u) where
	(<:.>) ((:*:) e) u a -> b
f <<= :: ((<:.>) ((:*:) e) u a -> b)
-> (<:.>) ((:*:) e) u a -> (<:.>) ((:*:) e) u b
<<= TU (e
e :*: u a
x) = (((:*:) e :. u) >>> b) -> (<:.>) ((:*:) e) u b
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) >>> b) -> (<:.>) ((:*:) e) u b)
-> (u b -> ((:*:) e :. u) >>> b) -> u b -> (<:.>) ((:*:) e) u b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. e -> u b -> ((:*:) e :. u) >>> b
forall s a. s -> a -> s :*: a
(:*:) e
e (u b -> (<:.>) ((:*:) e) u b) -> u b -> (<:.>) ((:*:) e) u b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- (<:.>) ((:*:) e) u a -> b
f ((<:.>) ((:*:) e) u a -> b)
-> (u a -> (<:.>) ((:*:) e) u a) -> u a -> b
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) -> (<:.>) ((:*:) e) u a)
-> (u a -> e :*: u a) -> u a -> (<:.>) ((:*:) 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 s a. s -> a -> s :*: a
(:*:) e
e (u a -> b) -> u a -> u b
forall (source :: * -> * -> *) (t :: * -> *) a b.
Extendable source t =>
source (t a) b -> source (t a) (t b)
<<= u a
x

retrieve :: Equipped e t => t a -> e
retrieve :: t a -> e
retrieve = (e :*: a) -> e
forall a b. (a :*: b) -> a
attached ((e :*: a) -> e) -> (t a -> e :*: a) -> t a -> e
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. forall a.
Interpreted (->) (Equipment e) =>
((->) < Equipment e a) < Primary (Equipment e) a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run @(->) @(Equipment _) (Equipment e a -> e :*: a)
-> (t a -> Equipment e a) -> t a -> e :*: a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. t a -> Equipment e a
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

instance Gettable Equipment where
	type Getting Equipment e output = Equipment e output -> e
	get :: Getting Equipment e r
get (Equipment (e
e :*: r
_)) = e
e