module Proton.Lens where

import Data.Profunctor
import Data.Profunctor.Strong
import Control.Arrow ((&&&))

type Lens s t a b = forall p. Strong p => p a b -> p s t
type Lens' s a = Lens s s a a

lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
-- lens getter setter = strong setter . lmap getter
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens getter :: s -> a
getter setter :: s -> b -> t
setter = (s -> (s, a)) -> ((s, b) -> t) -> p (s, a) (s, b) -> p s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (s -> s
forall a. a -> a
id (s -> s) -> (s -> a) -> s -> (s, a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& s -> a
getter) ((s -> b -> t) -> (s, b) -> t
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry s -> b -> t
setter) (p (s, a) (s, b) -> p s t)
-> (p a b -> p (s, a) (s, b)) -> p a b -> p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (s, a) (s, b)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second'

_1 :: Lens (a, x) (b, x) a b
_1 :: p a b -> p (a, x) (b, x)
_1 = ((a, x) -> a) -> ((a, x) -> b -> (b, x)) -> Lens (a, x) (b, x) a b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (a, x) -> a
forall a b. (a, b) -> a
fst (\(_, x :: x
x) b :: b
b -> (b
b, x
x))


_2 :: Lens (x, a) (x, b) a b
_2 :: p a b -> p (x, a) (x, b)
_2 = ((x, a) -> a) -> ((x, a) -> b -> (x, b)) -> Lens (x, a) (x, b) a b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (x, a) -> a
forall a b. (a, b) -> b
snd (\(x :: x
x, _) b :: b
b -> (x
x, b
b))