Add strict traversal operations

* Add `strictly` to turn a lazy (standard) traversal into a strict one
  that forces targets before installing them.
* Add `over'`, `iover'`, `modifying'`, `imodifying'`, and corresponding
  operators `%!~`, `%!@~`, `%!=`, and `%!@=`.
* Adjust documentation.

src/Control/Lens/Combinators.hs

@@ -107,6 +107,7 @@ import Control.Lens hiding
   , (...)
   , (#)
   , (%~)
+  , (%!~)
   , (.~)
   , (?~)
   , (<.~)
@@ -124,6 +125,7 @@ import Control.Lens hiding
   , (&&~)
   , (.=)
   , (%=)
+  , (%!=)
   , (?=)
   , (+=)
   , (-=)
@@ -140,7 +142,9 @@ import Control.Lens hiding
   , (<>~)
   , (<>=)
   , (%@~)
+  , (%!@~)
   , (%@=)
+  , (%!@=)
   , (:>)
   , (:<)
   )

src/Control/Lens/Internal/Setter.hs

@@ -49,6 +49,15 @@ instance Settable Identity where
   taintedDot = (Identity #.)
   {-# INLINE taintedDot #-}
 
+-- CAUTION: While Data.Tuple.Solo may *look* a lot like Identity, and while we
+-- *could* give it a Settable instance, we probably do not want to do so. In
+-- particular, if we did, then Control.Lens.Traversal.over' would "work" with
+-- Setters. But ... it wouldn't *actually* work; the mapping would end up being
+-- lazy when it's supposed to be strict. Similarly, the BoxT applicative
+-- transformer must not be made Settable, because that would cause a similarly
+-- confusing problem with Control.Lens.Traversal.strictly. There is not, as
+-- yet, any compelling reason to write such an instance, so let's not.
+
 -- | 'Control.Lens.Fold.backwards'
 instance Settable f => Settable (Backwards f) where
   untainted = untaintedDot forwards

src/Control/Lens/Setter.hs

@@ -342,9 +342,12 @@ cloneIndexedSetter l pafb = taintedDot (runIdentity #. l (Indexed $ \i -> Identi
 -- >>> over _1 show (10,20)
 -- ("10",20)
 --
+--
 -- Like 'fmap', @over@ is normally lazy in the result(s) of calling the
--- function, which can cause space leaks under some circumstances. For a strict
--- version, see `Control.Lens.Traversal.over'`.
+-- function, which can cause space leaks in lazy fields, or when using
+-- 'Control.Lens.At.ix' for value-lazy structures like 'Data.Sequence.Seq',
+-- 'Data.Map.Map', 'Data.IntMap.IntMap', or 'Data.Array.Array'.  For a strict
+-- version, see `Control.Lens.Traversal.iover'`.
 --
 -- @
 -- 'over' :: 'Setter' s t a b -> (a -> b) -> s -> t
@@ -1174,8 +1177,11 @@ ilocally l f = Reader.local (iover l f)
 -- @
 --
 -- Like 'Data.Functor.WithIndex.imap', @iover@ is normally lazy in the
--- result(s) of calling the function, which can cause space leaks under some
--- circumstances. For a strict version, see `Control.Lens.Traversal.iover'`.
+-- result(s) of calling the function, which can cause space leaks in lazy
+-- fields, or when using 'Control.Lens.At.ix' for value-lazy structures like
+-- 'Data.Sequence.Seq', 'Data.Map.Map', 'Data.IntMap.IntMap', or
+-- 'Data.Array.Array'.  For a strict version, see
+-- `Control.Lens.Traversal.iover'`.
 --
 -- @
 -- 'iover' :: 'IndexedSetter' i s t a b    -> (i -> a -> b) -> s -> t

src/Control/Lens/Traversal.hs

@@ -1,11 +1,16 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ConstraintKinds #-}
 
 #include "lens-common.h"
@@ -62,7 +67,6 @@ module Control.Lens.Traversal
   , mapAccumLOf, mapAccumROf
   , scanr1Of, scanl1Of
   , failover, ifailover
-  , over', iover'
 
   -- * Monomorphic Traversals
   , cloneTraversal
@@ -114,6 +118,17 @@ module Control.Lens.Traversal
   , imapAccumROf
   , imapAccumLOf
 
+  -- ** Strict traversals
+  , over'
+  , (%!~)
+  , iover'
+  , (%!@~)
+  , modifying'
+  , (%!=)
+  , imodifying'
+  , (%!@=)
+  , strictly
+
   -- * Reflection
   , traverseBy
   , traverseByOf
@@ -146,6 +161,8 @@ import Control.Lens.Lens
 import Control.Lens.Setter (ASetter, AnIndexedSetter, isets, sets)
 import Control.Lens.Type
 import Control.Monad.Trans.State.Lazy
+import Control.Monad.State.Class (MonadState)
+import qualified Control.Monad.State.Class as MonadState
 import Data.Bitraversable
 import Data.CallStack
 import Data.Functor.Apply
@@ -167,7 +184,7 @@ import Data.Tuple.Solo (Solo (..), getSolo)
 import GHC.Magic (inline)
 
 -- $setup
--- >>> :set -XNoOverloadedStrings -XFlexibleContexts
+-- >>> :set -XNoOverloadedStrings -XFlexibleContexts -XRankNTypes
 -- >>> import Data.Char (toUpper)
 -- >>> import Control.Applicative
 -- >>> import Control.Lens
@@ -185,6 +202,9 @@ import GHC.Magic (inline)
 -- >>> let firstAndThird :: Traversal (a, x, a) (b, x, b) a b; firstAndThird = traversal go where { go :: Applicative f => (a -> f b) -> (a, x, a) -> f (b, x, b); go focus (a, x, a') = liftA3 (,,) (focus a) (pure x) (focus a') }
 -- >>> let selectNested :: Traversal (x, [a]) (x, [b]) a b; selectNested = traversal go where { go :: Applicative f => (a -> f b) -> (x, [a]) -> f (x, [b]); go focus (x, as) = liftA2 (,) (pure x) (traverse focus as) }
 
+infixr 4 %!~, %!@~
+infix  4 %!=, %!@=
+
 ------------------------------------------------------------------------------
 -- Traversals
 ------------------------------------------------------------------------------
@@ -1471,25 +1491,170 @@ sequenceByOf l pur app = reifyApplicative pur app (l ReflectedApplicative)
 
 -- | A version of 'Control.Lens.Setter.over' that forces the result(s) of
 -- applying the function. This can prevent space leaks when modifying lazy
--- fields.
---
--- @
--- over traverse (const ⊥) [1,2] = [⊥, ⊥]
--- over' traverse (const ⊥) [1,2] = ⊥
--- @
+-- fields. See also 'strictly'.
 --
 -- @
 -- over' :: 'Lens' s t a b -> (a -> b) -> s -> t
 -- over' :: 'Traversal' s t a b -> (a -> b) -> s -> t
 -- @
+--
+-- >>> length $ over traverse id [undefined, undefined]
+-- 2
+--
+-- >>> over' traverse id [1, undefined :: Int]
+-- *** Exception: Prelude.undefined
+-- ...
 over' :: LensLike Solo s t a b -> (a -> b) -> s -> t
 over' l f = getSolo . l (\old -> Solo $! f old)
+{-# INLINE over' #-}
+
+-- | Traverse targets strictly. This is the operator version of 'over''.
+(%!~) :: LensLike Solo s t a b -> (a -> b) -> s -> t
+(%!~) = over'
+{-# INLINE (%!~) #-}
+
+-- $
+-- >>> :{
+-- let lover' :: Lens s t a b -> (a -> b) -> s -> t
+--     lover' l = over' l
+--     tover' :: Traversal s t a b -> (a -> b) -> s -> t
+--     tover' l = over' l
+-- :}
+--
+-- >>> :{
+-- let sover' :: Setter s t a b -> (a -> b) -> s -> t
+--     sover' l = over' l
+-- :}
+-- ...
+-- ...error...
+-- ...
 
 -- | A version of 'Control.Lens.Setter.iover' that forces the result(s) of
 -- applying the function. Alternatively, an indexed version of `over'`.
+-- See also 'strictly'.
+--
 -- @
--- iover' :: 'IndexedLens' s t a b -> (a -> b) -> s -> t
--- iover' :: 'IndexedTraversal' s t a b -> (a -> b) -> s -> t
+-- iover' :: IndexedLens i s t a b -> (i -> a -> b) -> s -> t
+-- iover' :: IndexedTraversal i s t a b -> (i -> a -> b) -> s -> t
 -- @
 iover' :: Over (Indexed i) Solo s t a b -> (i -> a -> b) -> s -> t
 iover' l f = getSolo . l (Indexed $ \i a -> Solo $! f i a)
+{-# INLINE iover' #-}
+
+-- | Traverse targets strictly with indices. This is the operator version of
+-- 'iover''.
+(%!@~) :: Over (Indexed i) Solo s t a b -> (i -> a -> b) -> s -> t
+(%!@~) = iover'
+{-# INLINE (%!@~) #-}
+
+-- | Modify the state strictly. This is stricter than
+-- @Control.Lens.Setter.modifying@ in two ways: it forces the new value of the
+-- state, and it forces the new value of the target within the state.
+modifying' :: MonadState s m => LensLike Solo s s a b -> (a -> b) -> m ()
+modifying' l f = do
+  s <- MonadState.get
+  let !(Solo !t) = l (\old -> Solo $! f old) s
+  MonadState.put t
+{-# INLINE modifying' #-}
+
+-- | Modify the state strictly. This is an operator version of
+-- 'modifying''.
+(%!=) :: MonadState s m => LensLike Solo s s a b -> (a -> b) -> m ()
+(%!=) = modifying'
+{-# INLINE (%!=) #-}
+
+-- | Modify the state strictly with an index. This is stricter than
+-- @Control.Lens.Setter.imodifying@ in two ways: it forces the new value of the
+-- state, and it forces the new value of the target within the state.
+imodifying' :: MonadState s m => Over (Indexed i) Solo s s a b -> (i -> a -> b) -> m ()
+imodifying' l f = do
+  s <- MonadState.get
+  let !(Solo !t) = l (Indexed $ \i old -> Solo $! f i old) s
+  MonadState.put t
+{-# INLINE imodifying' #-}
+
+-- | Modify the state strictly. This is an operator version of
+-- 'imodifying''.
+(%!@=) :: MonadState s m => Over (Indexed i) Solo s s a b -> (i -> a -> b) -> m ()
+(%!@=) = imodifying'
+{-# INLINE (%!@=) #-}
+
+-- $
+-- >>> :{
+-- let liover' :: IndexedLens i s t a b -> (i -> a -> b) -> s -> t
+--     liover' l = iover' l
+--     tiover' :: IndexedTraversal i s t a b -> (i -> a -> b) -> s -> t
+--     tiover' l = iover' l
+-- :}
+
+-- | Use an optic /strictly/. @strictly l f s@ will force the results of /all/
+-- the targets of @l@ before producing a new value. It does not affect folds or
+-- getters. Note that producing an optic using 'strictly' will not necessarily
+-- produce one even nearly as efficient as what could be written by hand,
+-- although it will do so in simple enough situations. Be particularly careful
+-- when working over many targets in a functor other than the usual 'Identity'
+-- or @'Const' c@; things may go very well or rather badly.
+--
+-- @
+-- 'over'' l = 'Control.Lens.Setter.over' (strictly l)
+-- 'iover'' l = 'Control.Lens.Setter.iover' (strictly l)
+-- @
+--
+-- @
+-- strictly :: 'Traversal' s t a b -> 'Traversal' s t a b
+-- strictly :: 'IndexedTraversal' i s t a b -> 'IndexedTraversal' i s t a b
+-- @
+strictly :: (Functor f, Profunctor p, Profunctor q) => Optical p q (BoxT f) s t a b -> Optical p q f s t a b
+strictly l f = rmap (fmap getSolo .# runBoxT) $ l (rmap (BoxT #. fmap (Solo $!)) f)
+{-# INLINE strictly #-}
+
+-- $
+-- >>> :{
+-- let tstrictly :: Traversal s t a b -> Traversal s t a b
+--     tstrictly l = strictly l
+--     itstrictly :: AnIndexedTraversal i s t a b -> IndexedTraversal i s t a b
+--     itstrictly l = strictly (cloneIndexedTraversal l)
+--     lstrictly :: Lens s t a b -> Lens s t a b
+--     lstrictly l = strictly l
+--     ilstrictly :: AnIndexedLens i s t a b -> IndexedLens i s t a b
+--     ilstrictly l = strictly (cloneIndexedLens l)
+--     fstrictly :: Fold s a -> Fold s a
+--     fstrictly l = strictly l
+-- :}
+--
+-- >>> :{
+-- let sstrictly :: Setter s t a b -> Setter s t a b
+--     sstrictly l = strictly l
+-- :}
+-- ...
+-- ...Settable ...BoxT...
+-- ...
+
+-- | A very simple applicative transformer that gives us more control over when
+-- things get forced. Note: this type /should not/ be made an instance of
+-- @Settable@, because then users could accidentally use 'strictly' with a
+-- 'Setter', which will not work at all. There is no way to strictify a
+-- 'Setter'.
+newtype BoxT f a = BoxT
+  { runBoxT :: f (Solo a) }
+  deriving (Functor, Foldable, Traversable)
+
+-- The Contravariant instance allows `strictly` to be used on a getter or fold.
+-- It's not at all obvious that this is *useful* (since `strictly` doesn't
+-- change these at all), but it's also not obviously *harmful*.
+instance Contravariant f => Contravariant (BoxT f) where
+  contramap f (BoxT m) = BoxT $ contramap (fmap f) m
+instance Apply f => Apply (BoxT f) where
+  liftF2 f (BoxT m) (BoxT n) = BoxT (liftF2 (liftA2 f) m n)
+  {-# INLINE liftF2 #-}
+instance Applicative f => Applicative (BoxT f) where
+  pure = BoxT . pure . Solo
+  {-# INLINE pure #-}
+  BoxT m <*> BoxT n = BoxT (liftA2 (<*>) m n)
+  {-# INLINE (<*>) #-}
+#if MIN_VERSION_base(4,10,0)
+  liftA2 f (BoxT m) (BoxT n) = BoxT (liftA2 (liftA2 f) m n)
+  {-# INLINE liftA2 #-}
+#endif
+  -- Caution: We *can't* implement *> or <* in terms of the underlying *> and
+  -- <*. We need to force the Solos, not discard them.