summaryrefslogtreecommitdiff
path: root/tests/Data/Graph/Dynamic/Action.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Data/Graph/Dynamic/Action.hs')
-rw-r--r--tests/Data/Graph/Dynamic/Action.hs78
1 files changed, 78 insertions, 0 deletions
diff --git a/tests/Data/Graph/Dynamic/Action.hs b/tests/Data/Graph/Dynamic/Action.hs
new file mode 100644
index 0000000..cab2ce6
--- /dev/null
+++ b/tests/Data/Graph/Dynamic/Action.hs
@@ -0,0 +1,78 @@
+-- | Generate arbitrary "actions" (cut, link...) to test the connectivity
+-- algorithms.
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE StandaloneDeriving #-}
+module Data.Graph.Dynamic.Action
+ ( ActionType (..)
+ , Action (..)
+
+ , runSlowForestAction
+ , runSlowGraphAction
+ ) where
+
+import qualified Data.Graph.Dynamic.Slow as Slow
+import Data.Hashable (Hashable)
+import Test.QuickCheck
+
+data ActionType = LinkCut | Toggl
+
+data Action (t :: ActionType) v where
+ Cut :: !v -> !v -> Action 'LinkCut v
+ Link :: !v -> !v -> Action 'LinkCut v
+ Toggle :: !v -> !v -> Action 'Toggl v
+ Query :: !v -> !v -> Action a v
+
+deriving instance Show v => Show (Action t v)
+
+deriving instance Functor (Action t)
+
+instance Arbitrary v => Arbitrary (Action 'LinkCut v) where
+ arbitrary = oneof
+ [ Cut <$> arbitrary <*> arbitrary
+ , Link <$> arbitrary <*> arbitrary
+ , Query <$> arbitrary <*> arbitrary
+ ]
+ shrink (Link a b) = Link <$> shrink a <*> shrink b
+ shrink (Cut a b) = Cut <$> shrink a <*> shrink b
+ shrink (Query a b) = Query <$> shrink a <*> shrink b
+
+instance Arbitrary v => Arbitrary (Action 'Toggl v) where
+ arbitrary = oneof
+ [ Toggle <$> arbitrary <*> arbitrary
+ , Query <$> arbitrary <*> arbitrary
+ ]
+ shrink (Toggle a b) = Toggle <$> shrink a <*> shrink b
+ shrink (Query a b) = Query <$> shrink a <*> shrink b
+
+runSlowForestAction
+ :: (Eq v, Hashable v)
+ => Slow.Graph v -> Action t v -> (Slow.Graph v, Maybe Bool)
+runSlowForestAction graph (Cut x y) =
+ (Slow.cut x y graph, Nothing)
+runSlowForestAction graph (Link x y)
+ | Slow.connected x y graph = (graph, Nothing)
+ | otherwise = (Slow.link x y graph, Nothing)
+runSlowForestAction graph (Toggle x y)
+ | Slow.edge x y graph = (Slow.cut x y graph, Nothing)
+ | Slow.connected x y graph = (graph, Nothing)
+ | otherwise = (Slow.link x y graph, Nothing)
+runSlowForestAction graph (Query x y) =
+ (graph, Just (Slow.connected x y graph))
+
+runSlowGraphAction
+ :: (Eq v, Hashable v)
+ => Slow.Graph v -> Action t v -> (Slow.Graph v, Maybe Bool)
+runSlowGraphAction graph (Cut x y) =
+ (Slow.cut x y graph, Nothing)
+runSlowGraphAction graph (Link x y) =
+ (Slow.link x y graph, Nothing)
+runSlowGraphAction graph (Toggle x y)
+ | Slow.edge x y graph = (Slow.cut x y graph, Nothing)
+ | otherwise = (Slow.link x y graph, Nothing)
+runSlowGraphAction graph (Query x y) =
+ (graph, Just (Slow.connected x y graph))