module Control.Joint.Concepts.Lens where

import "comonad" Control.Comonad (extract)

import Control.Joint.Abilities.Adaptable (adapt)
import Control.Joint.Effects.State (Stateful, State (State))
import Control.Joint.Effects.Store (Store (Store), pos, peek, retrofit)

type Lens s t = s -> Store t s

view :: Lens s t -> s -> t
view :: Lens s t -> s -> t
view Lens s t
lens = Store t s -> t
forall s a. Store s a -> s
pos (Store t s -> t) -> Lens s t -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens s t
lens

set :: Lens s t -> t -> s -> s
set :: Lens s t -> t -> s -> s
set Lens s t
lens t
new = t -> Store t s -> s
forall s a. s -> Store s a -> a
peek t
new (Store t s -> s) -> Lens s t -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens s t
lens

over :: Lens s t -> (t -> t) -> s -> s
over :: Lens s t -> (t -> t) -> s -> s
over Lens s t
lens t -> t
f = Store t s -> s
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Store t s -> s) -> Lens s t -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> t) -> Store t s -> Store t s
forall s a. (s -> s) -> Store s a -> Store s a
retrofit t -> t
f (Store t s -> Store t s) -> Lens s t -> Lens s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens s t
lens

zoom :: Stateful bg t => Lens bg ls -> State ls a -> t a
zoom :: Lens bg ls -> State ls a -> t a
zoom Lens bg ls
lens (State ((->) ls :. (,) ls) := a
f) = State bg a -> t a
forall (eff :: * -> *) (schema :: * -> *).
Adaptable eff schema =>
eff ~> schema
adapt (State bg a -> t a)
-> ((((->) bg :. (,) bg) := a) -> State bg a)
-> (((->) bg :. (,) bg) := a)
-> t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((->) bg :. (,) bg) := a) -> State bg a
forall s a. (((->) s :. (,) s) := a) -> State s a
State ((((->) bg :. (,) bg) := a) -> t a)
-> (((->) bg :. (,) bg) := a) -> t a
forall a b. (a -> b) -> a -> b
$ (\(Store (ls
p, ls -> bg
g)) -> (\(ls
x,a
y) -> (ls -> bg
g ls
x, a
y)) ((ls, a) -> (bg, a)) -> (((->) ls :. (,) ls) := a) -> ls -> (bg, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((->) ls :. (,) ls) := a
f (ls -> (bg, a)) -> ls -> (bg, a)
forall a b. (a -> b) -> a -> b
$ ls
p) (Store ls bg -> (bg, a)) -> Lens bg ls -> ((->) bg :. (,) bg) := a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens bg ls
lens

_1 :: Lens (a, b) a
_1 :: Lens (a, b) a
_1 (a
x, b
y) = (((,) a :. (->) a) := (a, b)) -> Store a (a, b)
forall s a. (((,) s :. (->) s) := a) -> Store s a
Store (a
x, \a
x' -> (a
x', b
y))

_2 :: Lens (a, b) b
_2 :: Lens (a, b) b
_2 (a
x, b
y) = (((,) b :. (->) b) := (a, b)) -> Store b (a, b)
forall s a. (((,) s :. (->) s) := a) -> Store s a
Store (b
y, \b
y' -> (a
x, b
y'))