Add failing test

Author: ryantrinkle

src/Data/Patch/MapWithPatchingMove.hs

@@ -23,6 +23,7 @@ module Data.Patch.MapWithPatchingMove
   , patchMapWithPatchingMoveInsertAll
   , insertMapKey
   , moveMapKey
+  , patchMapKey
   , swapMapKey
   , deleteMapKey
   , unsafePatchMapWithPatchingMove
@@ -135,6 +136,18 @@ moveMapKey src dst
         , (src, NodeInfo From_Delete (Just dst))
         ]
 
+patchMapKey
+  :: ( DecidablyEmpty p
+#if !MIN_VERSION_base(4,11,0)
+     , Semigroup p
+#endif
+     )
+  => k -> p -> PatchMapWithPatchingMove k p
+patchMapKey k p
+  | isEmpty p = PatchMapWithPatchingMove Map.empty
+  | otherwise =
+      PatchMapWithPatchingMove $ Map.singleton k $ NodeInfo (From_Move k p) (Just k)
+
 -- |Make a @'PatchMapWithPatchingMove' k p@ which has the effect of swapping two keys in the mapping, equivalent to:
 --
 -- @

test/tests.hs

@@ -4,25 +4,35 @@ module Main where
 import Test.HUnit (runTestTT, (~:), assertEqual, errors, failures, test)
 import Data.Patch ( Patch(apply) )
 import Data.Patch.MapWithMove ( patchThatChangesMap )
+import Data.Patch.MapWithPatchingMove (PatchMapWithPatchingMove)
+import qualified Data.Patch.MapWithPatchingMove as PatchMapWithPatchingMove
 import Data.Map as Map ( Map, fromList, singleton )
 import Hedgehog (checkParallel, discover, Property, property, forAll, PropertyT, (===))
 import Hedgehog.Gen as Gen ( int )
 import Hedgehog.Range as Range ( linear )
 import Control.Monad (replicateM)
 import System.Exit (exitFailure, exitSuccess)
 import Data.Sequence as Seq ( foldMapWithIndex, replicateM )
+import Data.Semigroup (Sum (..))
 
 main :: IO ()
 main = do
-   counts <- runTestTT $ test [
-      "Simple Move" ~: (do
+   counts <- runTestTT $ test
+     [ "Simple Move" ~: do
          let mapBefore = Map.fromList [(0,1)]
              mapAfter = Map.fromList [(0,0),(1,1)]
              patch = patchThatChangesMap mapBefore mapAfter
              afterPatch = apply patch mapBefore
-         assertEqual "Patch creates the same Map" (Just mapAfter) afterPatch),
-      "Property Checks" ~: propertyChecks
-    ]
+         assertEqual "Patch creates the same Map" (Just mapAfter) afterPatch
+     , "Property Checks" ~: propertyChecks
+     , "Insert and Patch" ~: do
+         let i :: PatchMapWithPatchingMove () (Sum Int)
+             i = PatchMapWithPatchingMove.insertMapKey () 1
+             p = PatchMapWithPatchingMove.patchMapKey () (Sum 2)
+             pAfterI = PatchMapWithPatchingMove.insertMapKey () 3
+         assertEqual "Insert after patch is the same as insert" (i <> p) i
+         assertEqual "Patch after insert is a patched insert" (p <> i) pAfterI
+     ]
    if errors counts + failures counts == 0 then exitSuccess else exitFailure
 
 propertyChecks :: IO Bool