Skip to content

Commit

Permalink
Add strict over variants
Browse files Browse the repository at this point in the history
Add `over'` and `iover'`, which force the result(s) of applying
the passed function.

Closes #1016
  • Loading branch information
treeowl committed Dec 21, 2022
1 parent a901d6e commit dae984d
Show file tree
Hide file tree
Showing 3 changed files with 36 additions and 0 deletions.
1 change: 1 addition & 0 deletions lens.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -190,6 +190,7 @@ library
indexed-traversable-instances >= 0.1 && < 0.2,
kan-extensions >= 5 && < 6,
mtl >= 2.2.1 && < 2.4,
OneTuple >= 0.3 && < 0.4,
parallel >= 3.2.1.0 && < 3.3,
profunctors >= 5.5.2 && < 6,
reflection >= 2.1 && < 3,
Expand Down
8 changes: 8 additions & 0 deletions src/Control/Lens/Setter.hs
Original file line number Diff line number Diff line change
Expand Up @@ -342,6 +342,10 @@ 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'`.
--
-- @
-- 'over' :: 'Setter' s t a b -> (a -> b) -> s -> t
-- 'over' :: 'ASetter' s t a b -> (a -> b) -> s -> t
Expand Down Expand Up @@ -1169,6 +1173,10 @@ ilocally l f = Reader.local (iover l f)
-- 'iover' l ≡ 'over' l '.' 'Indexed'
-- @
--
-- 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'`.
--
-- @
-- 'iover' :: 'IndexedSetter' i s t a b -> (i -> a -> b) -> s -> t
-- 'iover' :: 'IndexedLens' i s t a b -> (i -> a -> b) -> s -> t
Expand Down
27 changes: 27 additions & 0 deletions src/Control/Lens/Traversal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,7 @@ module Control.Lens.Traversal
, mapAccumLOf, mapAccumROf
, scanr1Of, scanl1Of
, failover, ifailover
, over', iover'

-- * Monomorphic Traversals
, cloneTraversal
Expand Down Expand Up @@ -162,6 +163,7 @@ import Data.Reflection
import Data.Semigroup.Traversable
import Data.Semigroup.Bitraversable
import Data.Tuple (swap)
import Data.Tuple.Solo (Solo (..), getSolo)
import GHC.Magic (inline)

-- $setup
Expand Down Expand Up @@ -1466,3 +1468,28 @@ traverseByOf l pur app f = reifyApplicative pur app (l (ReflectedApplicative #.
-- @
sequenceByOf :: Traversal s t (f b) b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> s -> f t
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] = ⊥
-- @
--
-- @
-- over' :: 'Lens' s t a b -> (a -> b) -> s -> t
-- over' :: 'Traversal' s t a b -> (a -> b) -> s -> t
-- @
over' :: LensLike Solo s t a b -> (a -> b) -> s -> t
over' l f = getSolo . l (\old -> Solo $! f old)

-- | A version of 'Control.Lens.Setter.iover' that forces the result(s) of
-- applying the function. Alternatively, an indexed version of `over'`.
-- @
-- iover' :: 'IndexedLens' s t a b -> (a -> b) -> s -> t
-- iover' :: 'IndexedTraversal' s t a b -> (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)

0 comments on commit dae984d

Please sign in to comment.