Fix Data.RRBVector.Internal.Array.{snoc, cons}

Closes #10
konsumlamm · Oct 21, 2023 · 1b285f9 · 1b285f9
1 parent 305f4f2
commit 1b285f9
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 4 deletions.
diff --git a/src/Data/RRBVector/Internal/Array.hs b/src/Data/RRBVector/Internal/Array.hs
@@ -173,17 +173,17 @@ last :: Array a -> a
 last arr = index arr (length arr - 1)
 
 snoc :: Array a -> a -> Array a
-snoc (Array _ len arr) x = Array 0 len' $ runSmallArray $ do
+snoc (Array start len arr) x = Array 0 len' $ runSmallArray $ do
     sma <- newSmallArray len' x
-    copySmallArray sma 0 arr 0 len
+    copySmallArray sma 0 arr start len
     pure sma
   where
     !len' = len + 1
 
 cons :: Array a -> a -> Array a
-cons (Array _ len arr) x = Array 0 len' $ runSmallArray $ do
+cons (Array start len arr) x = Array 0 len' $ runSmallArray $ do
     sma <- newSmallArray len' x
-    copySmallArray sma 1 arr 0 len
+    copySmallArray sma 1 arr start len
     pure sma
   where
     !len' = len + 1

diff --git a/test/Properties.hs b/test/Properties.hs
@@ -150,6 +150,7 @@ properties = testGroup "properties"
         ]
     , instances
     , laws
+    , issues
     ]
 
 instances :: TestTree
@@ -219,3 +220,12 @@ laws = testGroup "typeclass laws"
     , localOption (QuickCheckTests 500) . localOption (QuickCheckMaxSize 5000) . testLaws $ monadZipLaws proxyV
     , localOption (QuickCheckMaxSize 100) . testLaws $ traversableLaws proxyV
     ]
+
+-- old issues, to avoid regressions
+issues :: TestTree
+issues = testGroup "issues"
+    -- https://github.com/konsumlamm/rrb-vector/issues/10
+    [ testProperty "#10" $ \x v -> case V.viewl v of
+            Nothing -> property True
+            Just (_, v') -> x V.<| v' === V.update 0 x v
+    ]