feat: add: <<|~, <<|=, <|>~, <|>=

Add Cons operators of "with result" variants.

src/Control/Lens/Cons.hs

@@ -27,21 +27,22 @@ module Control.Lens.Cons
  , cons
  , uncons
  , _head, _tail
- , (<|~), (<|=)
+ , (<|~), (<|=), (<<|~), (<<|=)
  , pattern (:<)
  -- * Snoc
  , Snoc(..)
  , (|>)
  , snoc
  , unsnoc
  , _init, _last
- , (|>~), (|>=)
+ , (|>~), (|>=), (<|>~), (<|>=)
  , pattern (:>)
 
  ) where
 
 import Control.Lens.Equality (simply)
 import Control.Lens.Fold
+import Control.Lens.Lens
 import Control.Lens.Prism
 import Control.Lens.Review
 import Control.Lens.Setter
@@ -81,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
@@ -342,6 +343,22 @@ l <|~ n = over l (n <|)
 l <|= a = State.modify (l <|~ a)
 {-# INLINE (<|=) #-}
 
+-- | ('<|') a 'Cons' value onto the end of the target of a 'Lens' and
+-- return the 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 t b b -> a -> s -> (b, t)
+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, Cons b b a a) => LensLike ((,) b) s s b b -> a -> m b
+l <<|= r = l <%= (r <|)
+{-# INLINE (<<|=) #-}
+
 ------------------------------------------------------------------------------
 -- Snoc
 ------------------------------------------------------------------------------
@@ -570,3 +587,19 @@ l |>~ n = over l (|> n)
 (|>=) :: (MonadState s m, Snoc b b a a) => ASetter s s b b -> a -> m ()
 l |>= a = State.modify (l |>~ a)
 {-# INLINE (|>=) #-}
+
+-- | ('|>') a 'Cons' value onto the end of the target of a 'Lens' and
+-- return the 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 t b b -> p -> s -> (b, t)
+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 (<|>=) #-}

tests/hunit.hs

@@ -261,6 +261,16 @@ case_cons_to_state_record_field = do
  test = points <|= origin
  trig' = trig { _points = origin : (trig & _points) }
 
+case_cons_to_record_field_and_access_new_value =
+ (trig & points <<|~ origin)
+ @?= (origin : _points trig, trig { _points = origin : (trig & _points) })
+
+case_cons_to_state_record_field_and_access_new_value =
+ runState test trig @?= ([ origin ] <> _points trig, trig')
+ where
+ test = points <<|= origin
+ trig' = trig { _points = origin : (trig & _points) }
+
 case_snoc_to_record_field =
  (trig & points |>~ origin)
  @?= trig { _points = (trig & _points) `snoc` origin }
@@ -271,6 +281,16 @@ case_snoc_to_state_record_field = do
  test = points |>= origin
  trig' = trig { _points = (trig & _points) `snoc` origin }
 
+case_snoc_to_record_field_and_access_new_value =
+ (trig & points <|>~ origin)
+ @?= ([ origin ] <> _points trig, trig { _points = (trig & _points) `snoc` origin })
+
+case_snoc_to_state_record_field_and_access_new_value =
+ runState test trig @?= ([ origin ] <> _points trig, trig')
+ where
+ test = points <|>= origin
+ trig' = trig { _points = (trig & _points) `snoc` origin }
+
 case_append_to_record_field_and_access_old_value =
  (trig & points <<%~ (<>[origin]))
  @?= (_points trig, trig { _points = (trig & _points) <> [ origin ] })
@@ -373,6 +393,10 @@ main = defaultMain
  , testCase "append to state record field and access new value" case_append_to_state_record_field_and_access_new_value
  , testCase "prepend to record field and access new value" case_prepend_to_record_field_and_access_new_value
  , testCase "prepend to state record field and access new value" case_prepend_to_state_record_field_and_access_new_value
+ , testCase "cons to record field and access new value" case_cons_to_record_field_and_access_new_value
+ , testCase "cons to state record field and access new value" case_cons_to_state_record_field_and_access_new_value
+ , testCase "snoc to record field and access new value" case_snoc_to_record_field_and_access_new_value
+ , 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 "read maybe map entry" case_read_maybe_map_entry