module Test.Base where import qualified Data.Graph.Comfort as Graph import Data.Graph.Comfort (Graph) import qualified Data.Set as Set import Control.Applicative (liftA2) import qualified Test.QuickCheck as QC type Edge = Graph.DirEdge type Node = Int type EdgeLabel = Integer type NodeLabel = Char type MonoGraph = Graph Edge Node EdgeLabel NodeLabel newtype TestGraph = TestGraph {getTestGraph :: MonoGraph} deriving (Show) instance QC.Arbitrary TestGraph where shrink (TestGraph g) = case Graph.nodeSet g of ns -> map (TestGraph . flip Graph.deleteNodeSet g . Set.difference ns . Set.fromList) $ QC.shrink $ Set.toList ns arbitrary = do nodes <- QC.arbitrary fmap TestGraph $ if null nodes then return Graph.empty else do let genNode = QC.elements $ map fst nodes fmap (Graph.fromList nodes) $ QC.listOf $ liftA2 (,) (liftA2 Graph.DirEdge genNode genNode) QC.arbitrary data GraphAndEdge = GraphAndEdge MonoGraph (Edge Node) deriving (Show) instance QC.Arbitrary GraphAndEdge where shrink (GraphAndEdge gr e) = map (\(TestGraph g) -> GraphAndEdge g e) $ QC.shrink $ TestGraph gr arbitrary = let makeGraph p consEdge = do TestGraph gr <- QC.suchThat QC.arbitrary $ p . getTestGraph fmap (GraphAndEdge gr) $ consEdge gr in QC.oneof [makeGraph (not . null . Graph.edges) $ QC.elements . Graph.edges, makeGraph (not . null . Graph.nodes) $ \gr -> let selNode = QC.elements $ Graph.nodes gr in liftA2 Graph.DirEdge selNode selNode]