changeset-lens (empty) → 0.1.0.0

raw patch · 11 files changed

+710/−0 lines, 11 filesdep +basedep +changesetdep +changeset-containers

Dependencies added: base, changeset, changeset-containers, changeset-lens, containers, falsify, indexed-traversable, lens, monoid-extras, monoidal-containers, tasty, tasty-hunit, transformers, witherable

Files

• CHANGELOG.md +5/−0
• LICENSE +20/−0
• changeset-lens.cabal +103/−0
• src/Control/Monad/Changeset/Lens.hs +29/−0
• src/Control/Monad/Changeset/Lens/At.hs +131/−0
• src/Control/Monad/Changeset/Lens/Ixed.hs +109/−0
• src/Control/Monad/Changeset/Lens/Setter.hs +77/−0
• test/At.hs +81/−0
• test/Ixed.hs +71/−0
• test/Main.hs +22/−0
• test/Setter.hs +62/−0

@@ -0,0 +1,5 @@+# Revision history for changeset-lens++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,20 @@+Copyright (c) 2023 Manuel Bärenz++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,103 @@+cabal-version: 3.0+name: changeset-lens+-- PVP summary:     +-+------- breaking API changes+--                  | | +----- non-breaking API additions+--                  | | | +--- code changes with no API change+version: 0.1.0.0+synopsis: Stateful monad transformer based on monoidal actions+description:+  A general state monad transformer with separate types for the state and the possible changes.+  It can be defined for any monoid action.+  The monoid represents "changes", "updates", "edits" or "diffs" on the state.++  This package exposes utilities to transport changes along optics,+  such as lenses or indexed structures.++license: MIT+license-file: LICENSE+author: Manuel Bärenz+maintainer: programming@manuelbaerenz.de+copyright: MIT+category: Control+build-type: Simple+extra-doc-files: CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/turion/changeset++flag dev+  description: Enable warnings as errors. Active on ci.+  default: False+  manual: True++common opts+  ghc-options:+    -Wall++  if flag(dev)+    ghc-options:+      -Werror+  default-extensions:+    BangPatterns+    DeriveFunctor+    DeriveTraversable+    DerivingStrategies+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    KindSignatures+    MultiParamTypeClasses+    NamedFieldPuns+    RankNTypes+    ScopedTypeVariables+    StandaloneDeriving+    TupleSections+    TypeOperators++library+  import: opts+  exposed-modules:+    Control.Monad.Changeset.Lens+    Control.Monad.Changeset.Lens.At+    Control.Monad.Changeset.Lens.Ixed+    Control.Monad.Changeset.Lens.Setter++  build-depends:+    base >=4.12 && <4.22,+    changeset ==0.1.0.0,+    containers >=0.6 && <0.8,+    indexed-traversable ^>=0.1.1,+    lens >=4.19.2 && <5.4,+    monoid-extras ^>=0.6,+    monoidal-containers ^>=0.6.2,+    transformers >=0.5.6.2 && <0.7,+    witherable >=0.4 && <0.6,++  hs-source-dirs: src+  default-language: Haskell2010++test-suite changeset-lens-test+  import: opts+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  build-depends:+    base,+    changeset,+    changeset-containers,+    changeset-lens,+    containers,+    falsify ^>=0.2,+    lens,+    monoid-extras,+    tasty ^>=1.4.2,+    tasty-hunit ^>=0.10.2,++  other-modules:+    At+    Ixed+    Setter

@@ -0,0 +1,29 @@+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++{-# HLINT ignore lensChangeset "Eta reduce" #-}+{-# HLINT ignore prismChangeset "Eta reduce" #-}+{-# HLINT ignore traversalChangeset "Eta reduce" #-}++module Control.Monad.Changeset.Lens where++-- base+import Prelude hiding (Foldable (..))++-- lens+import Control.Lens (Lens', Prism', Traversal')++-- changeset-lens+import Control.Monad.Changeset.Lens.Setter++-- | Create a changeset that focusses on a part of the state via a lens.+lensChangeset :: Lens' s a -> w -> SetterChangeset s a w+lensChangeset l w = setterChangeset l w++-- | Create a changeset that only changes some variants of the state, which are specified by a prism.+prismChangeset :: Prism' s a -> w -> SetterChangeset s a w+prismChangeset p w = setterChangeset p w++-- | Create a changeset that changes those parts of a state which are traversed+traversalChangeset :: Traversal' s a -> w -> SetterChangeset s a w+traversalChangeset t w = setterChangeset t w

@@ -0,0 +1,131 @@+{-# LANGUAGE UndecidableInstances #-}++module Control.Monad.Changeset.Lens.At where++-- base+import Data.Foldable+import Data.Function ((&))+import Prelude hiding (Foldable (..))++-- lens+import Control.Lens (At (..), Index, IxValue, (%~))++-- containers+import Data.IntMap (IntMap)+import Data.Map (Map)++-- monoidal-containers+import Data.Map.Monoidal (MonoidalMap, foldlWithKey', singleton)++-- monoid-extras+import Data.Monoid.RightAction++-- indexed-traversal+import Data.Foldable.WithIndex (FoldableWithIndex)+import Data.Functor.WithIndex (FunctorWithIndex)+import Data.Traversable.WithIndex (TraversableWithIndex (itraverse))++-- witherable+import Witherable (Filterable (mapMaybe), FilterableWithIndex, Witherable (..), WitherableWithIndex)++-- changeset+import Control.Monad.Changeset.Class (MonadChangeset (..))+import Control.Monad.Trans.Changeset (FmapChange (FmapChange), JustChange, MaybeChange, setJust)++-- changeset-lens+import Control.Monad.Changeset.Lens.Ixed (IxedChangeset (..))++{- | Edit parts of an indexed datastructure.++The state datastructure is usually a container, such as a 'Data.Map.Map'.+Changes to an element of that structure are promoted to a change of the whole structure+by pairing them with an 'Index' that points to a specific position in the structure.++In contrast to 'Control.Monad.Changeset.Lens.IxedChangeset',+'AtChangeset' can also create or delete values.+See for example 'Control.Monad.Trans.Changeset.MaybeChange':+The operation @i |>\@ 'setJust' a@ will create a value @a@ at key @i.@++Note: Internally, an 'AtChangeset' is represented as a map,+and the monoid structure is pointwise.+This is because we assume that all different indices refer to different positions,+so changes on different indices commute.+-}+newtype AtChangeset s w = AtChangeset+  {getAtChangeset :: MonoidalMap (Index s) w}++deriving instance (Ord (Index s), Semigroup w) => Semigroup (AtChangeset s w)+deriving instance (Ord (Index s), Monoid w) => Monoid (AtChangeset s w)+deriving instance (Eq (Index s), Eq w) => Eq (AtChangeset s w)+deriving instance (Ord (Index s), Ord w) => Ord (AtChangeset s w)+deriving instance (Show (Index s), Show w) => Show (AtChangeset s w)+deriving instance (Ord (Index s), Read (Index s), Read w) => Read (AtChangeset s w)+deriving instance Functor (AtChangeset s)+deriving instance Foldable (AtChangeset s)+deriving instance Traversable (AtChangeset s)+deriving instance (Index s ~ i) => FunctorWithIndex i (AtChangeset s)+deriving instance (Index s ~ i) => FoldableWithIndex i (AtChangeset s)+instance (Index s ~ i) => TraversableWithIndex i (AtChangeset s) where+  itraverse f = fmap AtChangeset . itraverse f . getAtChangeset+instance Filterable (AtChangeset s) where+  mapMaybe f = AtChangeset . mapMaybe f . getAtChangeset+instance (Index s ~ i) => FilterableWithIndex i (AtChangeset s)+instance (Ord (Index s)) => Witherable (AtChangeset s) where+  wither f = fmap AtChangeset . wither f . getAtChangeset+instance (Index s ~ i, Ord i) => WitherableWithIndex i (AtChangeset s)++instance (RightAction w (Maybe (IxValue s)), At s) => RightAction (AtChangeset s w) s where+  actRight s AtChangeset {getAtChangeset} = foldlWithKey' (\s' i w -> s' & at i %~ flip actRight w) s getAtChangeset++-- | Create an 'AtChangeset' by pointing to a position in @s@, and specifying a change @w@ to the value at that position.+atChangeset ::+  -- | A position in @s.@ For example, @s@ might be a map, and @'Index' s@ a key.+  Index s ->+  -- | A change to the element in @s@ at the given position. Typically, we expect @'RightAction' w ('Maybe' ('IxValue' s))@ to hold.+  w ->+  AtChangeset s w+atChangeset i = AtChangeset . singleton i++-- | Changes to the elements of a 'Map'.+type MapAtChangeset k a = AtChangeset (Map k a) (MaybeChange a)++-- | Changes to the elements of an 'IntMap'.+type IntMapAtChangeset a = AtChangeset (IntMap a) (MaybeChange a)++{- | Change a value at a given index.++Essentially, this applies 'atChangeset'.++Example:++@+-- Sets the value at key i to a+i <>\@ 'setJust' a+-- Deletes the value at key i+i <>\@ 'setNothing'+@+-}+(<>@) :: (MonadChangeset s (AtChangeset s w) m) => Index s -> w -> m ()+index <>@ w = change $ atChangeset index w++{- | Set a value at a given index.++A shorthand for '<>@' in combination with 'setJust'.++Example:++@+-- Sets the value at key i to a+i .@ a+@+-}+(.@) :: (MonadChangeset s (AtChangeset s (MaybeChange (IxValue s))) m) => Index s -> IxValue s -> m ()+index .@ w = index <>@ setJust w++{- | Lift an 'IxedChangeset' to an 'AtChangeset'.++The action of the resulting changeset is the same,+but 'AtChangeset' is the more expressive type.+-}+ixedToAtChangeset :: IxedChangeset s w -> AtChangeset s (JustChange w)+ixedToAtChangeset = AtChangeset . fmap FmapChange . getIxedChangeset

@@ -0,0 +1,109 @@+{-# LANGUAGE UndecidableInstances #-}++module Control.Monad.Changeset.Lens.Ixed where++-- base+import Data.Foldable (Foldable)+import Data.Function ((&))+import Data.Monoid (First (..))+import Prelude hiding (Foldable (..))++-- lens+import Control.Lens (Index, IxValue, Ixed (..), (%~))++-- containers+import Data.Map.Strict (Map)++-- monoidal-containers+import Data.Map.Monoidal (MonoidalMap, foldlWithKey', singleton)++-- monoid-extras+import Data.Monoid.RightAction++-- indexed-traversal+import Data.Foldable.WithIndex (FoldableWithIndex)+import Data.Functor.WithIndex (FunctorWithIndex)+import Data.Traversable.WithIndex (TraversableWithIndex (..))++-- witherable+import Witherable (Filterable (..), FilterableWithIndex (..), Witherable (..), WitherableWithIndex)++-- changeset+import Control.Monad.Changeset.Class (MonadChangeset (..))++{- | Edit parts of an indexed datastructure.++The state datastructure is usually a container, such as a 'Data.Map.Map'.+Changes to an element of that structure are promoted to a change of the whole structure+by pairing them with an 'Index' that points to a specific position in the structure.++Note: Internally, an 'IxedChangeset' is represented as a map,+and the monoid structure is pointwise.+This is because we assume that all different indices refer to different positions,+so changes on different indices commute.+-}+newtype IxedChangeset s w = IxedChangeset+  {getIxedChangeset :: MonoidalMap (Index s) w}++deriving instance (Ord (Index s), Semigroup w) => Semigroup (IxedChangeset s w)+deriving instance (Ord (Index s), Monoid w) => Monoid (IxedChangeset s w)+deriving instance (Eq (Index s), Eq w) => Eq (IxedChangeset s w)+deriving instance (Ord (Index s), Ord w) => Ord (IxedChangeset s w)+deriving instance (Show (Index s), Show w) => Show (IxedChangeset s w)+deriving instance (Ord (Index s), Read (Index s), Read w) => Read (IxedChangeset s w)+deriving instance Functor (IxedChangeset s)+deriving instance Foldable (IxedChangeset s)+deriving instance Traversable (IxedChangeset s)+deriving instance (Index s ~ i) => FunctorWithIndex i (IxedChangeset s)+deriving instance (Index s ~ i) => FoldableWithIndex i (IxedChangeset s)+instance (Index s ~ i) => TraversableWithIndex i (IxedChangeset s) where+  itraverse f = fmap IxedChangeset . itraverse f . getIxedChangeset+instance Filterable (IxedChangeset s) where+  mapMaybe f = IxedChangeset . mapMaybe f . getIxedChangeset+instance (Index s ~ i) => FilterableWithIndex i (IxedChangeset s)+instance (Ord (Index s)) => Witherable (IxedChangeset s) where+  wither f = fmap IxedChangeset . wither f . getIxedChangeset+instance (Index s ~ i, Ord i) => WitherableWithIndex i (IxedChangeset s)++instance (RightAction w (IxValue s), Ixed s) => RightAction (IxedChangeset s w) s where+  actRight s IxedChangeset {getIxedChangeset} = foldlWithKey' (\s' i w -> s' & ix i %~ flip actRight w) s getIxedChangeset++-- | Create an 'IxedChangeset' by pointing to a position in @s@, and specifying a change @w@ to the value at that position.+ixedChangeset ::+  -- | A position in @s@. For example, @s@ might be a map, and @'Index' s@ a key.+  Index s ->+  -- | A change to the element in @s@ at the given position. Typically, we expect @'RightAction' w ('IxValue' s)@ to hold.+  w ->+  IxedChangeset s w+ixedChangeset i = IxedChangeset . singleton i++-- | Changes to the elements of a 'Map'.+type MapIxedChangeset k a = IxedChangeset (Map k a) a++{- | Change a value at a given index.++Essentially, this applies 'ixedChangeset'.++Example:++@+-- Increments the value at key i+i |>! Increment+@+-}+(|>!) :: (MonadChangeset s (IxedChangeset s w) m) => Index s -> w -> m ()+index |>! w = change $ ixedChangeset index w++{- | Set a value at a given index.++A shorthand for '|>!' in combination with 'First'.++Example:++@+-- Sets the value at key i to a+i .! a+@+-}+(.!) :: (MonadChangeset s (IxedChangeset s (First (IxValue s))) m) => Index s -> IxValue s -> m ()+index .! w = index |>! First (Just w)

@@ -0,0 +1,77 @@+module Control.Monad.Changeset.Lens.Setter where++-- base+import Data.Function ((&))+import Data.List (foldl')+import Data.Monoid (First (..))+import Prelude hiding (Foldable (..))++-- lens+import Control.Lens (Setter', (%~))++-- containers+import Data.Sequence (Seq)++-- monoid-extras+import Data.Monoid.RightAction++-- changeset+import Control.Monad.Changeset.Class (MonadChangeset (..))++{- | A single change focussed through a setter.++A setter may be any of a variety of optics: A 'Data.Lens.Lens', a 'Data.Lens.Prism', a 'Data.Lens.Traversal'.++The change of type @w@ has to apply to @a@,+which is a part of a bigger structure @s.@+It is paired with a setter, which allows it to act on that bigger structure.++If the bigger datastructure is indexed (it has an instance of 'Data.Lens.Ixed' or 'Data.Lens.At'),+then 'Control.Monad.Changeset.Lens.Ixed.IxedChangeset' or 'Control.Monad.Changeset.Lens.At.AtChangeset'+are probably better choices, because these can be inspected and changed better.+-}+data SetterChange s a w = SetterChange+  { setterChangeSetter :: Setter' s a+  , setterChangeChange :: w+  }+  deriving (Functor)++-- | A collection of 'SetterChange's, which are applied consecutively.+newtype SetterChangeset s a w = SetterChangeset+  {getSetterChangeset :: Seq (SetterChange s a w)}+  deriving newtype (Semigroup, Monoid)++instance (RightAction w a) => RightAction (SetterChangeset s a w) s where+  actRight s SetterChangeset {getSetterChangeset} = foldl' (\s' SetterChange {setterChangeSetter, setterChangeChange} -> s' & setterChangeSetter %~ flip actRight setterChangeChange) s getSetterChangeset++-- | Create a 'SetterChangeset' with a single change, focussing on a particular setter.+setterChangeset :: Setter' s a -> w -> SetterChangeset s a w+setterChangeset setterChangeSetter setterChangeChange = SetterChangeset $ pure $ SetterChange {setterChangeSetter, setterChangeChange}++{- | Change a value through a setter.++Essentially, this applies 'setterChangeset'.++Example:++@+-- Increments the value through a lens+someLens |>~ Increment+@+-}+(|>~) :: (MonadChangeset s (SetterChangeset s a w) m) => Setter' s a -> w -> m ()+setter |>~ w = change $ setterChangeset setter w++{- | Set a value through a setter..++A shorthand for '|>~' in combination with 'First'.++Example:++@+-- Sets the value behind the prism to a+somePrism .|>~ a+@+-}+(.|>~) :: (MonadChangeset s (SetterChangeset s a (First a)) m) => Setter' s a -> a -> m ()+setter .|>~ a = setter |>~ First (Just a)

@@ -0,0 +1,81 @@+module At where++-- base+import Data.Char (toLower, toUpper)+import Prelude hiding (Foldable (..))++-- tasty+import Test.Tasty++-- tasty-hunit+import Test.Tasty.HUnit (testCase, (@?=))++-- containers+import Data.IntMap (IntMap, singleton)+import qualified Data.IntMap as IM+import qualified Data.Map as M++-- changeset+import Control.Monad.Trans.Changeset+import Data.Monoid.RightAction (rEndo)+import Data.Monoid.RightAction.Coproduct (inL, inR, normaliseCoproduct)+import Data.Monoid.RightAction.IntMap++-- changeset-lens+import Control.Monad.Changeset.Class (MonadChangeset (..))+import Control.Monad.Changeset.Lens.At++tests :: TestTree+tests =+  testGroup+    "AtChangeset"+    [ testGroup+        "IntMap"+        [ testCase "Changing elements" $+            let action = do+                  0 <>@ justChange (rEndo not)+                  1 <>@ justChange (rEndo not)+             in execChangeset action (IM.singleton 0 True) @?= singleton 0 False+        , testCase "Adding and removing elements" $+            let action = do+                  0 <>@ setJust True+                  1 <>@ setJust False+                  1 <>@ setJust True+                  2 <>@ setJust False+                  2 <>@ setNothing+                  3 <>@ setNothing+                  4 <>@ setJust True+             in execChangeset action (IM.fromList [(0, False), (3, True)]) @?= IM.fromList [(0, True), (1, True), (4, True)]+        ]+    , testCase "Map" $+        let action = do+              "hello" <>@ justChange (rEndo (map toUpper))+              "world" <>@ justChange (rEndo (map (toLower . toUpper)))+         in execChangeset action (M.fromList [("hello", "hello"), ("world", "wOrLd")])+              @?= M.fromList [("hello", "HELLO"), ("world", "world")]+    , testCase "is inspectable" $+        let action = 0 .@ False :: Changeset (IntMap Bool) (IntMapAtChangeset Bool) ()+         in getChange action (IM.singleton 0 True) @?= atChangeset 0 (setJust False)+    , testCase "Last" $+        let action = 0 .@ False+         in execChangeset action (IM.singleton 0 True) @?= IM.singleton 0 False+    , testGroup+        "containers :+: AtChangeset"+        [ testCase "Can change after insert" $+            let action = do+                  change $ inL $ singleChange (Insert 0 True :: IntMapChange Bool)+                  -- Adding type signatures so GHC < 9 doesn't freak out+                  mapChange inR (0 .@ False :: Changeset (IntMap Bool) (IntMapAtChangeset Bool) ())+             in do+                  normaliseCoproduct (getChange action IM.empty)+                    @?= [ Left $ singleChange $ Insert 0 True+                        , Right $ atChangeset 0 $ setJust False+                        ]+                  execChangeset action mempty @?= IM.singleton 0 False+        , testCase "<>@ only affects same key" $+            let action = do+                  mapChange inL $ changeSingle (Insert 0 True :: IntMapChange Bool)+                  mapChange inR $ 1 <>@ justChange (rEndo not)+             in execChangeset action mempty @?= singleton 0 True+        ]+    ]

@@ -0,0 +1,71 @@+module Ixed where++-- base+import Data.Char (toLower, toUpper)+import Data.Monoid (Last (..))+import Prelude hiding (Foldable (..))++-- tasty+import Test.Tasty++-- tasty-hunit+import Test.Tasty.HUnit (testCase, (@?=))++-- containers+import Data.IntMap (singleton)+import qualified Data.IntMap as IM+import qualified Data.Map as M++-- changeset+import Control.Monad.Trans.Changeset++-- changeset-lens+import Control.Monad.Changeset.Class (MonadChangeset (..))+import Control.Monad.Changeset.Lens.Ixed+import Data.Monoid.RightAction (rEndo)+import Data.Monoid.RightAction.Coproduct (inL, inR, normaliseCoproduct)++-- changeset-containers+import Data.Monoid.RightAction.IntMap++tests :: TestTree+tests =+  testGroup+    "IxedChangeset"+    [ testCase "IntMap" $+        let action = do+              0 |>! rEndo not+              1 |>! rEndo not+         in execChangeset action (IM.singleton 0 True) @?= singleton 0 False+    , testCase "Map" $+        let action = do+              "hello" |>! rEndo (map toUpper)+              "world" |>! rEndo (map toUpper)+              "world" |>! rEndo (map toLower)+         in execChangeset action (M.fromList [("hello", "hello"), ("world", "wOrLd")])+              @?= M.fromList [("hello", "HELLO"), ("world", "world")]+    , testCase "is inspectable" $+        let action = 0 |>! Last (Just False)+         in getChange action (IM.singleton 0 True) @?= ixedChangeset 0 (Last (Just False))+    , testCase "Last" $+        let action = 0 |>! Last (Just False)+         in execChangeset action (IM.singleton 0 True) @?= IM.singleton 0 False+    , testGroup+        "containers :+: IxedChangeset"+        [ testCase "Can change after insert" $+            let action = do+                  change $ inL $ singleChange (Insert 0 True :: IntMapChange Bool)+                  mapChange inR $ 0 |>! Last (Just False)+             in do+                  normaliseCoproduct (getChange action IM.empty)+                    @?= [ Left $ singleChange $ Insert 0 True+                        , Right $ ixedChangeset 0 $ Last $ Just False+                        ]+                  execChangeset action mempty @?= IM.singleton 0 False+        , testCase "|>! only affects same key" $+            let action = do+                  mapChange inL $ changeSingle (Insert 0 True :: IntMapChange Bool)+                  mapChange inR $ 1 |>! rEndo not+             in execChangeset action mempty @?= singleton 0 True+        ]+    ]

@@ -0,0 +1,22 @@+module Main (main) where++-- base+import Prelude hiding (Foldable (..))++-- tasty+import Test.Tasty++-- changeset-lens-test+import qualified At+import qualified Ixed+import qualified Setter++main :: IO ()+main =+  defaultMain $+    testGroup+      "changeset-lens"+      [ Ixed.tests+      , Setter.tests+      , At.tests+      ]

@@ -0,0 +1,62 @@+module Setter where++-- base+import Prelude hiding (Foldable (..))++-- lens+import Control.Lens (Lens', lens)++-- tasty+import Test.Tasty++-- tasty-hunit+import Test.Tasty.HUnit (testCase, (@?=))++-- containers+import qualified Data.IntMap as IM++-- changeset+import Control.Monad.Changeset.Class+import Control.Monad.Trans.Changeset++-- changeset-lens+import Control.Monad.Changeset.Lens+import Control.Monad.Changeset.Lens.Ixed ((|>!))+import Control.Monad.Changeset.Lens.Setter (setterChangeset)++data Big = Big+  { irrelevant :: String+  , counter :: Int+  }+  deriving (Eq, Show)++lensCounter :: Lens' Big Int+lensCounter = lens counter $ \big counter -> big {counter}++tests :: TestTree+tests =+  testGroup+    "Setter"+    [ testGroup+        "Small change on big data structure"+        [ testCase "single change" $ execChangeset (change (lensChangeset lensCounter (singleChange Increment))) (Big "foo" 0) @?= Big "foo" 1+        ]+    , testGroup+        "nested IxedChangeset with SetterChangeset"+        [ testCase "Can apply setter changeset inside indexed structure" $+            let initialState = IM.fromList [(0, Big "" 0), (1, Big "" 0)]+                action = do+                  2 |>! setterChangeset lensCounter (singleChange Increment)+                  s <- current+                  1 |>! setterChangeset lensCounter (singleChange Increment)+                  2 |>! setterChangeset lensCounter (singleChange Increment)+                  return s+             in runChangeset action initialState+                  @?= ( initialState+                      , IM.fromList+                          [ (0, Big "" 0)+                          , (1, Big "" 1)+                          ]+                      )+        ]+    ]