From 15f94a012e78232b021fbca15d232be660c6b052 Mon Sep 17 00:00:00 2001 From: ncaq Date: Fri, 1 Mar 2024 21:47:54 +0900 Subject: [PATCH 1/4] feat(Setter): add: prepends setter Add a setter that prepends the element, like `cons`. For balance, we also add a setter that also appends the element to the tail, like `snoc`. We often use this when adding elements to list structures and other order-conscious things. When we are doing natural language processing, for example, and we are adding processed data, it is more natural to add the resulting processed data to the head side if the original input source is closer to the head. Naturally we can also construct the processing by adding the tail if we think hard enough, but we don't want to work hard at that since we only need to prepare a function. The naming of the `<>:~` function was lost with `~<>`, but considering that the `~` symbol in the lenses setter operator is basically on the right, I used the `:` operator to indicate that it is closer to the `cons` of the list, rather than focusing on the contrast. --- src/Control/Lens/Combinators.hs | 6 ++++ src/Control/Lens/Setter.hs | 55 ++++++++++++++++++++++++++++++--- tests/hunit.hs | 36 +++++++++++++++++++++ 3 files changed, 92 insertions(+), 5 deletions(-) diff --git a/src/Control/Lens/Combinators.hs b/src/Control/Lens/Combinators.hs index 4174ee661..07d7ac3cd 100644 --- a/src/Control/Lens/Combinators.hs +++ b/src/Control/Lens/Combinators.hs @@ -139,6 +139,12 @@ import Control.Lens hiding , (~) , (<>=) + , (<>:~) + , (<>:=) + , (<|~) + , (<|~) + , (|>~) + , (|>=) , (%@~) , (%@=) , (:>) diff --git a/src/Control/Lens/Setter.hs b/src/Control/Lens/Setter.hs index b2168cdf4..2ace40193 100644 --- a/src/Control/Lens/Setter.hs +++ b/src/Control/Lens/Setter.hs @@ -49,11 +49,11 @@ module Control.Lens.Setter , over , set , (.~), (%~) - , (+~), (-~), (*~), (//~), (^~), (^^~), (**~), (||~), (<>~), (&&~), (<.~), (?~), (~), (<>:~), (<|~), (|>~), (&&~), (<.~), (?~), (=), (&&=), (<.=), (?=), (=), (<>:=), (<|=), (|>=), (&&=), (<.=), (?=), (>> let setter :: Expr -> Expr -> Expr; setter = fun "setter" -- >>> :set -XNoOverloadedStrings -infixr 4 %@~, .@~, .~, +~, *~, -~, //~, ^~, ^^~, **~, &&~, <>~, ||~, %~, <.~, ?~, =, ||=, %=, <.=, ?=, ~, <>:~, <|~, |>~, ||~, %~, <.~, ?~, =, <>:=, <|=, |>=, ||=, %=, <.=, ?=, ~ n = over l (<> n) l <>= a = State.modify (l <>~ a) {-# INLINE (<>=) #-} +-- | Modify the target of a 'Semigroup' value by using @('<>')@. +-- However, unlike '<>~', it is prepend to the head side. +-- +-- >>> ["world"] & id <>:~ ["hello"] +-- ["hello","world"] +-- +-- >>> (["world"], ["lens"]) & _1 <>:~ ["hello"] +-- (["hello","world"],["lens"]) +(<>:~) :: Semigroup b => ASetter s t b b -> b -> s -> t +l <>:~ n = over l (n <>) +{-# INLINE (<>:~) #-} + +-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('<>')@. +-- However, unlike '<>=', it is prepend to the head side. +(<>:=) :: (MonadState s m, Semigroup a) => ASetter' s a -> a -> m () +l <>:= a = State.modify (l <>:~ a) +{-# INLINE (<>:=) #-} + +-- | Modify the target of a 'Cons' value by using @('<|')@. +-- +-- >>> (["world"], ["lens"]) & _1 <|~ "hello" +-- (["hello","world"],["lens"]) +(<|~) :: Cons b b a a => ASetter s t b b -> a -> s -> t +l <|~ n = over l (n <|) +{-# INLINE (<|~) #-} + +-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('<|')@. +(<|=) :: (MonadState s m, Cons b b a a) => ASetter s s b b -> a -> m () +l <|= a = State.modify (l <|~ a) +{-# INLINE (<|=) #-} + +-- | Modify the target of a 'Cons' value by using @('|>')@. +-- +-- >>> (["world"], ["lens"]) & _1 |>~ "hello" +-- (["world","hello"],["lens"]) +(|>~) :: Snoc b b a a => ASetter s t b b -> a -> s -> t +l |>~ n = over l (|> n) +{-# INLINE (|>~) #-} + +-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('|>')@. +(|>=) :: (MonadState s m, Snoc b b a a) => ASetter s s b b -> a -> m () +l |>= a = State.modify (l |>~ a) +{-# INLINE (|>=) #-} + ----------------------------------------------------------------------------- -- Writer Operations ----------------------------------------------------------------------------- diff --git a/tests/hunit.hs b/tests/hunit.hs index 15c502cb7..e9038f66b 100644 --- a/tests/hunit.hs +++ b/tests/hunit.hs @@ -221,6 +221,36 @@ case_append_to_state_record_field = do test = points <>= [ origin ] trig' = trig { _points = (trig & _points) <> [ origin ] } +case_prepend_to_record_field = + (trig & points <>:~ [ origin ]) + @?= trig { _points = [ origin ] <> (trig & _points) } + +case_prepend_to_state_record_field = do + runState test trig @?= ((), trig') + where + test = points <>:= [ origin ] + trig' = trig { _points = [ origin ] <> (trig & _points) } + +case_cons_to_record_field = + (trig & points <|~ origin) + @?= trig { _points = origin : (trig & _points) } + +case_cons_to_state_record_field = do + runState test 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 } + +case_snoc_to_state_record_field = do + runState test trig @?= ((), trig') + where + test = points |>= origin + trig' = trig { _points = (trig & _points) `snoc` origin } + case_append_to_record_field_and_access_new_value = (trig & points <<>~ [ origin ]) @?= (_points trig <> [ origin ], trig { _points = (trig & _points) <> [ origin ] }) @@ -323,6 +353,12 @@ main = defaultMain , testCase "increment state record field" case_increment_state_record_field , testCase "append to record field" case_append_to_record_field , testCase "append to state record field" case_append_to_state_record_field + , testCase "prepend to record field" case_prepend_to_record_field + , testCase "prepend to state record field" case_prepend_to_state_record_field + , testCase "cons to record field" case_cons_to_record_field + , testCase "cons to state record field" case_cons_to_state_record_field + , testCase "snoc to record field" case_snoc_to_record_field + , testCase "snoc to state record field" case_snoc_to_state_record_field , testCase "append to record field and access new value" case_append_to_record_field_and_access_new_value , testCase "append to state record field and access new value" case_append_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 From 451ade5b15b83bc2b6929d0af731d42b391ed43a Mon Sep 17 00:00:00 2001 From: ncaq Date: Wed, 6 Mar 2024 23:13:35 +0900 Subject: [PATCH 2/4] feat: add: `<<>:~` and `<<>:=` operators Add "with result" variants. Code review reflected. --- src/Control/Lens/Lens.hs | 26 ++++++++++++++++++++++---- tests/hunit.hs | 32 ++++++++++++++++++++++---------- 2 files changed, 44 insertions(+), 14 deletions(-) diff --git a/src/Control/Lens/Lens.hs b/src/Control/Lens/Lens.hs index 1a17be7f3..5e7ba202a 100644 --- a/src/Control/Lens/Lens.hs +++ b/src/Control/Lens/Lens.hs @@ -87,7 +87,7 @@ module Control.Lens.Lens -- * Setting Functionally with Passthrough , (<%~), (<+~), (<-~), (<*~), (~) + , (<||~), (<&&~), (<<>~), (<<>:~) , (<<%~), (<<.~), (<~) @@ -95,7 +95,7 @@ module Control.Lens.Lens -- * Setting State with Passthrough , (<%=), (<+=), (<-=), (<*=), (=) + , (<||=), (<&&=), (<<>=), (<<>:=) , (<<%=), (<<.=), (<=) @@ -163,9 +163,9 @@ import GHC.Exts (TYPE) -- >>> let setter :: Expr -> Expr -> Expr; setter = fun "setter" infixl 8 ^# -infixr 4 %%@~, <%@~, <<%@~, %%~, <+~, <*~, <-~, ~, <%~, <<%~, <<.~, <~, <<>:~, <%~, <<%~, <<.~, <~ -infix 4 %%@=, <%@=, <<%@=, %%=, <+=, <*=, <-=, =, <%=, <<%=, <<.=, <=, <<>:=, <%=, <<%=, <<.=, <= infixr 2 <<~ infixl 1 ??, &~ @@ -1192,6 +1192,24 @@ l <<>~ m = l <%~ (<> m) l <<>= r = l <%= (<> r) {-# INLINE (<<>=) #-} +-- | ('<>') a 'Semigroup' value onto the end of the target of a 'Lens' and +-- return the result. +-- However, unlike '<<>~', it is prepend 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) +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. +-- However, unlike '<<>=', it is prepend 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 ------------------------------------------------------------------------------ diff --git a/tests/hunit.hs b/tests/hunit.hs index e9038f66b..a5e683829 100644 --- a/tests/hunit.hs +++ b/tests/hunit.hs @@ -221,6 +221,16 @@ case_append_to_state_record_field = do test = points <>= [ origin ] trig' = trig { _points = (trig & _points) <> [ origin ] } +case_append_to_record_field_and_access_new_value = + (trig & points <<>~ [ origin ]) + @?= (_points trig <> [ origin ], trig { _points = (trig & _points) <> [ origin ] }) + +case_append_to_state_record_field_and_access_new_value = do + runState test trig @?= (_points trig <> [ origin ], trig') + where + test = points <<>= [ origin ] + trig' = trig { _points = (trig & _points) <> [ origin ] } + case_prepend_to_record_field = (trig & points <>:~ [ origin ]) @?= trig { _points = [ origin ] <> (trig & _points) } @@ -231,6 +241,16 @@ case_prepend_to_state_record_field = do test = points <>:= [ origin ] trig' = trig { _points = [ origin ] <> (trig & _points) } +case_prepend_to_record_field_and_access_new_value = + (trig & points <<>:~ [ origin ]) + @?= ([ origin ] <> _points trig, trig { _points = [ origin ] <> (trig & _points) }) + +case_prepend_to_state_record_field_and_access_new_value = do + runState test trig @?= ([ origin ] <> _points trig, trig') + where + test = points <<>:= [ origin ] + trig' = trig { _points = [ origin ] <> (trig & _points) } + case_cons_to_record_field = (trig & points <|~ origin) @?= trig { _points = origin : (trig & _points) } @@ -251,16 +271,6 @@ case_snoc_to_state_record_field = do test = points |>= origin trig' = trig { _points = (trig & _points) `snoc` origin } -case_append_to_record_field_and_access_new_value = - (trig & points <<>~ [ origin ]) - @?= (_points trig <> [ origin ], trig { _points = (trig & _points) <> [ origin ] }) - -case_append_to_state_record_field_and_access_new_value = do - runState test trig @?= (_points trig <> [ origin ], trig') - where - test = points <<>= [ origin ] - trig' = trig { _points = (trig & _points) <> [ origin ] } - case_append_to_record_field_and_access_old_value = (trig & points <<%~ (<>[origin])) @?= (_points trig, trig { _points = (trig & _points) <> [ origin ] }) @@ -361,6 +371,8 @@ main = defaultMain , testCase "snoc to state record field" case_snoc_to_state_record_field , testCase "append to record field and access new value" case_append_to_record_field_and_access_new_value , 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 "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 From 1c1295fdde342ff6f3446fd281bf3018a05b9ceb Mon Sep 17 00:00:00 2001 From: ncaq Date: Wed, 6 Mar 2024 23:25:54 +0900 Subject: [PATCH 3/4] refactor: move: Cons like operator from Setter to Cons What === Move `(<|~)`, `(<|=)`, `(|>~)`, `(|>=)` from `Control.Lens.Setter` to `Control.Lens.Cons`. Why === I try impl with result variants to `Control.Lens.Lens` like other. This requires the import of `Control.Lens.Cons` in `Control.Lens.Lens`. But it cause cycle import. So I decided to implement Cons-related operators with `Control.Lens.Cons`. --- src/Control/Lens/Cons.hs | 32 ++++++++++++++++++++++++++++++++ src/Control/Lens/Setter.hs | 35 ++++------------------------------- 2 files changed, 36 insertions(+), 31 deletions(-) diff --git a/src/Control/Lens/Cons.hs b/src/Control/Lens/Cons.hs index bda33c190..ce8d46f28 100644 --- a/src/Control/Lens/Cons.hs +++ b/src/Control/Lens/Cons.hs @@ -27,6 +27,7 @@ module Control.Lens.Cons , cons , uncons , _head, _tail + , (<|~), (<|=) , pattern (:<) -- * Snoc , Snoc(..) @@ -34,6 +35,7 @@ module Control.Lens.Cons , snoc , unsnoc , _init, _last + , (|>~), (|>=) , pattern (:>) ) where @@ -42,6 +44,7 @@ import Control.Lens.Equality (simply) import Control.Lens.Fold import Control.Lens.Prism import Control.Lens.Review +import Control.Lens.Setter import Control.Lens.Tuple import Control.Lens.Type import qualified Data.ByteString as StrictB @@ -62,6 +65,7 @@ import Data.Vector.Unboxed (Unbox) import qualified Data.Vector.Unboxed as Unbox import Data.Word import Control.Applicative (ZipList(..)) +import Control.Monad.State.Class as State import Prelude -- $setup @@ -77,6 +81,8 @@ import Prelude infixr 5 <|, `cons` infixl 5 |>, `snoc` +infixr 4 <|~, |>~ +infix 4 <|=, |>= pattern (:<) :: Cons b b a a => a -> b -> b pattern (:<) a s <- (preview _Cons -> Just (a,s)) where @@ -323,6 +329,19 @@ _tail :: Cons s s a a => Traversal' s s _tail = _Cons._2 {-# INLINE _tail #-} +-- | Modify the target of a 'Cons' value by using @('<|')@. +-- +-- >>> (["world"], ["lens"]) & _1 <|~ "hello" +-- (["hello","world"],["lens"]) +(<|~) :: Cons b b a a => ASetter s t b b -> a -> s -> t +l <|~ n = over l (n <|) +{-# INLINE (<|~) #-} + +-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('<|')@. +(<|=) :: (MonadState s m, Cons b b a a) => ASetter s s b b -> a -> m () +l <|= a = State.modify (l <|~ a) +{-# INLINE (<|=) #-} + ------------------------------------------------------------------------------ -- Snoc ------------------------------------------------------------------------------ @@ -538,3 +557,16 @@ snoc = curry (simply review _Snoc) unsnoc :: Snoc s s a a => s -> Maybe (s, a) unsnoc = simply preview _Snoc {-# INLINE unsnoc #-} + +-- | Modify the target of a 'Cons' value by using @('|>')@. +-- +-- >>> (["world"], ["lens"]) & _1 |>~ "hello" +-- (["world","hello"],["lens"]) +(|>~) :: Snoc b b a a => ASetter s t b b -> a -> s -> t +l |>~ n = over l (|> n) +{-# INLINE (|>~) #-} + +-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('|>')@. +(|>=) :: (MonadState s m, Snoc b b a a) => ASetter s s b b -> a -> m () +l |>= a = State.modify (l |>~ a) +{-# INLINE (|>=) #-} diff --git a/src/Control/Lens/Setter.hs b/src/Control/Lens/Setter.hs index 2ace40193..273ca95a0 100644 --- a/src/Control/Lens/Setter.hs +++ b/src/Control/Lens/Setter.hs @@ -49,11 +49,11 @@ module Control.Lens.Setter , over , set , (.~), (%~) - , (+~), (-~), (*~), (//~), (^~), (^^~), (**~), (||~), (<>~), (<>:~), (<|~), (|>~), (&&~), (<.~), (?~), (~), (<>:~), (&&~), (<.~), (?~), (=), (<>:=), (<|=), (|>=), (&&=), (<.=), (?=), (=), (<>:=), (&&=), (<.=), (?=), (>> let setter :: Expr -> Expr -> Expr; setter = fun "setter" -- >>> :set -XNoOverloadedStrings -infixr 4 %@~, .@~, .~, +~, *~, -~, //~, ^~, ^^~, **~, &&~, <>~, <>:~, <|~, |>~, ||~, %~, <.~, ?~, =, <>:=, <|=, |>=, ||=, %=, <.=, ?=, ~, <>:~, ||~, %~, <.~, ?~, =, <>:=, ||=, %=, <.=, ?=, :~ n = over l (n <>) l <>:= a = State.modify (l <>:~ a) {-# INLINE (<>:=) #-} --- | Modify the target of a 'Cons' value by using @('<|')@. --- --- >>> (["world"], ["lens"]) & _1 <|~ "hello" --- (["hello","world"],["lens"]) -(<|~) :: Cons b b a a => ASetter s t b b -> a -> s -> t -l <|~ n = over l (n <|) -{-# INLINE (<|~) #-} - --- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('<|')@. -(<|=) :: (MonadState s m, Cons b b a a) => ASetter s s b b -> a -> m () -l <|= a = State.modify (l <|~ a) -{-# INLINE (<|=) #-} - --- | Modify the target of a 'Cons' value by using @('|>')@. --- --- >>> (["world"], ["lens"]) & _1 |>~ "hello" --- (["world","hello"],["lens"]) -(|>~) :: Snoc b b a a => ASetter s t b b -> a -> s -> t -l |>~ n = over l (|> n) -{-# INLINE (|>~) #-} - --- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('|>')@. -(|>=) :: (MonadState s m, Snoc b b a a) => ASetter s s b b -> a -> m () -l |>= a = State.modify (l |>~ a) -{-# INLINE (|>=) #-} - ----------------------------------------------------------------------------- -- Writer Operations ----------------------------------------------------------------------------- From 71b25e9798686095bf993bc37531856c48e27d36 Mon Sep 17 00:00:00 2001 From: ncaq Date: Thu, 7 Mar 2024 00:18:43 +0900 Subject: [PATCH 4/4] feat: add: `<<|~`, `<<|=`, `<|>~`, `<|>=` Add Cons operators of "with result" variants. --- src/Control/Lens/Cons.hs | 41 ++++++++++++++++++++++++++++++++++++---- tests/hunit.hs | 24 +++++++++++++++++++++++ 2 files changed, 61 insertions(+), 4 deletions(-) diff --git a/src/Control/Lens/Cons.hs b/src/Control/Lens/Cons.hs index ce8d46f28..286300059 100644 --- a/src/Control/Lens/Cons.hs +++ b/src/Control/Lens/Cons.hs @@ -27,7 +27,7 @@ module Control.Lens.Cons , cons , uncons , _head, _tail - , (<|~), (<|=) + , (<|~), (<|=), (<<|~), (<<|=) , pattern (:<) -- * Snoc , Snoc(..) @@ -35,13 +35,14 @@ module Control.Lens.Cons , 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 (<|>=) #-} diff --git a/tests/hunit.hs b/tests/hunit.hs index a5e683829..73e7880c6 100644 --- a/tests/hunit.hs +++ b/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) + @?= (_points trig `snoc` origin, trig { _points = (trig & _points) `snoc` origin }) + +case_snoc_to_state_record_field_and_access_new_value = + runState test trig @?= (_points trig <> [ origin ], 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