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

module Pandora.Paradigm.Inventory.Equipment (Equipment (..), retrieve) where

import Pandora.Pattern.Semigroupoid ((.))
import Pandora.Pattern.Category (($))
import Pandora.Pattern.Functor.Covariant (Covariant ((-<$>-)))
import Pandora.Pattern.Functor.Extractable (Extractable (extract))
import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))
import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))
import Pandora.Pattern.Functor.Comonad (Comonad)
import Pandora.Paradigm.Primary.Algebraic ()
import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), attached)
import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable (adapt))
import Pandora.Paradigm.Controlflow.Effect.Transformer.Comonadic (Comonadic (bring), (:<) (TC))
import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite))
import Pandora.Paradigm.Schemes.TU (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 (t :: * -> *) (source :: * -> * -> *)
       (target :: * -> * -> *) a b.
Covariant t source target =>
source a b -> target (t a) (t b)
-<$>- e :*: a
x

instance Extractable (Equipment e) (->) where
	extract :: Equipment e a -> a
extract = (e :*: a) -> a
forall (t :: * -> *) (source :: * -> * -> *) a.
Extractable t source =>
source (t a) a
extract ((e :*: a) -> a)
-> (Equipment e a -> e :*: a) -> Equipment e a -> a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Equipment e a -> e :*: a
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run

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 (t :: * -> *) (source :: * -> * -> *)
       (target :: * -> * -> *) a b.
Covariant t source target =>
source a b -> target (t a) (t b)
-<$>- a -> u b
f (a -> u b) -> (e :*: a) -> u (e :*: b)
forall (t :: * -> *) (source :: * -> * -> *)
       (target :: * -> * -> *) (u :: * -> *) a b.
(Traversable t source target, Covariant u source target,
 Pointable u target, Semimonoidal u target (:*:) (:*:)) =>
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)

instance Comonadic (Equipment e) where
	bring :: (Equipment e :< u) ~> Equipment e
bring (TC (TU x)) = (e :*: a) -> Equipment e a
forall e a. (e :*: a) -> Equipment e a
Equipment ((e :*: a) -> Equipment e a) -> (e :*: a) -> Equipment e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ forall a. Extractable u (->) => u a -> a
forall (t :: * -> *) (source :: * -> * -> *) a.
Extractable t source =>
source (t a) a
extract @_ @(->) (u a -> a) -> (e :*: u a) -> e :*: a
forall (t :: * -> *) (source :: * -> * -> *)
       (target :: * -> * -> *) a b.
Covariant t source target =>
source a b -> target (t a) (t b)
-<$>- e :*: u a
x

type Equipped e t = Adaptable t (Equipment e)

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 (t :: * -> *) (source :: * -> * -> *) a b.
Extendable t source =>
source (t a) b -> source (t a) (t b)
<<= u a
x

instance Comonad (Equipment e) (->) where

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 (t :: * -> *) a. Interpreted t => 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 (t :: k -> *) (u :: k -> *). Adaptable t u => t ~> u
adapt