Indexed lenses (#50)

* add IndexedLens

* Fixed errors

* renamed variables, to match up lens and ilens

Author: Roxxik

src/Data/Lens/Internal/IndexedShop.purs

@@ -0,0 +1,20 @@
+-- | This module defines the `IndexedShop` profunctor
+module Data.Lens.Internal.IndexedShop where
+
+import Prelude
+
+import Data.Profunctor (class Profunctor)
+import Data.Profunctor.Strong (class Strong)
+import Data.Tuple (Tuple(..))
+
+-- | The `IndexedShop` profunctor characterizes an `IndexedLens`.
+data IndexedShop i a b s t = IndexedShop (s -> (Tuple i a)) (s -> b -> t)
+
+instance profunctorIndexedShop :: Profunctor (IndexedShop i a b) where
+  dimap f g (IndexedShop x y) = IndexedShop (x <<< f) (\s -> g <<< y (f s))
+
+instance strongShop :: Strong (IndexedShop i a b) where
+  first (IndexedShop x y) =
+    IndexedShop (\(Tuple a _) -> x a) (\(Tuple s c) b -> Tuple (y s b) c)
+  second (IndexedShop x y) =
+    IndexedShop (\(Tuple _ a) -> x a) (\(Tuple c s) b -> Tuple c (y s b))

src/Data/Lens/Lens.purs

@@ -4,16 +4,26 @@ module Data.Lens.Lens
   , lens'
   , withLens
   , cloneLens
+  , ilens
+  , ilens'
+  , withIndexedLens
+  , cloneIndexedLens
   , module Data.Lens.Types
   ) where
 
 import Prelude
 
 import Data.Lens.Internal.Shop (Shop(..))
-import Data.Lens.Types (Lens, Lens', ALens, ALens')
+import Data.Lens.Internal.IndexedShop (IndexedShop(..))
+import Data.Lens.Internal.Indexed (Indexed(..))
+import Data.Lens.Types
+  ( Lens,  Lens', ALens, ALens'
+  , IndexedLens, IndexedLens', AnIndexedLens, AnIndexedLens'
+  )
 import Data.Profunctor (dimap)
 import Data.Profunctor.Strong (first)
 import Data.Tuple (Tuple(..))
+import Data.Newtype(un)
 
 lens' :: forall s t a b. (s -> Tuple a (b -> t)) -> Lens s t a b
 lens' to pab = dimap to (\(Tuple b f) -> f b) (first pab)
@@ -27,3 +37,20 @@ withLens l f = case l (Shop id \_ b -> b) of Shop x y -> f x y
 
 cloneLens :: forall s t a b. ALens s t a b -> Lens s t a b
 cloneLens l = withLens l \x y p -> lens x y p
+
+
+ilens' :: forall i s t a b.
+  (s -> Tuple (Tuple i a) (b -> t)) -> IndexedLens i s t a b
+ilens' to pab = dimap to (\(Tuple b f) -> f b) (first ((un Indexed) pab))
+
+-- create an `IndexedLens` from a getter/setter pair.
+ilens :: forall i s t a b.
+  (s -> Tuple i a) -> (s -> b -> t) -> IndexedLens i s t a b
+ilens get set = ilens' \s -> Tuple (get s) \b -> set s b
+
+withIndexedLens :: forall i s t a b r.
+  (AnIndexedLens i s t a b) -> ((s -> (Tuple i a)) -> (s -> b -> t) -> r) -> r
+withIndexedLens l f = case l (Indexed (IndexedShop id \_ b -> b)) of IndexedShop x y -> f x y
+
+cloneIndexedLens :: forall i s t a b. AnIndexedLens i s t a b -> IndexedLens i s t a b
+cloneIndexedLens l = withIndexedLens l \x y p -> ilens x y p

src/Data/Lens/Types.purs

@@ -4,6 +4,7 @@ module Data.Lens.Types
   , module Data.Lens.Internal.Exchange
   , module Data.Lens.Internal.Market
   , module Data.Lens.Internal.Shop
+  , module Data.Lens.Internal.IndexedShop
   , module Data.Lens.Internal.Tagged
   , module Data.Lens.Internal.Forget
   , module Data.Lens.Internal.Wander
@@ -17,6 +18,7 @@ import Data.Lens.Internal.Indexed (Indexed(..))
 import Data.Lens.Internal.Market (Market(..))
 import Data.Lens.Internal.Re (Re(..))
 import Data.Lens.Internal.Shop (Shop(..))
+import Data.Lens.Internal.IndexedShop (IndexedShop(..))
 import Data.Lens.Internal.Tagged (Tagged(..))
 import Data.Lens.Internal.Wander (class Wander, wander)
 import Data.Profunctor (class Profunctor)
@@ -41,6 +43,13 @@ type Lens' s a = Lens s s a a
 type ALens s t a b = Optic (Shop a b) s t a b
 type ALens' s a = ALens s s a a
 
+-- | An indexed lens.
+type IndexedLens i s t a b = forall p. Strong p => IndexedOptic p i s t a b
+type IndexedLens' i s a = IndexedLens i s s a a
+
+type AnIndexedLens i s t a b = IndexedOptic (IndexedShop i a b) i s t a b
+type AnIndexedLens' i s a = AnIndexedLens i s s a a
+
 -- | A prism.
 type Prism s t a b = forall p. Choice p => Optic p s t a b
 type Prism' s a = Prism s s a a