reflection 2.1

* Move foldMapBy, foldBy into reflection, but re-export them.
* Add traverseBy, traverseByOf, itraverseBy, itraverseByOf.
* Pull reflection HEAD for the travis configuration.
* Remove internal reified monoid definition.

.travis.yml

@@ -44,7 +44,13 @@ before_install:
     fi
 
 install:
+  # fetch reflection HEAD until 2.1 is on hackage
+  - git clone https://github.com/ekmett/reflection.git
+  - cd reflection
+  - cabal install
+  - cd ..
   - $CABAL install --dependencies-only --enable-tests
+
   - $CABAL configure --enable-tests $MODE
 
 script:

CHANGELOG.markdown

@@ -1,6 +1,8 @@
 4.13
 ----
 * Pattern synonyms
+* Moved `foldMapBy` and `foldBy` into `reflection`.
+* Added `traverseByOf`.
 
 4.12.3
 ------

lens.cabal

@@ -199,7 +199,7 @@ library
     mtl                       >= 2.0.1    && < 2.3,
     parallel                  >= 3.1.0.1  && < 3.3,
     profunctors               >= 5        && < 6,
-    reflection                >= 2        && < 3,
+    reflection                >= 2.1      && < 3,
     semigroupoids             >= 5        && < 6,
     semigroups                >= 0.8.4    && < 1,
     tagged                    >= 0.4.4    && < 1,

src/Control/Lens/Fold.hs

@@ -8,6 +8,10 @@
 #define MIN_VERSION_profunctors(x,y,z) 1
 #endif
 
+#ifndef MIN_VERSION_reflection
+#define MIN_VERSION_reflection(x,y,z) 1
+#endif
+
 #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0))
 {-# LANGUAGE Trustworthy #-}
 #endif
@@ -168,6 +172,9 @@ import Data.Profunctor
 import Data.Profunctor.Rep
 import Data.Profunctor.Sieve
 import Data.Profunctor.Unsafe
+#if MIN_VERSION_reflection(2,1,0)
+import Data.Reflection
+#endif
 import Data.Traversable
 import Prelude hiding (foldr)
 
@@ -2499,19 +2506,6 @@ skip _ = ()
 -- Folds with Reified Monoid
 ------------------------------------------------------------------------------
 
--- | Fold a value using its 'Foldable' instance using
--- explicitly provided 'Monoid' operations. This is like 'fold'
--- where the 'Monoid' instance can be manually specified.
---
--- @
--- 'foldBy' 'mappend' 'mempty' ≡ 'fold'
--- @
---
--- >>> foldBy (++) [] ["hello","world"]
--- "helloworld"
-foldBy :: Foldable t => (a -> a -> a) -> a -> t a -> a
-foldBy f z = reifyFold f z (foldMap M)
-
 -- | Fold a value using a specified 'Fold' and 'Monoid' operations.
 -- This is like 'foldBy' where the 'Foldable' instance can be
 -- manually specified.
@@ -2531,20 +2525,7 @@ foldBy f z = reifyFold f z (foldMap M)
 -- >>> foldByOf both (++) [] ("hello","world")
 -- "helloworld"
 foldByOf :: Fold s a -> (a -> a -> a) -> a -> s -> a
-foldByOf l f z = reifyFold f z (foldMapOf l M)
-
--- | Fold a value using its 'Foldable' instance using
--- explicitly provided 'Monoid' operations. This is like 'foldMap'
--- where the 'Monoid' instance can be manually specified.
---
--- @
--- 'foldMapBy' 'mappend' 'mempty' ≡ 'foldMap'
--- @
---
--- >>> foldMapBy (+) 0 length ["hello","world"]
--- 10
-foldMapBy :: Foldable t => (r -> r -> r) -> r -> (a -> r) -> t a -> r
-foldMapBy f z g = reifyFold f z (foldMap (M #. g))
+foldByOf l f z = reifyMonoid f z (foldMapOf l ReflectedMonoid)
 
 -- | Fold a value using a specified 'Fold' and 'Monoid' operations.
 -- This is like 'foldMapBy' where the 'Foldable' instance can be
@@ -2565,4 +2546,4 @@ foldMapBy f z g = reifyFold f z (foldMap (M #. g))
 -- >>> foldMapByOf both (+) 0 length ("hello","world")
 -- 10
 foldMapByOf :: Fold s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r
-foldMapByOf l f z g = reifyFold f z (foldMapOf l (M #. g))
+foldMapByOf l f z g = reifyMonoid f z (foldMapOf l (ReflectedMonoid #. g))

src/Control/Lens/Indexed.hs

@@ -76,6 +76,9 @@ module Control.Lens.Indexed
   -- * Indexed Folds with Reified Monoid
   , ifoldMapBy
   , ifoldMapByOf
+  -- * Indexed Traversals with Reified Applicative
+  , itraverseBy
+  , itraverseByOf
   ) where
 
 import Control.Applicative
@@ -110,6 +113,7 @@ import Data.List.NonEmpty as NonEmpty
 import Data.Map as Map
 import Data.Monoid hiding (Product)
 import Data.Profunctor.Unsafe
+import Data.Reflection
 import Data.Sequence hiding ((:<), index)
 #if !(MIN_VERSION_containers(0,5,0))
 import Data.Traversable (sequenceA)
@@ -858,7 +862,13 @@ skip _ = ()
 -------------------------------------------------------------------------------
 
 ifoldMapBy :: FoldableWithIndex i t => (r -> r -> r) -> r -> (i -> a -> r) -> t a -> r
-ifoldMapBy f z g = reifyFold f z (ifoldMap (\i a -> M (g i a)))
+ifoldMapBy f z g = reifyMonoid f z (ifoldMap (\i a -> ReflectedMonoid (g i a)))
 
-ifoldMapByOf :: (forall s. IndexedGetting i (M r s) t a) -> (r -> r -> r) -> r -> (i -> a -> r) -> t -> r
-ifoldMapByOf l f z g = reifyFold f z (ifoldMapOf l (\i a -> M (g i a)))
+ifoldMapByOf :: IndexedFold i t a -> (r -> r -> r) -> r -> (i -> a -> r) -> t -> r
+ifoldMapByOf l f z g = reifyMonoid f z (ifoldMapOf l (\i a -> ReflectedMonoid (g i a)))
+
+itraverseBy :: TraversableWithIndex i t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> t a -> f (t b)
+itraverseBy pur app f = reifyApplicative pur app (itraverse (\i a -> ReflectedApplicative (f i a)))
+
+itraverseByOf :: IndexedTraversal i s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> s -> f t
+itraverseByOf l pur app f = reifyApplicative pur app (itraverseOf l (\i a -> ReflectedApplicative (f i a)))

src/Control/Lens/Internal/Fold.hs

@@ -26,8 +26,7 @@ module Control.Lens.Internal.Fold
   , Min(..), getMin
   , Leftmost(..), getLeftmost
   , Rightmost(..), getRightmost
-  , ReifiedMonoid(..), M(..)
-  , reifyFold
+  , ReifiedMonoid(..)
   ) where
 
 import Control.Applicative
@@ -213,24 +212,3 @@ getRightmost :: Rightmost a -> Maybe a
 getRightmost RPure = Nothing
 getRightmost (RLeaf a) = Just a
 getRightmost (RStep x) = getRightmost x
-
-------------------------------------------------------------------------------
--- Folding with Reified Monoid
-------------------------------------------------------------------------------
-
-data ReifiedMonoid a = ReifiedMonoid { reifiedMappend :: a -> a -> a, reifiedMempty :: a }
-
-instance Reifies s (ReifiedMonoid a) => Monoid (M a s) where
-  mappend (M x) (M y) = reflectResult (\m -> M (reifiedMappend m x y))
-  mempty              = reflectResult (\m -> M (reifiedMempty  m    ))
-
-reflectResult :: Reifies s a => (a -> f s) -> f s
-reflectResult f = let r = f (reflect r) in r
-
-newtype M a s = M a
-
-unM :: M a s -> proxy s -> a
-unM (M a) _ = a
-
-reifyFold :: (a -> a -> a) -> a -> (forall s. Reifies s (ReifiedMonoid a) => t -> M a s) -> t -> a
-reifyFold f z m xs = reify (ReifiedMonoid f z) (unM (m xs))

src/Control/Lens/Traversal.hs

@@ -113,6 +113,10 @@ module Control.Lens.Traversal
   , imapAccumROf
   , imapAccumLOf
 
+  -- * Reflection
+  , traverseBy
+  , traverseByOf
+
   -- * Implementation Details
   , Bazaar(..), Bazaar'
   , Bazaar1(..), Bazaar1'
@@ -154,6 +158,7 @@ import Data.Profunctor
 import Data.Profunctor.Rep
 import Data.Profunctor.Sieve
 import Data.Profunctor.Unsafe
+import Data.Reflection
 import Data.Semigroup.Traversable
 import Data.Tagged
 import Data.Traversable
@@ -1290,3 +1295,13 @@ confusing t = \f -> lowerYoneda . lowerRift . t (liftRiftYoneda . f)
   {-# INLINE yap #-}
 
 {-# INLINE confusing #-}
+
+-- | Traverse a container using a specified applicative
+--
+-- This is like 'traverseBy' where the 'Traversable' instance can be specified by any 'Traversal'
+--
+-- @
+-- 'traverseByOf' 'traverse' ≡ 'traverseBy'
+-- @
+traverseByOf :: Traversal s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> s -> f t
+traverseByOf l pur app f = reifyApplicative pur app (l (ReflectedApplicative #. f))