{-# LANGUAGE RankNTypes #-}
module Fresnel.Lens
( -- * Lenses
  Lens
, Lens'
, IsLens
  -- * Construction
, lens
  -- * Elimination
, withLens
  -- * Combinators
, alongside
  -- * Unpacked
, UnpackedLens(..)
, unpackedLens
) where

import Control.Arrow ((&&&), (***))
import Data.Profunctor
import Fresnel.Iso.Internal (IsIso)
import Fresnel.Lens.Internal (IsLens)
import Fresnel.Optic

-- Lenses

type Lens s t a b = forall p . IsLens p => Optic p s t a b

type Lens' s a = Lens s s a a


-- Construction

lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens s -> a
get s -> b -> t
set = (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
get) ((s -> b -> t) -> (s, b) -> t
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry s -> b -> t
set) (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'


-- Elimination

withLens :: Lens s t a b -> (((s -> a) -> (s -> b -> t) -> r) -> r)
withLens :: Lens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r
withLens Lens s t a b
o = UnpackedLens a b s t
-> forall r. ((s -> a) -> (s -> b -> t) -> r) -> r
forall a b s t.
UnpackedLens a b s t
-> forall r. ((s -> a) -> (s -> b -> t) -> r) -> r
withUnpackedLens (Optic (UnpackedLens a b) s t a b
Lens s t a b
o ((a -> a) -> (a -> b -> b) -> UnpackedLens a b a b
forall s a b t. (s -> a) -> (s -> b -> t) -> UnpackedLens a b s t
unpackedLens a -> a
forall a. a -> a
id ((b -> b) -> a -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
id)))


-- Combinators

alongside :: Lens s1 t1 a1 b1 -> Lens s2 t2 a2 b2 -> Lens (s1, s2) (t1, t2) (a1, a2) (b1, b2)
alongside :: Lens s1 t1 a1 b1
-> Lens s2 t2 a2 b2 -> Lens (s1, s2) (t1, t2) (a1, a2) (b1, b2)
alongside Lens s1 t1 a1 b1
o1 Lens s2 t2 a2 b2
o2 = Lens s1 t1 a1 b1
-> ((s1 -> a1)
    -> (s1 -> b1 -> t1) -> Optic p (s1, s2) (t1, t2) (a1, a2) (b1, b2))
-> Optic p (s1, s2) (t1, t2) (a1, a2) (b1, b2)
forall s t a b r.
Lens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r
withLens Lens s1 t1 a1 b1
o1 (((s1 -> a1)
  -> (s1 -> b1 -> t1) -> Optic p (s1, s2) (t1, t2) (a1, a2) (b1, b2))
 -> Optic p (s1, s2) (t1, t2) (a1, a2) (b1, b2))
-> ((s1 -> a1)
    -> (s1 -> b1 -> t1) -> Optic p (s1, s2) (t1, t2) (a1, a2) (b1, b2))
-> Optic p (s1, s2) (t1, t2) (a1, a2) (b1, b2)
forall a b. (a -> b) -> a -> b
$ \ s1 -> a1
get1 s1 -> b1 -> t1
set1 -> Lens s2 t2 a2 b2
-> ((s2 -> a2)
    -> (s2 -> b2 -> t2) -> Optic p (s1, s2) (t1, t2) (a1, a2) (b1, b2))
-> Optic p (s1, s2) (t1, t2) (a1, a2) (b1, b2)
forall s t a b r.
Lens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r
withLens Lens s2 t2 a2 b2
o2 (((s2 -> a2)
  -> (s2 -> b2 -> t2) -> Optic p (s1, s2) (t1, t2) (a1, a2) (b1, b2))
 -> Optic p (s1, s2) (t1, t2) (a1, a2) (b1, b2))
-> ((s2 -> a2)
    -> (s2 -> b2 -> t2) -> Optic p (s1, s2) (t1, t2) (a1, a2) (b1, b2))
-> Optic p (s1, s2) (t1, t2) (a1, a2) (b1, b2)
forall a b. (a -> b) -> a -> b
$ \ s2 -> a2
get2 s2 -> b2 -> t2
set2 ->
  ((s1, s2) -> (a1, a2))
-> ((s1, s2) -> (b1, b2) -> (t1, t2))
-> Lens (s1, s2) (t1, t2) (a1, a2) (b1, b2)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (s1 -> a1
get1 (s1 -> a1) -> (s2 -> a2) -> (s1, s2) -> (a1, a2)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** s2 -> a2
get2) (((b1 -> t1) -> (b2 -> t2) -> (b1, b2) -> (t1, t2))
-> (b1 -> t1, b2 -> t2) -> (b1, b2) -> (t1, t2)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (b1 -> t1) -> (b2 -> t2) -> (b1, b2) -> (t1, t2)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) ((b1 -> t1, b2 -> t2) -> (b1, b2) -> (t1, t2))
-> ((s1, s2) -> (b1 -> t1, b2 -> t2))
-> (s1, s2)
-> (b1, b2)
-> (t1, t2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s1 -> b1 -> t1
set1 (s1 -> b1 -> t1)
-> (s2 -> b2 -> t2) -> (s1, s2) -> (b1 -> t1, b2 -> t2)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** s2 -> b2 -> t2
set2))


-- Unpacked

-- | A 'Lens' unpacked into the get & set functions it was constructed from.
newtype UnpackedLens a b s t = UnpackedLens { UnpackedLens a b s t
-> forall r. ((s -> a) -> (s -> b -> t) -> r) -> r
withUnpackedLens :: forall r . ((s -> a) -> (s -> b -> t) -> r) -> r }

instance Profunctor (UnpackedLens a b) where
  dimap :: (a -> b)
-> (c -> d) -> UnpackedLens a b b c -> UnpackedLens a b a d
dimap a -> b
f c -> d
g (UnpackedLens forall r. ((b -> a) -> (b -> b -> c) -> r) -> r
r) = ((b -> a) -> (b -> b -> c) -> UnpackedLens a b a d)
-> UnpackedLens a b a d
forall r. ((b -> a) -> (b -> b -> c) -> r) -> r
r (((b -> a) -> (b -> b -> c) -> UnpackedLens a b a d)
 -> UnpackedLens a b a d)
-> ((b -> a) -> (b -> b -> c) -> UnpackedLens a b a d)
-> UnpackedLens a b a d
forall a b. (a -> b) -> a -> b
$ \ b -> a
get b -> b -> c
set -> (a -> a) -> (a -> b -> d) -> UnpackedLens a b a d
forall s a b t. (s -> a) -> (s -> b -> t) -> UnpackedLens a b s t
unpackedLens (b -> a
get (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) ((c -> d) -> (b -> c) -> b -> d
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap c -> d
g ((b -> c) -> b -> d) -> (a -> b -> c) -> a -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> c
set (b -> b -> c) -> (a -> b) -> a -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Strong (UnpackedLens a b) where
  first' :: UnpackedLens a b a b -> UnpackedLens a b (a, c) (b, c)
first' (UnpackedLens forall r. ((a -> a) -> (a -> b -> b) -> r) -> r
r) = ((a -> a) -> (a -> b -> b) -> UnpackedLens a b (a, c) (b, c))
-> UnpackedLens a b (a, c) (b, c)
forall r. ((a -> a) -> (a -> b -> b) -> r) -> r
r (((a -> a) -> (a -> b -> b) -> UnpackedLens a b (a, c) (b, c))
 -> UnpackedLens a b (a, c) (b, c))
-> ((a -> a) -> (a -> b -> b) -> UnpackedLens a b (a, c) (b, c))
-> UnpackedLens a b (a, c) (b, c)
forall a b. (a -> b) -> a -> b
$ \ a -> a
get a -> b -> b
set -> ((a, c) -> a)
-> ((a, c) -> b -> (b, c)) -> UnpackedLens a b (a, c) (b, c)
forall s a b t. (s -> a) -> (s -> b -> t) -> UnpackedLens a b s t
unpackedLens (a -> a
get (a -> a) -> ((a, c) -> a) -> (a, c) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, c) -> a
forall a b. (a, b) -> a
fst) (\ (a
a, c
c) b
b -> (a -> b -> b
set a
a b
b, c
c))

instance IsIso (UnpackedLens a b)
instance IsLens (UnpackedLens a b)


unpackedLens :: (s -> a) -> (s -> b -> t) -> UnpackedLens a b s t
unpackedLens :: (s -> a) -> (s -> b -> t) -> UnpackedLens a b s t
unpackedLens s -> a
get s -> b -> t
set = (forall r. ((s -> a) -> (s -> b -> t) -> r) -> r)
-> UnpackedLens a b s t
forall a b s t.
(forall r. ((s -> a) -> (s -> b -> t) -> r) -> r)
-> UnpackedLens a b s t
UnpackedLens (\ (s -> a) -> (s -> b -> t) -> r
k -> (s -> a) -> (s -> b -> t) -> r
k s -> a
get s -> b -> t
set)