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