added icompose

bower.json

@@ -31,7 +31,8 @@
     "purescript-profunctor": "^4.0.0",
     "purescript-record": "^2.0.0",
     "purescript-transformers": "^4.0.0",
-    "purescript-tuples": "^5.0.0"
+    "purescript-tuples": "^5.0.0",
+    "purescript-type-equality": "^3.0.0"
   },
   "devDependencies": {
     "purescript-console": "^4.0.0"

src/Data/Lens/Indexed.purs

@@ -3,8 +3,8 @@ module Data.Lens.Indexed where
 import Prelude
 
 import Control.Monad.State (modify, get, evalState)
-
 import Data.Functor.Compose (Compose(..))
+import Data.Lens.Internal.Indexable (indexed)
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Lens.Setter ((%~))
 import Data.Lens.Types (wander, Optic, IndexedOptic, Indexed(..), Traversal, IndexedTraversal)
@@ -13,7 +13,47 @@ import Data.Profunctor (class Profunctor, dimap, lcmap)
 import Data.Profunctor.Star (Star(..))
 import Data.Profunctor.Strong (first)
 import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
-import Data.Tuple (curry, fst, snd)
+import Data.Tuple (Tuple(..), curry, fst, snd)
+
+infixr 9 icomposeBoth as <.>
+infixr 9 icomposeLeft as <.
+infixr 9 icomposeRight as .>
+
+withIndex :: forall p i s t. p (Tuple i s) t -> Indexed p i s t
+withIndex = Indexed
+
+icompose 
+  :: forall p i s t a b i' k s' t'
+   . Profunctor p 
+  => (i -> i' -> k) 
+  -> IndexedOptic p i s t s' t' 
+  -> IndexedOptic (Indexed p i) i' s' t' a b 
+  -> IndexedOptic p k s t a b
+icompose f l r = l <<< r <<< withIndex <<< withIndex <<< lcmap (\(Tuple i (Tuple j a)) -> Tuple (f i j) a) <<< indexed
+
+icomposeBoth 
+  :: forall p i s t a b i' s' t'
+   . Profunctor p 
+  => IndexedOptic p i s t s' t' 
+  -> IndexedOptic (Indexed p i) i' s' t' a b 
+  -> IndexedOptic p (Tuple i i') s t a b 
+icomposeBoth = icompose Tuple
+
+icomposeLeft 
+  :: forall p i s t a b i' s' t'
+   . Profunctor p 
+  => IndexedOptic p i s t s' t' 
+  -> IndexedOptic (Indexed p i) i' s' t' a b 
+  -> IndexedOptic p i s t a b 
+icomposeLeft = icompose const
+
+icomposeRight 
+  :: forall p i s t a b i' s' t'
+   . Profunctor p 
+  => IndexedOptic p i s t s' t' 
+  -> IndexedOptic (Indexed p i) i' s' t' a b 
+  -> IndexedOptic p i' s t a b 
+icomposeRight = icompose (const identity)
 
 -- | Converts an `IndexedOptic` to an `Optic` by forgetting indices.
 unIndex

src/Data/Lens/Internal/Indexable.purs

@@ -0,0 +1,26 @@
+module Data.Lens.Internal.Indexable where
+
+import Prelude
+
+import Data.Lens.Internal.Forget (Forget)
+import Data.Newtype (unwrap)
+import Data.Profunctor (class Profunctor, lcmap)
+import Data.Lens.Internal.Indexed (Indexed)
+import Data.Tuple (Tuple(..), snd)
+import Type.Equality (class TypeEquals)
+import Type.Equality as TE
+
+class Indexable i p q | p -> q where
+  indexed :: forall a b. p a b -> q (Tuple i a) b
+
+instance indexableFunction :: Indexable i (->) (->) where
+  indexed = indexedDefault
+
+instance indexableForget :: Indexable i (Forget r) (Forget r) where
+  indexed = indexedDefault
+
+instance indexableIndexed :: (Profunctor p, TypeEquals i j) => Indexable i (Indexed p j) p where
+  indexed = lcmap (\(Tuple x y) -> Tuple (TE.to x) y) <<< unwrap
+
+indexedDefault :: forall p a b i. Profunctor p => p a b -> p (Tuple i a) b
+indexedDefault = lcmap snd