comfort-graph 0.0.3.1 → 0.0.3.2

raw patch · 6 files changed

+376/−277 lines, 6 filesdep +doctest-exitcode-stdiodep ~transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: doctest-exitcode-stdio

Dependency ranges changed: transformers

API changes (from Hackage documentation)

Files

• Makefile +8/−0
• comfort-graph.cabal +12/−6
• src/Data/Graph/Comfort.hs +97/−0
• test/Main.hs +6/−271
• test/Test/Base.hs +57/−0
• test/Test/Data/Graph/Comfort.hs +196/−0

@@ -0,0 +1,8 @@+run-test:	update-test+	runhaskell Setup configure --user --enable-tests+	runhaskell Setup build+	runhaskell Setup haddock+	runhaskell Setup test comfort-graph-test --show-details=streaming++update-test:+	doctest-extract -i src/ -o test/ --executable-main=Main.hs Data.Graph.Comfort

@@ -1,5 +1,5 @@ Name:                comfort-graph-Version:             0.0.3.1+Version:             0.0.3.2 Synopsis:            Graph structure with type parameters for nodes and edges Description:   This graph structure is based on "Data.Map"@@ -41,7 +41,7 @@   * @fgl@:       standard package for graph processing with many graph algorithms       but cumbersome data structure with Int numbered nodes-Homepage:            http://hub.darcs.net/thielema/comfort-graph+Homepage:            https://hub.darcs.net/thielema/comfort-graph License:             BSD3 License-File:        LICENSE Author:              Henning Thielemann@@ -49,15 +49,17 @@ Category:            Data Build-Type:          Simple Cabal-Version:       >=1.10+Extra-Source-Files:+  Makefile  Source-Repository this-  Tag:         0.0.3.1+  Tag:         0.0.3.2   Type:        darcs-  Location:    http://hub.darcs.net/thielema/comfort-graph+  Location:    https://hub.darcs.net/thielema/comfort-graph  Source-Repository head   Type:        darcs-  Location:    http://hub.darcs.net/thielema/comfort-graph+  Location:    https://hub.darcs.net/thielema/comfort-graph  Library   Exposed-Modules:@@ -79,12 +81,16 @@   If impl(ghc>=8.0)     GHC-Options: -fno-warn-redundant-constraints -Test-Suite test-comfort-graph+Test-Suite comfort-graph-test   Type:                exitcode-stdio-1.0   Hs-Source-Dirs:      test   Main-is:             Main.hs+  Other-Modules:+    Test.Base+    Test.Data.Graph.Comfort   Build-Depends:     comfort-graph,+    doctest-exitcode-stdio >=0.0 && <0.1,     QuickCheck >=2 && <3,     transformers,     containers,

@@ -88,6 +88,49 @@ import Prelude (error)  +{- $setup+>>> import Test.Base+>>>+>>> import qualified Data.Graph.Comfort as Graph+>>> import qualified Data.Map as Map+>>> import qualified Data.Set as Set+>>> import qualified Data.Char as Char+>>>+>>> import qualified Control.Monad.Trans.Class as MT+>>> import qualified Control.Monad.Trans.State as MS+>>> import Control.Applicative (pure)+>>> import Data.Functor.Identity (Identity(Identity), runIdentity)+>>>+>>> import qualified Test.QuickCheck as QC+>>> import Test.QuickCheck ((==>))+>>>+>>> deleteNodeIfExists :: Node -> MonoGraph -> MonoGraph+>>> deleteNodeIfExists n gr =+>>>    maybe gr (const $ Graph.deleteNode n gr) $ Graph.lookupNode n gr+>>>+>>> isolated :: (Graph.Edge e, Ord n) => Graph.Graph e n el nl -> n -> Bool+>>> isolated gr n = Set.null (Graph.adjacentEdgeSet gr n)+>>>+>>> nodeAction :: (Monad m) => NodeLabel -> MS.StateT NodeLabel m NodeLabel+>>> nodeAction x = do y <- MS.get; MS.put x; return y+>>>+>>> evalTraverseNode :: NodeLabel -> MonoGraph -> MonoGraph+>>> evalTraverseNode nl =+>>>    flip MS.evalState nl . Graph.traverseNode nodeAction+>>>+>>> edgeAction :: (Monad m) => EdgeLabel -> MS.StateT EdgeLabel m EdgeLabel+>>> edgeAction x = MS.modify (x+) >> MS.get+>>>+>>> evalTraverseEdge :: EdgeLabel -> MonoGraph -> MonoGraph+>>> evalTraverseEdge el =+>>>    flip MS.evalState el . Graph.traverseEdge edgeAction+>>>+>>> evalTraverse :: NodeLabel -> EdgeLabel -> MonoGraph -> MonoGraph+>>> evalTraverse nl el =+>>>    flip MS.evalState el . flip MS.evalStateT nl .+>>>    Graph.traverse nodeAction (MT.lift . edgeAction)+-}+ {- For all 'Graph's the 'isConsistent' predicate must be 'True'. -}@@ -311,6 +354,10 @@ edges = Map.keys . edgeLabels  +{- |+prop> \(TestGraph gr) -> Graph.isConsistent (Graph.reverse gr)+prop> \(TestGraph gr) -> Graph.reverse (Graph.reverse gr) == gr+-} reverse ::    (Reverse e, Ord n) =>    Graph e n el nl -> Graph e n el nl@@ -359,6 +406,10 @@           Map.mapKeys (wrap . g . unwrap) outs)) .    Map.mapKeysWith (error "Graph.mapKeys: node map is not injective") f +{- |+prop> Graph.isEmpty (Graph.empty :: MonoGraph)+prop> Graph.isConsistent (Graph.empty :: MonoGraph)+-} empty :: Graph edge node edgeLabel nodeLabel empty = Graph Map.empty @@ -410,6 +461,9 @@ nodeLabels :: (Edge e, Ord n) => Graph e n el nl -> Map n nl nodeLabels = fmap snd3 . graphMapWrap +{- |+prop> \(GraphAndEdge gr e) -> Graph.lookupEdge e gr == Map.lookup e (Graph.edgeLabels gr)+-} lookupEdge :: (Edge e, Ord n) => e n -> Graph e n el nl -> Maybe el lookupEdge e (Graph g) =    Map.lookup (wrap e) . thd3 =<< Map.lookup (from e) g@@ -425,6 +479,9 @@ isEmpty :: Graph e n el nl -> Bool isEmpty = Map.null . graphMapWrap +{- |+prop> \(TestGraph gr) n -> Graph.lookupNode n gr == Map.lookup n (Graph.nodeLabels gr)+-} lookupNode :: (Ord n) => n -> Graph e n el nl -> Maybe nl lookupNode n (Graph g) = fmap snd3 $ Map.lookup n g @@ -466,6 +523,10 @@  {- | Node to be deleted must be contained in the graph.++prop> \(TestGraph gr) n -> Graph.isConsistent $ deleteNodeIfExists n gr+prop> \(TestGraph gr) n nl -> Graph.deleteNode n (Graph.insertNode n nl gr) == deleteNodeIfExists n gr+prop> \(TestGraph gr) -> let isolatedNodes = filter (isolated gr) $ Graph.nodes gr in not (null isolatedNodes) ==> QC.forAll (QC.elements isolatedNodes) $ \n nl -> Graph.insertNode n nl gr == Graph.insertNode n nl (Graph.deleteNode n gr) -} deleteNode ::    (Edge e, Ord n) =>@@ -490,6 +551,11 @@    Set n -> Graph e n el nl -> Graph e n el nl deleteNodeSet delNs g = Set.foldl (flip deleteNode) g delNs +{- |+prop> \(GraphAndEdge gr e) -> Graph.isConsistent $ Graph.deleteEdge e gr+prop> \(GraphAndEdge gr e) el -> Graph.deleteEdge e (Graph.insertEdge e el gr) == Graph.deleteEdge e gr+prop> \(GraphAndEdge gr e) el -> Graph.insertEdge e el gr == Graph.insertEdge e el (Graph.deleteEdge e gr)+-} deleteEdge ::    (Edge e, Ord n) =>    e n -> Graph e n el nl -> Graph e n el nl@@ -498,6 +564,9 @@       Map.adjust (mapThd3 $ Map.delete $ wrap e) (from e) .       Map.adjust (mapFst3 $ Map.delete $ wrap e) (to e) +{- |+prop> \(GraphAndEdge gr e) -> Graph.filterEdgeWithKey (\ei _ -> e/=ei) gr == Graph.deleteEdge e gr+-} filterEdgeWithKey ::    (Edge e, Ord n) =>    (e n -> el -> Bool) ->@@ -548,6 +617,9 @@ and existing edges are maintained. However, I think we should better have an extra function for this purpose and you should not rely on this behavior.++prop> \(TestGraph gr) n nl -> Graph.isConsistent $ Graph.insertNode n nl gr+prop> \(TestGraph gr) n nl -> Graph.lookupNode n (Graph.insertNode n nl gr) == Just nl -} insertNode ::    (Ord n) => n -> nl -> Graph e n el nl -> Graph e n el nl@@ -558,6 +630,10 @@       n (Map.empty, nl, Map.empty) .    graphMapWrap +{- |+prop> \(GraphAndEdge gr e) el -> Graph.isConsistent $ Graph.insertEdge e el gr+prop> \(GraphAndEdge gr e) el -> Graph.lookupEdge e (Graph.insertEdge e el gr) == Just el+-} insertEdge ::    (Edge e, Ord n) =>    e n -> el -> Graph e n el nl -> Graph e n el nl@@ -589,6 +665,9 @@ fromList ns es =    fromMapWrap (Map.fromList ns) $ Map.fromList $ map (mapFst wrap) es +{- |+prop> \(TestGraph gr) -> gr == Graph.fromMap (Graph.nodeLabels gr) (Graph.edgeLabels gr)+-} fromMap ::    (Edge e, Ord n) =>    Map n nl -> Map (e n) el -> Graph e n el nl@@ -606,6 +685,9 @@           (TMap.cons Map.empty $ Map.mapKeysWith Map.union fromWrap ess) ns  +{- |+prop> \(TestGraph gr) -> Graph.mapNode id gr == gr+-} mapNode :: (nl0 -> nl1) -> Graph e n el nl0 -> Graph e n el nl1 mapNode f =    Graph . fmap (\(ins,n,outs) -> (ins, f n, outs)) . graphMapWrap@@ -616,6 +698,9 @@    Map.mapWithKey (\n (ins,nl,outs) -> (ins, f n nl, outs)) .    graphMapWrap +{- |+prop> \(TestGraph gr) -> Graph.mapEdge id gr == gr+-} mapEdge :: (el0 -> el1) -> Graph e n el0 nl -> Graph e n el1 nl mapEdge f =    Graph . fmap (\(ins,n,outs) -> (fmap f ins, n, fmap f outs)) . graphMapWrap@@ -649,6 +734,9 @@  {- | Same restrictions as in 'traverse'.++prop> \(TestGraph gr) nl -> Graph.isConsistent $ evalTraverseNode nl gr+prop> \(TestGraph gr) -> runIdentity (Graph.traverseNode (Identity . Char.toUpper) gr) == Graph.mapNode Char.toUpper gr -} traverseNode ::    (Applicative f, Edge e, Ord n) =>@@ -660,6 +748,9 @@  {- | Same restrictions as in 'traverse'.++prop> \(TestGraph gr) el -> Graph.isConsistent $ evalTraverseEdge el gr+prop> \(TestGraph gr) el -> runIdentity (Graph.traverseEdge (Identity . (el+)) gr) == Graph.mapEdge (el+) gr -} traverseEdge ::    (Applicative f, Edge e, Ord n) =>@@ -669,6 +760,12 @@  {- | Don't rely on a particular order of traversal!++prop> \(TestGraph gr) nl el -> Graph.isConsistent $ evalTraverse nl el gr+prop> \(TestGraph gr) nl el -> evalTraverse nl el gr == evalTraverseNode nl (evalTraverseEdge el gr)+prop> \(TestGraph gr) nl el -> evalTraverse nl el gr == evalTraverseEdge el (evalTraverseNode nl gr)+prop> \(TestGraph gr) nl -> flip MS.evalState nl (Graph.traverseNode nodeAction gr) == flip MS.evalState nl (Graph.traverse nodeAction pure gr)+prop> \(TestGraph gr) el -> flip MS.evalState el (Graph.traverseEdge edgeAction gr) == flip MS.evalState el (Graph.traverse pure edgeAction gr) -} traverse, _traverseNaive ::    (Applicative f, Edge e, Ord n) =>

@@ -1,275 +1,10 @@-module Main (main) where--import qualified Data.Graph.Comfort as Graph-import Data.Graph.Comfort (Graph)--import qualified Data.Map as Map-import qualified Data.Set as Set-import qualified Data.Char as Char-import Data.Bool.HT (implies)--import qualified Control.Monad.Trans.Class as MT-import qualified Control.Monad.Trans.State as MS-import Control.Applicative (liftA2, pure)-import Data.Functor.Identity (Identity(Identity), runIdentity)--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]---test :: (QC.Testable prop) => String -> prop -> IO ()-test msg prop =-   putStr (msg ++ ": ") >> QC.quickCheck prop---emptyIsEmpty :: Bool-emptyIsEmpty =-   Graph.isEmpty (Graph.empty :: MonoGraph)--emptyIsConsistent :: Bool-emptyIsConsistent =-   Graph.isEmpty (Graph.empty :: MonoGraph)--fromMapNodeEdgeLabels :: TestGraph -> Bool-fromMapNodeEdgeLabels (TestGraph gr) =-   Graph.fromMap (Graph.nodeLabels gr) (Graph.edgeLabels gr) == gr--reverseIsConsistent :: TestGraph -> Bool-reverseIsConsistent (TestGraph gr) =-   Graph.isConsistent (Graph.reverse gr)--reverseReverse :: TestGraph -> Bool-reverseReverse (TestGraph gr) =-   Graph.reverse (Graph.reverse gr) == gr--mapNodeId :: TestGraph -> Bool-mapNodeId (TestGraph gr) =-   Graph.mapNode id gr == gr--mapEdgeId :: TestGraph -> Bool-mapEdgeId (TestGraph gr) =-   Graph.mapEdge id gr == gr--insertNodeIsConsistent :: TestGraph -> Node -> NodeLabel -> Bool-insertNodeIsConsistent (TestGraph gr) n nl =-   Graph.isConsistent $ Graph.insertNode n nl gr--insertLookupNode :: TestGraph -> Node -> NodeLabel -> Bool-insertLookupNode (TestGraph gr) n nl =-   Graph.lookupNode n (Graph.insertNode n nl gr) == Just nl--lookupNodeLabels :: TestGraph -> Node -> Bool-lookupNodeLabels (TestGraph gr) n =-   Graph.lookupNode n gr == Map.lookup n (Graph.nodeLabels gr)--deleteNodeIfExists :: Node -> MonoGraph -> MonoGraph-deleteNodeIfExists n gr =-   maybe gr (const $ Graph.deleteNode n gr) $ Graph.lookupNode n gr--deleteNodeIsConsistent :: TestGraph -> Node -> Bool-deleteNodeIsConsistent (TestGraph gr) n =-   Graph.isConsistent $ deleteNodeIfExists n gr--deleteInsertNode :: TestGraph -> Node -> NodeLabel -> Bool-deleteInsertNode (TestGraph gr) n nl =-   Graph.deleteNode n (Graph.insertNode n nl gr)-   ==-   deleteNodeIfExists n gr--insertDeleteNode :: TestGraph -> Node -> NodeLabel -> Bool-insertDeleteNode (TestGraph gr) n nl =-   let isolated =-         maybe False (const True) (Graph.lookupNode n gr)-         &&-         Set.null (Graph.adjacentEdgeSet gr n)-   in  isolated `implies`-       Graph.insertNode n nl gr-       ==-       Graph.insertNode n nl (Graph.deleteNode n gr)---insertEdgeIsConsistent :: GraphAndEdge -> EdgeLabel -> Bool-insertEdgeIsConsistent (GraphAndEdge gr e) el =-   Graph.isConsistent $ Graph.insertEdge e el gr--insertLookupEdge :: GraphAndEdge -> EdgeLabel -> Bool-insertLookupEdge (GraphAndEdge gr e) el =-   Graph.lookupEdge e (Graph.insertEdge e el gr) == Just el--lookupEdgeLabels :: GraphAndEdge -> Bool-lookupEdgeLabels (GraphAndEdge gr e) =-   Graph.lookupEdge e gr == Map.lookup e (Graph.edgeLabels gr)--deleteEdgeIsConsistent :: GraphAndEdge -> Bool-deleteEdgeIsConsistent (GraphAndEdge gr e) =-   Graph.isConsistent $ Graph.deleteEdge e gr--deleteInsertEdge :: GraphAndEdge -> EdgeLabel -> Bool-deleteInsertEdge (GraphAndEdge gr e) el =-   Graph.deleteEdge e (Graph.insertEdge e el gr)-   ==-   Graph.deleteEdge e gr--insertDeleteEdge :: GraphAndEdge -> EdgeLabel -> Bool-insertDeleteEdge (GraphAndEdge gr e) el =-   Graph.insertEdge e el gr-   ==-   Graph.insertEdge e el (Graph.deleteEdge e gr)--filterDeleteEdge :: GraphAndEdge -> Bool-filterDeleteEdge (GraphAndEdge gr e) =-   Graph.filterEdgeWithKey (\ei _ -> e/=ei) gr == Graph.deleteEdge e gr---nodeAction :: (Monad m) => NodeLabel -> MS.StateT NodeLabel m NodeLabel-nodeAction x = do y <- MS.get; MS.put x; return y--evalTraverseNode :: NodeLabel -> MonoGraph -> MonoGraph-evalTraverseNode nl =-   flip MS.evalState nl . Graph.traverseNode nodeAction--traverseNodeIsConsistent :: TestGraph -> NodeLabel -> Bool-traverseNodeIsConsistent (TestGraph gr) nl =-   Graph.isConsistent $ evalTraverseNode nl gr---edgeAction :: (Monad m) => EdgeLabel -> MS.StateT EdgeLabel m EdgeLabel-edgeAction x = MS.modify (x+) >> MS.get--evalTraverseEdge :: EdgeLabel -> MonoGraph -> MonoGraph-evalTraverseEdge el =-   flip MS.evalState el . Graph.traverseEdge edgeAction--traverseEdgeIsConsistent :: TestGraph -> EdgeLabel -> Bool-traverseEdgeIsConsistent (TestGraph gr) el =-   Graph.isConsistent $ evalTraverseEdge el gr--evalTraverse :: NodeLabel -> EdgeLabel -> MonoGraph -> MonoGraph-evalTraverse nl el =-   flip MS.evalState el . flip MS.evalStateT nl .-   Graph.traverse nodeAction (MT.lift . edgeAction)--traverseIsConsistent :: TestGraph -> NodeLabel -> EdgeLabel -> Bool-traverseIsConsistent (TestGraph gr) nl el =-   Graph.isConsistent $ evalTraverse nl el gr---traverseNodeEdge :: TestGraph -> NodeLabel -> EdgeLabel -> Bool-traverseNodeEdge (TestGraph gr) nl el =-   evalTraverseNode nl (evalTraverseEdge el gr)-   ==-   evalTraverse nl el gr--traverseEdgeNode :: TestGraph -> NodeLabel -> EdgeLabel -> Bool-traverseEdgeNode (TestGraph gr) nl el =-   evalTraverseEdge el (evalTraverseNode nl gr)-   ==-   evalTraverse nl el gr---traverseNode :: TestGraph -> NodeLabel -> Bool-traverseNode (TestGraph gr) nl =-   flip MS.evalState nl (Graph.traverseNode nodeAction gr)-   ==-   flip MS.evalState nl (Graph.traverse nodeAction pure gr)--traverseEdge :: TestGraph -> EdgeLabel -> Bool-traverseEdge (TestGraph gr) el =-   flip MS.evalState el (Graph.traverseEdge edgeAction gr)-   ==-   flip MS.evalState el (Graph.traverse pure edgeAction gr)---traverseMapNode :: TestGraph -> Bool-traverseMapNode (TestGraph gr) =-   runIdentity (Graph.traverseNode (Identity . Char.toUpper) gr)-   ==-   Graph.mapNode Char.toUpper gr+-- Do not edit! Automatically created with doctest-extract.+module Main where -traverseMapEdge :: TestGraph -> EdgeLabel -> Bool-traverseMapEdge (TestGraph gr) el =-   runIdentity (Graph.traverseEdge (Identity . (el+)) gr)-   ==-   Graph.mapEdge (el+) gr+import qualified Test.Data.Graph.Comfort +import qualified Test.DocTest.Driver as DocTest  main :: IO ()-main = do-   test "emptyIsEmpty" $ emptyIsEmpty-   test "emptyIsConsistent" $ emptyIsConsistent-   test "fromMapNodeEdgeLabels" $ fromMapNodeEdgeLabels-   test "reverseIsConsistent" $ reverseIsConsistent-   test "reverseReverse" $ reverseReverse-   test "mapNodeId" $ mapNodeId-   test "mapEdgeId" $ mapEdgeId--   test "insertNodeIsConsistent" $ insertNodeIsConsistent-   test "insertLookupNode" $ insertLookupNode-   test "lookupNodeLabels" $ lookupNodeLabels-   test "deleteNodeIsConsistent" $ deleteNodeIsConsistent-   test "deleteInsertNode" $ deleteInsertNode-   test "insertDeleteNode" $ insertDeleteNode--   test "insertEdgeIsConsistent" $ insertEdgeIsConsistent-   test "insertLookupEdge" $ insertLookupEdge-   test "lookupEdgeLabels" $ lookupEdgeLabels-   test "deleteEdgeIsConsistent" $ deleteEdgeIsConsistent-   test "deleteInsertEdge" $ deleteInsertEdge-   test "insertDeleteEdge" $ insertDeleteEdge-   test "filterDeleteEdge" $ filterDeleteEdge--   test "traverseNodeIsConsistent" $ traverseNodeIsConsistent-   test "traverseEdgeIsConsistent" $ traverseEdgeIsConsistent-   test "traverseIsConsistent" $ traverseIsConsistent-   test "traverseNodeEdge" $ traverseNodeEdge-   test "traverseEdgeNode" $ traverseEdgeNode-   test "traverseNode" $ traverseNode-   test "traverseEdge" $ traverseEdge-   test "traverseMapNode" $ traverseMapNode-   test "traverseMapEdge" $ traverseMapEdge+main = DocTest.run $ do+    Test.Data.Graph.Comfort.test

@@ -0,0 +1,57 @@+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]

@@ -0,0 +1,196 @@+-- Do not edit! Automatically created with doctest-extract from src/Data/Graph/Comfort.hs+{-# LINE 91 "src/Data/Graph/Comfort.hs" #-}++module Test.Data.Graph.Comfort where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 92 "src/Data/Graph/Comfort.hs" #-}+import     Test.Base++import     qualified Data.Graph.Comfort as Graph+import     qualified Data.Map as Map+import     qualified Data.Set as Set+import     qualified Data.Char as Char++import     qualified Control.Monad.Trans.Class as MT+import     qualified Control.Monad.Trans.State as MS+import     Control.Applicative (pure)+import     Data.Functor.Identity (Identity(Identity), runIdentity)++import     qualified Test.QuickCheck as QC+import     Test.QuickCheck ((==>))++deleteNodeIfExists     :: Node -> MonoGraph -> MonoGraph+deleteNodeIfExists     n gr =+       maybe gr (const $ Graph.deleteNode n gr) $ Graph.lookupNode n gr++isolated     :: (Graph.Edge e, Ord n) => Graph.Graph e n el nl -> n -> Bool+isolated     gr n = Set.null (Graph.adjacentEdgeSet gr n)++nodeAction     :: (Monad m) => NodeLabel -> MS.StateT NodeLabel m NodeLabel+nodeAction     x = do y <- MS.get; MS.put x; return y++evalTraverseNode     :: NodeLabel -> MonoGraph -> MonoGraph+evalTraverseNode     nl =+       flip MS.evalState nl . Graph.traverseNode nodeAction++edgeAction     :: (Monad m) => EdgeLabel -> MS.StateT EdgeLabel m EdgeLabel+edgeAction     x = MS.modify (x+) >> MS.get++evalTraverseEdge     :: EdgeLabel -> MonoGraph -> MonoGraph+evalTraverseEdge     el =+       flip MS.evalState el . Graph.traverseEdge edgeAction++evalTraverse     :: NodeLabel -> EdgeLabel -> MonoGraph -> MonoGraph+evalTraverse     nl el =+       flip MS.evalState el . flip MS.evalStateT nl .+       Graph.traverse nodeAction (MT.lift . edgeAction)++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Data.Graph.Comfort:358: "+{-# LINE 358 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 358 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) -> Graph.isConsistent (Graph.reverse gr))+ DocTest.printPrefix "Data.Graph.Comfort:359: "+{-# LINE 359 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 359 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) -> Graph.reverse (Graph.reverse gr) == gr)+ DocTest.printPrefix "Data.Graph.Comfort:410: "+{-# LINE 410 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 410 "src/Data/Graph/Comfort.hs" #-}+     (Graph.isEmpty (Graph.empty :: MonoGraph))+ DocTest.printPrefix "Data.Graph.Comfort:411: "+{-# LINE 411 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 411 "src/Data/Graph/Comfort.hs" #-}+     (Graph.isConsistent (Graph.empty :: MonoGraph))+ DocTest.printPrefix "Data.Graph.Comfort:465: "+{-# LINE 465 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 465 "src/Data/Graph/Comfort.hs" #-}+     (\(GraphAndEdge gr e) -> Graph.lookupEdge e gr == Map.lookup e (Graph.edgeLabels gr))+ DocTest.printPrefix "Data.Graph.Comfort:483: "+{-# LINE 483 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 483 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) n -> Graph.lookupNode n gr == Map.lookup n (Graph.nodeLabels gr))+ DocTest.printPrefix "Data.Graph.Comfort:527: "+{-# LINE 527 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 527 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) n -> Graph.isConsistent $ deleteNodeIfExists n gr)+ DocTest.printPrefix "Data.Graph.Comfort:528: "+{-# LINE 528 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 528 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) n nl -> Graph.deleteNode n (Graph.insertNode n nl gr) == deleteNodeIfExists n gr)+ DocTest.printPrefix "Data.Graph.Comfort:529: "+{-# LINE 529 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 529 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) -> let isolatedNodes = filter (isolated gr) $ Graph.nodes gr in not (null isolatedNodes) ==> QC.forAll (QC.elements isolatedNodes) $ \n nl -> Graph.insertNode n nl gr == Graph.insertNode n nl (Graph.deleteNode n gr))+ DocTest.printPrefix "Data.Graph.Comfort:555: "+{-# LINE 555 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 555 "src/Data/Graph/Comfort.hs" #-}+     (\(GraphAndEdge gr e) -> Graph.isConsistent $ Graph.deleteEdge e gr)+ DocTest.printPrefix "Data.Graph.Comfort:556: "+{-# LINE 556 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 556 "src/Data/Graph/Comfort.hs" #-}+     (\(GraphAndEdge gr e) el -> Graph.deleteEdge e (Graph.insertEdge e el gr) == Graph.deleteEdge e gr)+ DocTest.printPrefix "Data.Graph.Comfort:557: "+{-# LINE 557 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 557 "src/Data/Graph/Comfort.hs" #-}+     (\(GraphAndEdge gr e) el -> Graph.insertEdge e el gr == Graph.insertEdge e el (Graph.deleteEdge e gr))+ DocTest.printPrefix "Data.Graph.Comfort:568: "+{-# LINE 568 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 568 "src/Data/Graph/Comfort.hs" #-}+     (\(GraphAndEdge gr e) -> Graph.filterEdgeWithKey (\ei _ -> e/=ei) gr == Graph.deleteEdge e gr)+ DocTest.printPrefix "Data.Graph.Comfort:621: "+{-# LINE 621 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 621 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) n nl -> Graph.isConsistent $ Graph.insertNode n nl gr)+ DocTest.printPrefix "Data.Graph.Comfort:622: "+{-# LINE 622 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 622 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) n nl -> Graph.lookupNode n (Graph.insertNode n nl gr) == Just nl)+ DocTest.printPrefix "Data.Graph.Comfort:634: "+{-# LINE 634 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 634 "src/Data/Graph/Comfort.hs" #-}+     (\(GraphAndEdge gr e) el -> Graph.isConsistent $ Graph.insertEdge e el gr)+ DocTest.printPrefix "Data.Graph.Comfort:635: "+{-# LINE 635 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 635 "src/Data/Graph/Comfort.hs" #-}+     (\(GraphAndEdge gr e) el -> Graph.lookupEdge e (Graph.insertEdge e el gr) == Just el)+ DocTest.printPrefix "Data.Graph.Comfort:669: "+{-# LINE 669 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 669 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) -> gr == Graph.fromMap (Graph.nodeLabels gr) (Graph.edgeLabels gr))+ DocTest.printPrefix "Data.Graph.Comfort:689: "+{-# LINE 689 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 689 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) -> Graph.mapNode id gr == gr)+ DocTest.printPrefix "Data.Graph.Comfort:702: "+{-# LINE 702 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 702 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) -> Graph.mapEdge id gr == gr)+ DocTest.printPrefix "Data.Graph.Comfort:738: "+{-# LINE 738 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 738 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) nl -> Graph.isConsistent $ evalTraverseNode nl gr)+ DocTest.printPrefix "Data.Graph.Comfort:739: "+{-# LINE 739 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 739 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) -> runIdentity (Graph.traverseNode (Identity . Char.toUpper) gr) == Graph.mapNode Char.toUpper gr)+ DocTest.printPrefix "Data.Graph.Comfort:752: "+{-# LINE 752 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 752 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) el -> Graph.isConsistent $ evalTraverseEdge el gr)+ DocTest.printPrefix "Data.Graph.Comfort:753: "+{-# LINE 753 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 753 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) el -> runIdentity (Graph.traverseEdge (Identity . (el+)) gr) == Graph.mapEdge (el+) gr)+ DocTest.printPrefix "Data.Graph.Comfort:764: "+{-# LINE 764 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 764 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) nl el -> Graph.isConsistent $ evalTraverse nl el gr)+ DocTest.printPrefix "Data.Graph.Comfort:765: "+{-# LINE 765 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 765 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) nl el -> evalTraverse nl el gr == evalTraverseNode nl (evalTraverseEdge el gr))+ DocTest.printPrefix "Data.Graph.Comfort:766: "+{-# LINE 766 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 766 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) nl el -> evalTraverse nl el gr == evalTraverseEdge el (evalTraverseNode nl gr))+ DocTest.printPrefix "Data.Graph.Comfort:767: "+{-# LINE 767 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 767 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) nl -> flip MS.evalState nl (Graph.traverseNode nodeAction gr) == flip MS.evalState nl (Graph.traverse nodeAction pure gr))+ DocTest.printPrefix "Data.Graph.Comfort:768: "+{-# LINE 768 "src/Data/Graph/Comfort.hs" #-}+ DocTest.property+{-# LINE 768 "src/Data/Graph/Comfort.hs" #-}+     (\(TestGraph gr) el -> flip MS.evalState el (Graph.traverseEdge edgeAction gr) == flip MS.evalState el (Graph.traverse pure edgeAction gr))