summaryrefslogtreecommitdiff
path: root/tests/Data/Graph/Dynamic/Levels
diff options
context:
space:
mode:
authorJasperVanDerJeugt <>2019-01-11 12:32:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-01-11 12:32:00 (GMT)
commit6a7ef9d8008cb5469c3d720cf066cc2745780616 (patch)
treeed9d09ef38251b70fcae4ef88555a2164f5f0918 /tests/Data/Graph/Dynamic/Levels
version 0.1.0.10.1.0.1
Diffstat (limited to 'tests/Data/Graph/Dynamic/Levels')
-rw-r--r--tests/Data/Graph/Dynamic/Levels/Tests.hs83
1 files changed, 83 insertions, 0 deletions
diff --git a/tests/Data/Graph/Dynamic/Levels/Tests.hs b/tests/Data/Graph/Dynamic/Levels/Tests.hs
new file mode 100644
index 0000000..ba17c11
--- /dev/null
+++ b/tests/Data/Graph/Dynamic/Levels/Tests.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+module Data.Graph.Dynamic.Levels.Tests where
+
+import Control.Monad (foldM, forM_)
+import Control.Monad.ST
+import Data.Graph.Dynamic.Action
+import Data.Graph.Dynamic.Internal.Tree (Tree)
+import qualified Data.Graph.Dynamic.Levels as Levels
+import qualified Data.Graph.Dynamic.Program as Program
+import qualified Data.Graph.Dynamic.Slow as Slow
+import Data.Hashable (Hashable)
+import Data.List (foldl', mapAccumL)
+import Data.Maybe (catMaybes)
+import Test.Framework
+import Test.Framework.Providers.QuickCheck2
+import Test.Framework.TH
+import qualified Test.QuickCheck as QC
+
+runGraphAction
+ :: (Eq v, Hashable v, Tree tree)
+ => Levels.Graph tree s v -> [Bool] -> Action t v -> ST s [Bool]
+runGraphAction levels xs (Cut x y) = do
+ Levels.cut_ levels x y
+ return xs
+runGraphAction levels xs (Link x y) = do
+ Levels.link_ levels x y
+ return xs
+runGraphAction levels xs (Toggle x y) = do
+ Levels.edge levels x y >>= \case
+ True -> Levels.cut_ levels x y
+ False -> Levels.link_ levels x y
+ return xs
+runGraphAction levels xs (Query x y) =
+ Levels.connected levels x y >>= \q -> return (q:xs)
+
+checkActions :: QC.Positive Int -> [Action t Int] -> QC.Property
+checkActions (QC.Positive n) actions = slowResult QC.=== result
+ where
+ actions' = map (fmap (`mod` n)) actions
+ initialSlowGraph = Slow.edgeless [0..n-1]
+ slowResult = catMaybes $ snd $ mapAccumL runSlowGraphAction initialSlowGraph actions'
+ result :: [Bool]
+ result = runST $ do
+ initialGraph <- Levels.edgeless' [0..n-1]
+ results <- foldM (runGraphAction initialGraph) [] actions'
+ return $ reverse results
+
+prop_graph_linkcut :: QC.Positive Int -> [Action 'LinkCut Int] -> QC.Property
+prop_graph_linkcut = checkActions
+
+prop_graph_toggle :: QC.Positive Int -> [Action 'Toggl Int] -> QC.Property
+prop_graph_toggle = checkActions
+
+prop_program :: Program.IntGraphProgram -> ()
+prop_program (Program.IntGraphProgram p) = runST $ do
+ f <- Levels.empty'
+ Program.runProgram f p
+
+prop_spanningTree :: QC.Positive Int -> [Action 'LinkCut Int] -> QC.Property
+prop_spanningTree (QC.Positive n) actions =
+ Slow.isSpanningForest spanningForest slow QC.=== True
+ where
+ actions' = map (fmap (`mod` n)) actions
+
+ spanningForest = runST $ do
+ et <- Levels.edgeless' [0 .. n - 1]
+ forM_ actions' $ \action -> runGraphAction et [] action
+ Levels.spanningForest et
+
+ slow = foldl'
+ (\g a -> fst $ runSlowGraphAction g a)
+ (Slow.edgeless [0 .. n - 1])
+ actions'
+
+tests :: Test
+tests = $testGroupGenerator