Add some more optics (#185)

This commit adds the following new optics to the microlens package:

  * `mapMOf`, `rewriteMOf`, `transformMOf`
    These functions allow you to map/rewrite/transform a value using a
    lens a monadic action.

  * `anyOf`, `allOf`, `noneOf`
    In addition to those folds the `foldMapOf` function which was
    already present in the internal module is exposed by the public
    API.

  * `cosmosOf`
    Provided a traversal of the immediate children of a value,
    transitively traverse a children and the value itself.

In addition to that the `Zoomed` type family is exposed by the public
API of the microlens-mtl package.

The changes were motivated by an issue of the Dhall project;
See dhall-lang/dhall-haskell#998

Author: mmhat

microlens-mtl/src/Lens/Micro/Mtl.hs

@@ -39,6 +39,7 @@ module Lens.Micro.Mtl
   (<<%=), (<<.=),
 
   -- * Zooming
+  Zoomed,
   zoom,
   magnify,
 )

microlens/src/Lens/Micro.hs

@@ -46,8 +46,11 @@ module Lens.Micro
   (?~),
   (<%~), (<<%~), (<<.~),
   mapped,
+  mapMOf,
   rewriteOf,
+  rewriteMOf,
   transformOf,
+  transformMOf,
 
   -- * Getter: extracts a value from a structure
   -- $getters-note
@@ -67,6 +70,10 @@ module Lens.Micro
   has,
   folded,
   folding,
+  foldMapOf,
+  anyOf,
+  allOf,
+  noneOf,
 
   -- * Lens: a combined getter-and-setter
   -- $lenses-note
@@ -95,6 +102,7 @@ module Lens.Micro
   _head, _tail, _init, _last,
   mapAccumLOf,
   worded, lined,
+  cosmosOf,
 
   -- * Prism: a traversal iterating over at most 1 element
   -- $prisms-note
@@ -459,6 +467,16 @@ mapped :: Functor f => ASetter (f a) (f b) a b
 mapped = sets fmap
 {-# INLINE mapped #-}
 
+{- |
+Map each element of a structure targeted by a Lens to a monadic action, evaluate these actions from left to right, and collect the results.
+
+>>> mapMOf both (\x -> [x, x + 1]) (1,3)
+[(1,3),(1,4),(2,3),(2,4)]
+-}
+mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
+mapMOf = coerce
+{-# INLINE mapMOf #-}
+
 {- |
 This is a version of ('%~') which modifies the structure and returns it along with the new value:
 
@@ -532,6 +550,17 @@ rewriteOf l f = go where
   go = transformOf l (\x -> maybe x go (f x))
 {-# INLINE rewriteOf #-}
 
+{- |
+Rewrite by applying a monadic rule everywhere you can. Ensures that the rule cannot be applied anywhere in the result.
+-}
+rewriteMOf
+    :: Monad m
+    => LensLike (WrappedMonad m) a b a b -> (b -> m (Maybe a)) -> a -> m b
+rewriteMOf l f = go
+  where
+    go = transformMOf l (\x -> f x >>= maybe (return x) go)
+{-# INLINE rewriteMOf #-}
+
 {- |
 Transform every element by recursively applying a given 'ASetter' in a bottom-up manner.
 
@@ -542,6 +571,16 @@ transformOf l f = go where
   go = f . over l go
 {-# INLINE transformOf #-}
 
+{- |
+Transform every element by recursively applying a given 'ASetter' in a bottom-up manner with a monadic effect.
+-}
+transformMOf
+    :: Monad m => LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b
+transformMOf l f = go
+  where
+    go t = mapMOf l go t >>= f
+{-# INLINE transformMOf #-}
+
 -- Getting -----------------------------------------------------------------
 
 {- $getters-note
@@ -777,6 +816,51 @@ folding :: F.Foldable f => (s -> f a) -> SimpleFold s a
 folding sfa agb = phantom . F.traverse_ agb . sfa
 {-# INLINE folding #-}
 
+{- |
+Returns 'True' if any value returned by a getter (any getter, including lenses,
+traversals, and folds) satisfies a predicate.
+
+>>> anyOf each (=='x') ['x','x']
+True
+>>> anyOf each (=='x') ['x','y']
+True
+>>> anyOf each (=='x') ['y','y']
+False
+-}
+anyOf :: Getting Any s a -> (a -> Bool) -> s -> Bool
+anyOf l f = getAny #. foldMapOf l (Any #. f)
+{-# INLINE anyOf #-}
+
+{- |
+Returns 'True' if any value returned by a getter (any getter, including lenses,
+traversals, and folds) satisfies a predicate.
+
+>>> allOf each (=='x') ['x','x']
+True
+>>> allOf each (=='x') ['x','y']
+False
+>>> allOf each (=='x') ['y','y']
+False
+-}
+allOf :: Getting All s a -> (a -> Bool) -> s -> Bool
+allOf l f = getAll #. foldMapOf l (All #. f)
+{-# INLINE allOf #-}
+
+{- |
+Returns 'True' if no value returned by a getter (any getter, including lenses,
+traversals, and folds) satisfies a predicate.
+
+>>> noneOf each (=='x') ['x','x']
+False
+>>> noneOf each (=='x') ['x','y']
+False
+>>> noneOf each (=='x') ['y','y']
+True
+-}
+noneOf :: Getting Any s a -> (a -> Bool) -> s -> Bool
+noneOf l f = not . anyOf l f
+{-# INLINE noneOf #-}
+
 -- Lenses ------------------------------------------------------------------
 
 {- $lenses-note
@@ -1299,6 +1383,13 @@ lined :: Traversal' String String
 lined f = fmap (intercalate "\n") . traverse f . lines
 {-# INLINE lined #-}
 
+{- |
+Given a Traversal that knows how to locate immediate children, traverse all of the transitive descendants of a node, including itself.
+-}
+cosmosOf :: Traversal a t a t -> Traversal a t a b'
+cosmosOf d f s = f s *> d (cosmosOf d f) s
+{-# INLINE cosmosOf #-}
+
 -- Prisms ------------------------------------------------------------------
 
 {- $prisms-note