tests: Add tests for `split`

tests/MA/Algorithm/SplitSpec.hs

@@ -4,6 +4,7 @@ import           Test.Hspec
 
 import           Control.Monad.ST
 import           Data.STRef
+import           Data.List                      ( sort )
 
 import           Control.Monad.Reader
 import qualified Data.Vector                   as V
@@ -12,7 +13,7 @@ import           Lens.Micro.Platform
 
 import           MA.Algorithm.Types
 import           MA.Algorithm.Split
-import           Data.BlockQueue
+import           Data.BlockQueue                ( BlockQueue )
 import           Data.Partition.Common
 import           Data.MorphismEncoding          ( fromEdgeRef
                                                 , Encoding
@@ -25,6 +26,8 @@ import qualified Data.BlockQueue               as Queue
 import           MA.Functors.Powerset
 import           MA.Functors.MonoidValued
 import qualified Data.RefinablePartition       as Partition
+import qualified Data.Partition                as Partition
+                                                ( toBlocks )
 
 spec :: Spec
 spec = do
@@ -32,6 +35,7 @@ spec = do
   updateBlockSpec
   splitBlockSpec
   addBlocksToQueueSpec
+  splitSpec
 
 
 collectTouchedBlocksSpec :: Spec
@@ -226,6 +230,56 @@ addBlocksToQueueSpec = describe "addBlocksToQueue" $ do
       in  res `shouldMatchList` (map Block [0, 1, 2])
 
 
+splitSpec :: Spec
+splitSpec = describe "split" $ do
+  let encoding =
+        (enc
+          [10, 10, 10, 1, 1, 20, 20, 0]
+          [ (0, 1 , 7)
+          , (0, 9 , 0)
+          , (1, 2 , 7)
+          , (1, 8 , 1)
+          , (2, 3 , 7)
+          , (2, 7 , 2)
+          , (3, 1 , 7)
+          , (4, 1 , 4)
+          , (5, 20, 6)
+          , (6, 20, 5)
+          ]
+        )
+
+  it "splits all touched blocks correctly"
+    $ let res = withState @(MonoidValued Int) encoding $ do
+            p <- view (_1 . partitionL)
+            b <- lift (Partition.blockOfState p 7)
+            split b
+            Partition.toBlocks <$> lift (Partition.freeze p)
+      in  (map sort res)
+            `shouldMatchList` [[0], [1], [2], [3], [4], [5, 6], [7]]
+
+  it "adds the correct blocks to the queue"
+    $ let
+        res = withState @(MonoidValued Int) encoding $ do
+          p  <- view (_1 . partitionL)
+          b  <- lift (Partition.blockOfState p 7)
+          b3 <- lift (Partition.blockOfState p 3)
+          (lift . Queue.delete b) =<< view _2
+          (lift . Queue.delete b3) =<< view _2
+          split b
+          queuedBlocks <- lift . Queue.toList =<< view _2
+          lift (mapM (fmap VU.toList . Partition.statesOfBlock p) queuedBlocks)
+      in
+        res
+          `shouldSatisfy` (\l ->
+                            ([0] `elem` l)
+                              && ([1] `elem` l)
+                              && ([2] `elem` l)
+                              && ([5, 6] `elem` l)
+                              && (  ([3] `elem` l && not ([4] `elem` l))
+                                 || ([4] `elem` l && not ([3] `elem` l))
+                                 )
+                          )
+
 withState
   :: RefinementInterface h
   => Encoding (Label h) (H1 h)