module Pandora.Paradigm.Inventory.Optics where

import Pandora.Core.Functor (type (:=>))
import Pandora.Pattern.Category ((.), ($))
import Pandora.Pattern.Functor.Covariant ((<$))
import Pandora.Pattern.Functor.Extractable (Extractable (extract))
import Pandora.Pattern.Functor.Representable (Representable (Representation, (<#>), tabulate))
import Pandora.Pattern.Object.Setoid (Setoid ((==)))
import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)))
import Pandora.Paradigm.Primary.Object.Boolean ((?))
import Pandora.Paradigm.Inventory.Store (Store (Store), position, look, retrofit)

infixr 0 :-.
infixr 0 :~.

type (:-.) src tgt = Lens src tgt

-- Reference to taret within some source
type Lens src tgt = src :=> Store tgt

-- Lens as natural transformation
type (:~.) src tgt = forall a . Lens (src a) (tgt a)

-- | Lens composition infix operator
(|>) :: Lens src tgt -> Lens tgt new -> Lens src new
|> :: Lens src tgt -> Lens tgt new -> Lens src new
(|>) Lens src tgt
from Lens tgt new
to src
src = src
src src -> Store new tgt -> Store new src
forall (t :: * -> *) a b. Covariant t => a -> t b -> t a
<$ (Lens tgt new
to Lens tgt new
-> (Store tgt src -> tgt) -> Store tgt src -> Store new tgt
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Store tgt src -> tgt
forall s (t :: * -> *) a. Storable s t => t a -> s
position (Store tgt src -> Store new tgt) -> Store tgt src -> Store new tgt
forall (m :: * -> * -> *). Category m => m ~~> m
$ Lens src tgt
from src
src)

-- | Get the target of a lens
view :: Lens src tgt -> src -> tgt
view :: Lens src tgt -> src -> tgt
view Lens src tgt
lens = Store tgt src -> tgt
forall s (t :: * -> *) a. Storable s t => t a -> s
position (Store tgt src -> tgt) -> Lens src tgt -> src -> tgt
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Lens src tgt
lens

-- | Replace the target of a lens
set :: Lens src tgt -> tgt -> src -> src
set :: Lens src tgt -> tgt -> src -> src
set Lens src tgt
lens tgt
new = tgt -> src <:= Store tgt
forall s (t :: * -> *) a. Storable s t => s -> a <:= t
look tgt
new (src <:= Store tgt) -> Lens src tgt -> src -> src
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Lens src tgt
lens

-- | Modify the target of a lens
over :: Lens src tgt -> (tgt -> tgt) -> src -> src
over :: Lens src tgt -> (tgt -> tgt) -> src -> src
over Lens src tgt
lens tgt -> tgt
f = src <:= Store tgt
forall (t :: * -> *) a. Extractable t => a <:= t
extract (src <:= Store tgt) -> Lens src tgt -> src -> src
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (tgt -> tgt) -> Store tgt ~> Store tgt
forall s. (s -> s) -> Store s ~> Store s
retrofit tgt -> tgt
f (Store tgt src -> Store tgt src) -> Lens src tgt -> Lens src tgt
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Lens src tgt
lens

-- | Representable based lens
represent :: (Representable t, Setoid (Representation t)) => Representation t -> t a :-. a
represent :: Representation t -> t a :-. a
represent Representation t
r t a
x = (((:*:) a :. (->) a) := t a) -> Store a (t a)
forall s a. (((:*:) s :. (->) s) := a) -> Store s a
Store ((((:*:) a :. (->) a) := t a) -> Store a (t a))
-> (((:*:) a :. (->) a) := t a) -> Store a (t a)
forall (m :: * -> * -> *). Category m => m ~~> m
$ (Representation t
r Representation t -> a <:= t
forall (t :: * -> *) a.
Representable t =>
Representation t -> a <:= t
<#> t a
x) a -> (a -> t a) -> ((:*:) a :. (->) a) := t a
forall s a. s -> a -> Product s a
:*: \a
new -> (Representation t -> a) -> t a
forall (t :: * -> *) a.
Representable t =>
(Representation t -> a) -> t a
tabulate (\Representation t
r' -> Representation t
r' Representation t -> Representation t -> Boolean
forall a. Setoid a => a -> a -> Boolean
== Representation t
r Boolean -> a -> a -> a
forall a. Boolean -> a -> a -> a
? a
new (a -> a) -> a -> a
forall (m :: * -> * -> *). Category m => m ~~> m
$ Representation t
r' Representation t -> a <:= t
forall (t :: * -> *) a.
Representable t =>
Representation t -> a <:= t
<#> t a
x)