Skip to content
Browse files

Improved whereby. Added a more compoisitonal `withIndex` and `index`.…

… Deleted the old `withIndex`, `withIndicesOf`, `indicesOf`.
  • Loading branch information...
1 parent cd3214c commit fcbbcde3a162e5e00e883a955e44e3eb413c49b2 @ekmett committed Dec 28, 2012
Showing with 29 additions and 69 deletions.
  1. +3 −3 src/Control/Lens/Action.hs
  2. +3 −43 src/Control/Lens/Fold.hs
  3. +23 −23 src/Control/Lens/Indexed.hs
View
6 src/Control/Lens/Action.hs
@@ -106,17 +106,17 @@ type IndexedActing i m r s t a b = Indexed i a (Effect m r b) -> s -> Effect m r
--
-- @'perform' ≡ 'flip' ('^@!')@
iperform :: Monad m => IndexedActing i m (i, a) s t a b -> s -> m (i, a)
-iperform l = getEffect #. withIndex l (\i a -> Effect (return (i, a)))
+iperform l = getEffect #. l (Indexed $ \i a -> Effect (return (i, a)))
{-# INLINE iperform #-}
-- | Perform an 'IndexedAction' and modify the result.
iperforms :: Monad m => IndexedActing i m e s t a b -> (i -> a -> e) -> s -> m e
-iperforms l f = getEffect #. withIndex l (\i a -> Effect (return (f i a)))
+iperforms l f = getEffect #. l (Indexed $ \i a -> Effect (return (f i a)))
{-# INLINE iperforms #-}
-- | Perform an 'IndexedAction'
(^@!) :: Monad m => s -> IndexedActing i m (i, a) s t a b -> m (i, a)
-s ^@! l = getEffect (withIndex l (\i a -> Effect (return (i, a))) s)
+s ^@! l = getEffect (l (Indexed $ \i a -> Effect (return (i, a))) s)
{-# INLINE (^@!) #-}
-- | Construct an 'IndexedAction' from a monadic side-effect
View
46 src/Control/Lens/Fold.hs
@@ -108,10 +108,6 @@ module Control.Lens.Fold
, ifoldlMOf
, itoListOf
- -- ** Converting to Folds
- , withIndicesOf
- , indicesOf
-
-- ** Building Indexed Folds
, ifiltering
, itakingWhile
@@ -1576,44 +1572,6 @@ s ^@?! l = ifoldrOf l (\i x _ -> (i,x)) (error "(^@?!): empty Fold") s
-- Converting to Folds
-------------------------------------------------------------------------------
--- | Transform an indexed fold into a fold of both the indices and the values.
---
--- @
--- 'withIndicesOf' :: 'IndexedFold' i s a -> 'Fold' s (i, a)
--- 'withIndicesOf' :: 'IndexedLens'' i s a -> 'Getter' s (i, a)
--- 'withIndicesOf' :: 'IndexedTraversal'' i s a -> 'Fold' s (i, a)
--- @
---
--- All 'Fold' operations are safe, and comply with the laws. However:
---
--- Passing this an 'IndexedTraversal' will still allow many
--- 'Traversal' combinators to type check on the result, but the result
--- can only be legally traversed by operations that do not edit the indices.
---
--- @
--- 'withIndicesOf' :: 'IndexedTraversal' i s t a b -> 'Traversal' s t (i, a) (j, b)
--- @
---
--- Change made to the indices will be discarded.
-withIndicesOf :: Functor f => IndexedLensLike (Indexed i) f s t a b -> LensLike f s t (i, a) (j, b)
-withIndicesOf l f = l . Indexed $ \i c -> snd <$> f (i,c)
-{-# INLINE withIndicesOf #-}
-
--- | Transform an indexed fold into a fold of the indices.
---
--- @
--- 'indicesOf' :: 'IndexedFold' i s a -> 'Fold' s i
--- 'indicesOf' :: 'IndexedLens'' i s a -> 'Getter' s i
--- 'indicesOf' :: 'IndexedTraversal'' i s a -> 'Fold' s i
--- @
-indicesOf :: Gettable f => IndexedLensLike (Indexed i) f s t a a -> LensLike f s t i j
-indicesOf l f = l . Indexed $ const . coerce . f
-{-# INLINE indicesOf #-}
-
--------------------------------------------------------------------------------
--- Converting to Folds
--------------------------------------------------------------------------------
-
-- | Obtain an 'IndexedFold' by filtering an 'IndexedLens', 'IndexedGetter', or 'IndexedFold'.
--
-- When passed an 'IndexedTraversal', sadly the result is /not/ a legal 'IndexedTraversal'.
@@ -1628,7 +1586,9 @@ ifiltering p l f = l . Indexed $ \ i c -> if p i c then indexed f i c else pure
-- | This allows you to filter an 'IndexedFold', 'IndexedGetter', 'IndexedTraversal' or 'IndexedLens' based on an index.
--
-whereby :: Applicative f => (i -> Bool) -> Overloading' (Indexed i) (Indexed i) f a a
+-- >>> ["hello","the","world","!!!"]^..traversed.whereby even
+-- ["hello","world"]
+whereby :: (Indexable i p, Applicative f) => (i -> Bool) -> Overloading' p (Indexed i) f a a
whereby p f = Indexed $ \i a -> if p i then indexed f i a else pure a
-- | Obtain an 'IndexedFold' by taking elements from another
View
46 src/Control/Lens/Indexed.hs
@@ -33,7 +33,6 @@ module Control.Lens.Indexed
-- * Indexing
Indexable(..)
, Indexed(..)
- , withIndex
, (<.), (<.>), (.>)
, reindexed
, icompose
@@ -59,8 +58,8 @@ module Control.Lens.Indexed
, ifoldlM
, itoList
-- * Converting to Folds
- , withIndices
- , indices
+ , withIndex
+ , index
-- * Indexed Traversables
, TraversableWithIndex(..)
, itraversed
@@ -81,6 +80,7 @@ import Control.Lens.Fold
import Control.Lens.Internal
import Control.Lens.Setter
import Control.Lens.Traversal
+import Control.Lens.Type
import Data.Foldable
import Data.Functor.Identity
import Data.Hashable
@@ -99,10 +99,6 @@ infixr 9 <.>, <., .>
-- $setup
-- >>> import Control.Lens
-withIndex :: (Indexed i s t -> r) -> (i -> s -> t) -> r
-withIndex l = l .# Indexed
-{-# INLINE withIndex #-}
-
-- | Compose an 'Indexed' function with a non-indexed function.
--
-- Mnemonically, the @<@ points to the indexing we want to preserve.
@@ -140,6 +136,24 @@ icompose ijk istr jabst cab = istr . Indexed $ \i -> jabst . Indexed $ \j -> ind
{-# INLINE icompose #-}
-------------------------------------------------------------------------------
+-- Converting to Folds
+-------------------------------------------------------------------------------
+
+-- | Fold a container with indices returning both the indices and the values.
+--
+-- The result is only valid to compose in a 'Traversal', if you don't edit the
+-- index as edits to the index have no effect.
+withIndex :: (Indexable i p, Functor f) => Overloading p (Indexed i) f s t (i, s) (j, t)
+withIndex f = Indexed $ \i a -> snd <$> indexed f i (i, a)
+{-# INLINE withIndex #-}
+
+-- | When composed with an indexed fold or indexed traversal this yields an
+-- (indexed) fold of the indices.
+index :: (Indexable i p, Functor f, Gettable f) => Overloading' p (Indexed i) f s i
+index f = Indexed $ \i _ -> coerce (indexed f i i)
+{-# INLINE index #-}
+
+-------------------------------------------------------------------------------
-- FunctorWithIndex
-------------------------------------------------------------------------------
@@ -353,20 +367,6 @@ itoList = ifoldr (\i c -> ((i,c):)) []
{-# INLINE itoList #-}
-------------------------------------------------------------------------------
--- Converting to Folds
--------------------------------------------------------------------------------
-
--- | Fold a container with indices returning both the indices and the values.
-withIndices :: FoldableWithIndex i f => Fold (f a) (i,a)
-withIndices f = coerce . getFolding . ifoldMap (\i a -> Folding (f (i,a)))
-{-# INLINE withIndices #-}
-
--- | Fold a container with indices returning only the indices.
-indices :: FoldableWithIndex i f => Fold (f a) i
-indices f = coerce . (getFolding #. ifoldMap (\i _ -> Folding (f i)))
-{-# INLINE indices #-}
-
--------------------------------------------------------------------------------
-- TraversableWithIndex
-------------------------------------------------------------------------------
@@ -485,7 +485,7 @@ instance FoldableWithIndex Int [] where
ifoldMap = ifoldMapOf itraversed
{-# INLINE ifoldMap #-}
instance TraversableWithIndex Int [] where
- itraverse = withIndex traversed
+ itraverse = itraverseOf traversed
{-# INLINE itraverse #-}
-- | The position in the sequence is available as the index.
@@ -496,7 +496,7 @@ instance FoldableWithIndex Int Seq where
ifoldMap = ifoldMapOf itraversed
{-# INLINE ifoldMap #-}
instance TraversableWithIndex Int Seq where
- itraverse = withIndex traversed
+ itraverse = itraverseOf traversed
{-# INLINE itraverse #-}
instance FunctorWithIndex Int Vector where

0 comments on commit fcbbcde

Please sign in to comment.
Something went wrong with that request. Please try again.