Re-export #1058 operators from Control.Lens.Operators, fix incorrect documentation

CHANGELOG.markdown

@@ -1,3 +1,17 @@
+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 `~`, and their variants
+  which return the old result) from `Control.Lens.Operators`.
+
 5.3.1 [2024.05.05]
 ------------------
 * Add a `Magnify` instance for the CPS variant of `RWST` when building with
@@ -16,7 +30,7 @@
   * Add a `_SCCP` `Prism` for the `Pragma` data type.
 * Add the following `Setter`s for prepending and appending elements:
   * `(<>:~)`: prepend an element to the front via `(<>)`.
-  * `(<<>:~)`: append an element to the back via `(<>)`.
+  * `(<<>:~)`: prepend an element to the front via `(<>)` and return the result.
   * `(<|~)`: cons an element to the front via `(<|)`.
   * `(<<|~)`: cons an element to the front via `(<|)` and return the result.
   * `(|>~)`: snoc an element to the back via `(|>)`.

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 ??, &~
 
@@ -1192,24 +1192,42 @@ l <<>~ m = l <%~ (<> m)
 l <<>= r = l <%= (<> r)
 {-# INLINE (<<>=) #-}
 
--- | ('<>') a 'Semigroup' value onto the end of the target of a 'Lens' and
+-- | ('<>') a 'Semigroup' value onto the front of the target of a 'Lens' and
 -- return the result.
--- However, unlike '<<>~', it is prepend to the head side.
+-- 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 t m m -> m -> s -> (m, t)
+(<<>:~) :: Semigroup m => LensLike ((,) m) s t m m -> m -> s -> (m, t)
 l <<>:~ m = l <%~ (m <>)
 {-# INLINE (<<>:~) #-}
 
--- | ('<>') a 'Semigroup' value onto the end of the target of a 'Lens' into
+-- | ('<>') 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 prepend to the head side.
+-- 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
+(<<>:=) :: (MonadState s m, Semigroup r) => LensLike' ((,) r) s r -> r -> m r
 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

@@ -18,6 +18,18 @@ module Control.Lens.Operators
   -- * "Control.Lens.Cons"
     (<|)
   , (|>)
+  , (<|~)
+  , (<|=)
+  , (<<|~)
+  , (<<|=)
+  , (<<<|~)
+  , (<<<|=)
+  , (|>~)
+  , (|>=)
+  , (<|>~)
+  , (<|>=)
+  , (<<|>~)
+  , (<<|>=)
   -- * "Control.Lens.Fold"
   , (^..)
   , (^?)
@@ -62,6 +74,7 @@ module Control.Lens.Operators
   , (<<||~)
   , (<<&&~)
   , (<<<>~)
+  , (<<<>:~)
   , (<%=)
   , (<+=)
   , (<-=)
@@ -85,9 +98,12 @@ module Control.Lens.Operators
   , (<<||=)
   , (<<&&=)
   , (<<<>=)
+  , (<<<>:=)
   , (<<~)
   , (<<>~)
   , (<<>=)
+  , (<<>:~)
+  , (<<>:=)
   , (<%@~)
   , (<<%@~)
   , (%%@~)
@@ -141,6 +157,8 @@ 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