Define variants of #1058 operators which return old result

As requested in
#1068 (review).

CHANGELOG.markdown

@@ -1,8 +1,16 @@
 next [????.??.??]
 -----------------
+* Define the following lenses that perform an operation and result the old
+ result:
+ * `(<<<>:~)` (prepend to the front via `(<>)` and return the old result)
+ * `(<<<|~)` (prepend to the front via `(<|)` and return the old result)
+ * `(<<|>~)` (append to the back via `(|>)` and return the old result)
+
+ Each of these also has a variant that end with `=` instead of `~` (e.g.,
+ `(<<<>:=)`) for working in a `MonadState` setting.
 * Re-export `(<>:~)`, `(<<>:~)`, `(<|~)`, `(<<|~)`, `(|>~)`, and `(<|>~)` (as
- well as their variants which end with `=` instead of `~`) from
- `Control.Lens.Operators`.
+ well as their variants which end with `=` instead of `~`, and their variants
+ which return the old result) from `Control.Lens.Operators`.
 
 5.3.1 [2024.05.05]
 ------------------

src/Control/Lens/Combinators.hs

@@ -141,10 +141,16 @@ import Control.Lens hiding
  , (<>=)
  , (<>:~)
  , (<>:=)
+ , (<<>:~)
+ , (<<>:=)
  , (<|~)
  , (<|=)
+ , (<<|~)
+ , (<<|=)
  , (|>~)
  , (|>=)
+ , (<|>~)
+ , (<|>=)
  , (%@~)
  , (%@=)
  , (:>)

src/Control/Lens/Cons.hs

@@ -27,15 +27,15 @@ module Control.Lens.Cons
  , cons
  , uncons
  , _head, _tail
- , (<|~), (<|=), (<<|~), (<<|=)
+ , (<|~), (<|=), (<<|~), (<<|=), (<<<|~), (<<<|=)
  , pattern (:<)
  -- * Snoc
  , Snoc(..)
  , (|>)
  , snoc
  , unsnoc
  , _init, _last
- , (|>~), (|>=), (<|>~), (<|>=)
+ , (|>~), (|>=), (<|>~), (<|>=), (<<|>~), (<<|>=)
  , pattern (:>)
 
  ) where
@@ -82,8 +82,8 @@ import Prelude
 
 infixr 5 <|, `cons`
 infixl 5 |>, `snoc`
-infixr 4 <|~, |>~, <<|~, <|>~
-infix 4 <|=, |>=, <<|=, <|>=
+infixr 4 <|~, |>~, <<|~, <|>~, <<<|~, <<|>~
+infix 4 <|=, |>=, <<|=, <|>=, <<<|=, <<|>=
 
 pattern (:<) :: Cons b b a a => a -> b -> b
 pattern (:<) a s <- (preview _Cons -> Just (a,s)) where
@@ -351,6 +351,14 @@ l <|= a = State.modify (l <|~ a)
 l <<|~ m = l <%~ (m <|)
 {-# INLINE (<<|~) #-}
 
+-- | ('<|') a 'Cons' value onto the end of the target of a 'Lens' and
+-- return the /old/ result.
+--
+-- When you do not need the result of the operation, ('Control.Lens.Cons.<|~') is more flexible.
+(<<<|~) :: Cons b b a a => LensLike' ((,) b) s b -> a -> s -> (b, s)
+l <<<|~ m = l <<%~ (m <|)
+{-# INLINE (<<<|~) #-}
+
 -- | ('<|') a 'Semigroup' value onto the end of the target of a 'Lens' into
 -- your 'Monad''s state and return the result.
 --
@@ -359,6 +367,14 @@ l <<|~ m = l <%~ (m <|)
 l <<|= r = l <%= (r <|)
 {-# INLINE (<<|=) #-}
 
+-- | ('<|') a 'Semigroup' value onto the end of the target of a 'Lens' into
+-- your 'Monad''s state and return the /old/ result.
+--
+-- When you do not need the result of the operation, ('Control.Lens.Cons.<|=') is more flexible.
+(<<<|=) :: (MonadState s m, Cons b b a a) => LensLike ((,) b) s s b b -> a -> m b
+l <<<|= r = l <<%= (r <|)
+{-# INLINE (<<<|=) #-}
+
 ------------------------------------------------------------------------------
 -- Snoc
 ------------------------------------------------------------------------------
@@ -596,10 +612,26 @@ l |>= a = State.modify (l |>~ a)
 l <|>~ m = l <%~ (|> m)
 {-# INLINE (<|>~) #-}
 
+-- | ('|>') a 'Cons' value onto the end of the target of a 'Lens' and
+-- return the /old/ result.
+--
+-- When you do not need the result of the operation, ('Control.Lens.Cons.|>~') is more flexible.
+(<<|>~) :: Snoc b b p p => LensLike' ((,) b) s b -> p -> s -> (b, s)
+l <<|>~ m = l <<%~ (|> m)
+{-# INLINE (<<|>~) #-}
+
 -- | ('|>') a 'Semigroup' value onto the end of the target of a 'Lens' into
 -- your 'Monad''s state and return the result.
 --
 -- When you do not need the result of the operation, ('Control.Lens.Cons.|>=') is more flexible.
 (<|>=) :: (MonadState s m, Snoc b b p p) => LensLike ((,) b) s s b b -> p -> m b
 l <|>= r = l <%= (|> r)
 {-# INLINE (<|>=) #-}
+
+-- | ('|>') a 'Semigroup' value onto the end of the target of a 'Lens' into
+-- your 'Monad''s state and return the result.
+--
+-- When you do not need the result of the operation, ('Control.Lens.Cons.|>=') is more flexible.
+(<<|>=) :: (MonadState s m, Snoc b b p p) => LensLike ((,) b) s s b b -> p -> m b
+l <<|>= r = l <<%= (|> r)
+{-# INLINE (<<|>=) #-}

src/Control/Lens/Lens.hs

@@ -90,15 +90,15 @@ module Control.Lens.Lens
  , (<||~), (<&&~), (<<>~), (<<>:~)
  , (<<%~), (<<.~), (<<?~), (<<+~), (<<-~), (<<*~)
  , (<<//~), (<<^~), (<<^^~), (<<**~)
- , (<<||~), (<<&&~), (<<<>~)
+ , (<<||~), (<<&&~), (<<<>~), (<<<>:~)
 
  -- * Setting State with Passthrough
  , (<%=), (<+=), (<-=), (<*=), (<//=)
  , (<^=), (<^^=), (<**=)
  , (<||=), (<&&=), (<<>=), (<<>:=)
  , (<<%=), (<<.=), (<<?=), (<<+=), (<<-=), (<<*=)
  , (<<//=), (<<^=), (<<^^=), (<<**=)
- , (<<||=), (<<&&=), (<<<>=)
+ , (<<||=), (<<&&=), (<<<>=), (<<<>:=)
  , (<<~)
 
  -- * Cloning Lenses
@@ -164,9 +164,9 @@ import GHC.Exts (TYPE)
 
 infixl 8 ^#
 infixr 4 %%@~, <%@~, <<%@~, %%~, <+~, <*~, <-~, <//~, <^~, <^^~, <**~, <&&~, <||~, <<>~, <<>:~, <%~, <<%~, <<.~, <<?~, <#~, #~, #%~, <#%~, #%%~
- , <<+~, <<-~, <<*~, <<//~, <<^~, <<^^~, <<**~, <<||~, <<&&~, <<<>~
+ , <<+~, <<-~, <<*~, <<//~, <<^~, <<^^~, <<**~, <<||~, <<&&~, <<<>~, <<<>:~
 infix 4 %%@=, <%@=, <<%@=, %%=, <+=, <*=, <-=, <//=, <^=, <^^=, <**=, <&&=, <||=, <<>=, <<>:=, <%=, <<%=, <<.=, <<?=, <#=, #=, #%=, <#%=, #%%=
- , <<+=, <<-=, <<*=, <<//=, <<^=, <<^^=, <<**=, <<||=, <<&&=, <<<>=
+ , <<+=, <<-=, <<*=, <<//=, <<^=, <<^^=, <<**=, <<||=, <<&&=, <<<>=, <<<>:=
 infixr 2 <<~
 infixl 1 ??, &~
 
@@ -1201,6 +1201,15 @@ l <<>= r = l <%= (<> r)
 l <<>:~ m = l <%~ (m <>)
 {-# INLINE (<<>:~) #-}
 
+-- | ('<>') a 'Semigroup' value onto the front of the target of a 'Lens' and
+-- return the /old/ result.
+-- However, unlike ('<<>~'), it is prepended to the head side.
+--
+-- When you do not need the result of the operation, ('Control.Lens.Setter.<>:~') is more flexible.
+(<<<>:~) :: Semigroup m => LensLike' ((,)m) s m -> m -> s -> (m, s)
+l <<<>:~ m = l <<%~ (m <>)
+{-# INLINE (<<<>:~) #-}
+
 -- | ('<>') a 'Semigroup' value onto the front of the target of a 'Lens' into
 -- your 'Monad''s state and return the result.
 -- However, unlike ('<<>='), it is prepended to the head side.
@@ -1210,6 +1219,15 @@ l <<>:~ m = l <%~ (m <>)
 l <<>:= r = l <%= (r <>)
 {-# INLINE (<<>:=) #-}
 
+-- | ('<>') a 'Semigroup' value onto the front of the target of a 'Lens' into
+-- your 'Monad''s state and return the /old/ result.
+-- However, unlike ('<<<>='), it is prepended to the head side.
+--
+-- When you do not need the result of the operation, ('Control.Lens.Setter.<>:=') is more flexible.
+(<<<>:=) :: (MonadState s m, Semigroup r) => LensLike' ((,)r) s r -> r -> m r
+l <<<>:= r = l <<%= (r <>)
+{-# INLINE (<<<>:=) #-}
+
 ------------------------------------------------------------------------------
 -- Arrow operators
 ------------------------------------------------------------------------------

src/Control/Lens/Operators.hs

@@ -22,10 +22,14 @@ module Control.Lens.Operators
  , (<|=)
  , (<<|~)
  , (<<|=)
+ , (<<<|~)
+ , (<<<|=)
  , (|>~)
  , (|>=)
  , (<|>~)
  , (<|>=)
+ , (<<|>~)
+ , (<<|>=)
  -- * "Control.Lens.Fold"
  , (^..)
  , (^?)
@@ -70,6 +74,7 @@ module Control.Lens.Operators
  , (<<||~)
  , (<<&&~)
  , (<<<>~)
+ , (<<<>:~)
  , (<%=)
  , (<+=)
  , (<-=)
@@ -93,6 +98,7 @@ module Control.Lens.Operators
  , (<<||=)
  , (<<&&=)
  , (<<<>=)
+ , (<<<>:=)
  , (<<~)
  , (<<>~)
  , (<<>=)

tests/hunit.hs

@@ -292,15 +292,35 @@ case_snoc_to_state_record_field_and_access_new_value =
  trig' = trig { _points = (trig & _points) `snoc` origin }
 
 case_append_to_record_field_and_access_old_value =
- (trig & points <<%~ (<>[origin]))
+ (trig & points <<<>~ [ origin ])
  @?= (_points trig, trig { _points = (trig & _points) <> [ origin ] })
 
 case_append_to_state_record_field_and_access_old_value = do
  runState test trig @?= (_points trig, trig')
  where
- test = points <<%= (<>[origin])
+ test = points <<<>= [ origin ]
  trig' = trig { _points = (trig & _points) <> [ origin ] }
 
+case_cons_to_record_field_and_access_old_value =
+ (trig & points <<<|~ origin)
+ @?= (_points trig, trig { _points = origin : (trig & _points) })
+
+case_cons_to_state_record_field_and_access_old_value =
+ runState test trig @?= (_points trig, trig')
+ where
+ test = points <<<|= origin
+ trig' = trig { _points = origin : (trig & _points) }
+
+case_snoc_to_record_field_and_access_old_value =
+ (trig & points <<|>~ origin)
+ @?= (_points trig, trig { _points = (trig & _points) `snoc` origin })
+
+case_snoc_to_state_record_field_and_access_old_value =
+ runState test trig @?= (_points trig, trig')
+ where
+ test = points <<|>= origin
+ trig' = trig { _points = (trig & _points) `snoc` origin }
+
 case_read_maybe_map_entry = trig^.labels.at origin @?= Just "Origin"
 
 case_read_maybe_state_map_entry =
@@ -399,6 +419,10 @@ main = defaultMain
  , testCase "snoc to state record field and access new value" case_snoc_to_state_record_field_and_access_new_value
  , testCase "append to record field and access old value" case_append_to_record_field_and_access_old_value
  , testCase "append to state record field and access old value" case_append_to_state_record_field_and_access_old_value
+ , testCase "cons to record field and access old value" case_cons_to_record_field_and_access_old_value
+ , testCase "cons to state record field and access old value" case_cons_to_state_record_field_and_access_old_value
+ , testCase "snoc to record field and access old value" case_snoc_to_record_field_and_access_old_value
+ , testCase "snoc to state record field and access old value" case_snoc_to_state_record_field_and_access_old_value
  , testCase "read maybe map entry" case_read_maybe_map_entry
  , testCase "read maybe state map entry" case_read_maybe_state_map_entry
  , testCase "read map entry" case_read_map_entry