comfort-graph 0.0.0.2 → 0.0.0.3
raw patch · 3 files changed
+298/−5 lines, 3 filesdep +comfort-graphdep ~QuickCheckdep ~basedep ~containersPVP ok
version bump matches the API change (PVP)
Dependencies added: comfort-graph
Dependency ranges changed: QuickCheck, base, containers, transformers, utility-ht
API changes (from Hackage documentation)
Files
- comfort-graph.cabal +16/−2
- src/Data/Graph/Comfort.hs +7/−3
- test/Main.hs +275/−0
comfort-graph.cabal view
@@ -1,5 +1,5 @@ Name: comfort-graph-Version: 0.0.0.2+Version: 0.0.0.3 Synopsis: Graph structure with type parameters for nodes and edges Description: This graph structure is based on "Data.Map"@@ -51,7 +51,7 @@ Cabal-Version: >=1.10 Source-Repository this- Tag: 0.0.0.2+ Tag: 0.0.0.3 Type: darcs Location: http://hub.darcs.net/thielema/comfort-graph @@ -74,5 +74,19 @@ utility-ht >=0.0.10 && <0.1, base >=4.5 && <5 Hs-Source-Dirs: src+ Default-Language: Haskell2010+ GHC-Options: -Wall++Test-Suite test-comfort-graph+ Type: exitcode-stdio-1.0+ Hs-Source-Dirs: test+ Main-is: Main.hs+ Build-Depends:+ comfort-graph,+ QuickCheck >=2 && <3,+ transformers,+ containers,+ utility-ht,+ base Default-Language: Haskell2010 GHC-Options: -Wall
src/Data/Graph/Comfort.hs view
@@ -59,7 +59,7 @@ import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold import Control.Monad (liftM2, (=<<))-import Control.Applicative (Applicative, pure, liftA2, liftA3)+import Control.Applicative (Applicative, liftA2, liftA3) import Data.Foldable (Foldable, foldMap) import Data.Set (Set) import Data.Map (Map)@@ -590,7 +590,10 @@ traverseNode :: (Applicative f, Edge e, Ord n) => (nl0 -> f nl1) -> Graph e n el nl0 -> f (Graph e n el nl1)-traverseNode f = traverse f pure+traverseNode f =+ fmap Graph .+ Trav.traverse (\(ins,nl0,outs) -> fmap (\nl1 -> (ins, nl1, outs)) $ f nl0) .+ graphMapWrap {- | Same restrictions as in 'traverse'.@@ -598,7 +601,8 @@ traverseEdge :: (Applicative f, Edge e, Ord n) => (el0 -> f el1) -> Graph e n el0 nl -> f (Graph e n el1 nl)-traverseEdge f = traverse pure f+traverseEdge f gr =+ fmap (fromMap (nodeLabels gr)) $ Trav.traverse f $ edgeLabels gr {- | Don't rely on a particular order of traversal!
+ test/Main.hs view
@@ -0,0 +1,275 @@+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.adjacentEdges 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++traverseMapEdge :: TestGraph -> EdgeLabel -> Bool+traverseMapEdge (TestGraph gr) el =+ runIdentity (Graph.traverseEdge (Identity . (el+)) gr)+ ==+ Graph.mapEdge (el+) gr+++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