{-# LANGUAGE AllowAmbiguousTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Inventory (module Exports, zoom, magnify, (=<>), (~<>), adjust) where import Pandora.Paradigm.Inventory.Optics as Exports import Pandora.Paradigm.Inventory.Store as Exports import Pandora.Paradigm.Inventory.State as Exports import Pandora.Paradigm.Inventory.Imprint as Exports import Pandora.Paradigm.Inventory.Equipment as Exports import Pandora.Paradigm.Inventory.Environment as Exports import Pandora.Paradigm.Inventory.Accumulator as Exports import Pandora.Core.Functor (type (~>)) import Pandora.Pattern.Category ((.), ($), (#), identity) import Pandora.Pattern.Functor.Covariant (Covariant) import Pandora.Pattern.Functor.Adjoint (Adjoint ((-|), (|-))) import Pandora.Pattern.Functor.Extractable (extract) import Pandora.Pattern.Functor.Bivariant ((<->)) import Pandora.Paradigm.Primary.Functor.Function ((!.), (%)) import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity)) import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:))) import Pandora.Paradigm.Controlflow.Effect.Interpreted (run) import Pandora.Paradigm.Controlflow.Effect.Adaptable (adapt) import Pandora.Paradigm.Structure.Ability.Accessible (Accessible (access)) instance Adjoint (Store s) (State s) where (-|) :: a -> (Store s a -> b) -> State s b a x -| :: a -> (Store s a -> b) -> State s b -| Store s a -> b f = (((->) s :. (:*:) s) := b) -> State s b forall s a. (((->) s :. (:*:) s) := a) -> State s a State ((((->) s :. (:*:) s) := b) -> State s b) -> (((->) s :. (:*:) s) := b) -> State s b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ \s s -> s -> b -> Product s b forall s a. s -> a -> Product s a (:*:) s s (b -> Product s b) -> (Product s (s -> a) -> b) -> Product s (s -> a) -> Product s b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . Store s a -> b f (Store s a -> b) -> (Product s (s -> a) -> Store s a) -> Product s (s -> a) -> b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . Product s (s -> a) -> Store s a forall s a. (((:*:) s :. (->) s) := a) -> Store s a Store (Product s (s -> a) -> Product s b) -> Product s (s -> a) -> Product s b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ s s s -> (s -> a) -> Product s (s -> a) forall s a. s -> a -> Product s a :*: (a x a -> s -> a forall a b. a -> b -> a !.) (|-) :: Store s a -> (a -> State s b) -> b Store (s s :*: s -> a f) |- :: Store s a -> (a -> State s b) -> b |- a -> State s b g = Product s b -> b forall (t :: * -> *) (source :: * -> * -> *) a. Extractable t source => source (t a) a extract (Product s b -> b) -> (a -> Product s b) -> a -> b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . (State s b -> ((->) s :. (:*:) s) := b forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run (State s b -> ((->) s :. (:*:) s) := b) -> s -> State s b -> Product s b forall a b c. (a -> b -> c) -> b -> a -> c % s s) (State s b -> Product s b) -> (a -> State s b) -> a -> Product s b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . a -> State s b g (a -> b) -> a -> b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ s -> a f s s instance Adjoint (Accumulator e) (Imprint e) where a x -| :: a -> (Accumulator e a -> b) -> Imprint e b -| Accumulator e a -> b f = (e -> b) -> Imprint e b forall e a. (e -> a) -> Imprint e a Imprint ((e -> b) -> Imprint e b) -> (e -> b) -> Imprint e b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ a x a -> (Product e a -> b) -> e -> b forall (t :: * -> *) (u :: * -> *) a b. Adjoint t u => a -> (t a -> b) -> u b -| Accumulator e a -> b f (Accumulator e a -> b) -> (Product e a -> Accumulator e a) -> Product e a -> b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . Product e a -> Accumulator e a forall e a. (e :*: a) -> Accumulator e a Accumulator Accumulator e a x |- :: Accumulator e a -> (a -> Imprint e b) -> b |- a -> Imprint e b g = Accumulator e a -> Primary (Accumulator e) a forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run Accumulator e a x (e :*: a) -> (a -> e -> b) -> b forall (t :: * -> *) (u :: * -> *) a b. Adjoint t u => t a -> (a -> u b) -> b |- Imprint e b -> e -> b forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run (Imprint e b -> e -> b) -> (a -> Imprint e b) -> a -> e -> b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . a -> Imprint e b g instance Adjoint (Equipment e) (Environment e) where a x -| :: a -> (Equipment e a -> b) -> Environment e b -| Equipment e a -> 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) $ a x a -> (Product e a -> b) -> e -> b forall (t :: * -> *) (u :: * -> *) a b. Adjoint t u => a -> (t a -> b) -> u b -| Equipment e a -> b f (Equipment e a -> b) -> (Product e a -> Equipment e a) -> Product e a -> b forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . Product e a -> Equipment e a forall e a. (e :*: a) -> Equipment e a Equipment Equipment e a x |- :: Equipment e a -> (a -> Environment e b) -> b |- a -> Environment e b g = Equipment e a -> Primary (Equipment e) a forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run Equipment e a x (e :*: a) -> (a -> e -> b) -> b forall (t :: * -> *) (u :: * -> *) a b. Adjoint t u => t a -> (a -> u b) -> 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 (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . a -> Environment e b g zoom :: Stateful bg t => Lens Identity bg ls -> State ls ~> t zoom :: Lens Identity bg ls -> State ls ~> t zoom Lens Identity bg ls lens State ls a less = let restruct :: (Identity ls -> bg) -> Identity ls -> Product bg a restruct Identity ls -> bg to = (Identity ls -> bg to (Identity ls -> bg) -> (ls -> Identity ls) -> ls -> bg forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . ls -> Identity ls forall a. a -> Identity a Identity (ls -> bg) -> (a -> a) -> Product ls a -> Product bg a forall (v :: * -> * -> *) a b c d. (Bivariant v, forall i. Covariant (v i)) => (a -> b) -> (c -> d) -> v a c -> v b d <-> a -> a forall (m :: * -> * -> *) a. Category m => m a a identity) (Product ls a -> Product bg a) -> (Identity ls -> Product ls a) -> Identity ls -> Product bg a forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . State ls a -> Primary (State ls) a forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run State ls a less (((->) ls :. (:*:) ls) := a) -> (Identity ls -> ls) -> Identity ls -> Product ls a forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . forall (t :: * -> *) (source :: * -> * -> *) a. Extractable t source => source (t a) a forall (source :: * -> * -> *) a. Extractable Identity source => source (Identity a) a extract @Identity in State bg a -> t a forall k (t :: k -> *) (u :: k -> *). Adaptable t u => t ~> u adapt (State bg a -> t a) -> ((bg -> Product bg a) -> State bg a) -> (bg -> Product bg a) -> t a forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . (bg -> Product bg a) -> State bg a forall s a. (((->) s :. (:*:) s) := a) -> State s a State ((bg -> Product bg a) -> t a) -> (bg -> Product bg a) -> t a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ (Product (Identity ls) (Identity ls -> bg) -> ((Identity ls -> bg) -> Identity ls -> Product bg a) -> Product bg a forall (t :: * -> *) (u :: * -> *) a b. Adjoint t u => t a -> (a -> u b) -> b |- (Identity ls -> bg) -> Identity ls -> Product bg a restruct) (Product (Identity ls) (Identity ls -> bg) -> Product bg a) -> (bg -> Product (Identity ls) (Identity ls -> bg)) -> bg -> Product bg a forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . Store (Identity ls) bg -> Product (Identity ls) (Identity ls -> bg) forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run (Store (Identity ls) bg -> Product (Identity ls) (Identity ls -> bg)) -> (bg -> Store (Identity ls) bg) -> bg -> Product (Identity ls) (Identity ls -> bg) forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . Lens Identity bg ls -> Primary (P_Q_T (->) Store Identity bg) ls forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run Lens Identity bg ls lens (=<>) :: Stateful src t => Lens mode src tgt -> mode tgt -> t src Lens mode src tgt lens =<> :: Lens mode src tgt -> mode tgt -> t src =<> mode tgt new = (src -> src) -> t src forall s (t :: * -> *). Stateful s t => (s -> s) -> t s modify ((src -> src) -> t src) -> (src -> src) -> t src forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ Lens mode src tgt -> mode tgt -> src -> src forall (available :: * -> *) source target. Lens available source target -> available target -> source -> source set Lens mode src tgt lens mode tgt new (~<>) :: Covariant mode => Stateful src t => Lens mode src tgt -> (mode tgt -> mode tgt) -> t src Lens mode src tgt lens ~<> :: Lens mode src tgt -> (mode tgt -> mode tgt) -> t src ~<> mode tgt -> mode tgt f = (src -> src) -> t src forall s (t :: * -> *). Stateful s t => (s -> s) -> t s modify ((src -> src) -> t src) -> (src -> src) -> t src forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ Lens mode src tgt -> (mode tgt -> mode tgt) -> src -> src forall (available :: * -> *) source target. Covariant available => Lens available source target -> (available target -> available target) -> source -> source over Lens mode src tgt lens mode tgt -> mode tgt f magnify :: forall bg ls t . (Accessible ls bg, Stateful bg t) => t ls magnify :: t ls magnify = forall bg (t :: * -> *) ls. Stateful bg t => Lens Identity bg ls -> State ls ~> t forall (t :: * -> *) ls. Stateful bg t => Lens Identity bg ls -> State ls ~> t zoom @bg (Lens Identity bg ls -> State ls ls -> t ls) -> Lens Identity bg ls -> State ls ls -> t ls forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # Accessible ls bg => Lens Identity bg ls forall target source. Accessible target source => Lens Identity source target access @ls @bg (State ls ls -> t ls) -> State ls ls -> t ls forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # State ls ls forall s (t :: * -> *). Stateful s t => t s current adjust :: forall bg ls t . (Accessible ls bg, Stateful bg t) => (ls -> ls) -> t ls adjust :: (ls -> ls) -> t ls adjust = Lens Identity bg ls -> State ls ~> t forall bg (t :: * -> *) ls. Stateful bg t => Lens Identity bg ls -> State ls ~> t zoom @bg (Accessible ls bg => Lens Identity bg ls forall target source. Accessible target source => Lens Identity source target access @ls @bg) (State ls ls -> t ls) -> ((ls -> ls) -> State ls ls) -> (ls -> ls) -> t ls forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . (ls -> ls) -> State ls ls forall s (t :: * -> *). Stateful s t => (s -> s) -> t s modify