diff --git a/bower.json b/bower.json index 58defe3..28b0786 100644 --- a/bower.json +++ b/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" diff --git a/src/Data/Lens/Indexed.purs b/src/Data/Lens/Indexed.purs index 33ad80d..26db517 100644 --- a/src/Data/Lens/Indexed.purs +++ b/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 diff --git a/src/Data/Lens/Internal/Indexable.purs b/src/Data/Lens/Internal/Indexable.purs new file mode 100644 index 0000000..377b9b2 --- /dev/null +++ b/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 \ No newline at end of file