diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014 factis research GmbH +Copyright (c) 2014 - 2016 factis research GmbH Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/graph-core.cabal b/graph-core.cabal --- a/graph-core.cabal +++ b/graph-core.cabal @@ -1,5 +1,5 @@ name: graph-core -version: 0.2.2.0 +version: 0.3.0.0 synopsis: Fast, memory efficient and persistent graph implementation description: A small package providing a powerful and easy to use Haskell graph implementation. homepage: https://github.com/factisresearch/graph-core @@ -7,7 +7,7 @@ license-file: LICENSE author: Stefan Wehr , David Leuschner , Niklas Baumstark, Jonathan Dimond, Alexander Thiemann maintainer: Alexander Thiemann -copyright: (c) 2014 factis research GmbH +copyright: (c) 2014 - 2016 factis research GmbH category: Data build-type: Simple cabal-version: >=1.8 @@ -22,16 +22,15 @@ safe >=0.3, deepseq >=1.3, vector >=0.10, - QuickCheck >=2.6, mtl >=2.1 hs-source-dirs: src - ghc-options: -Wall -fno-warn-orphans + ghc-options: -Wall test-suite graph-core-tests type: exitcode-stdio-1.0 hs-source-dirs: src main-is: Tests.hs - other-modules: Test.NodeManager, Test.Core, Test.Persistence + other-modules: Test.NodeManager, Test.Core, Test.Persistence, Test.Arbitrary build-depends: base >=4.6 && <5, hashable >=1.2, unordered-containers >=0.2, @@ -46,4 +45,4 @@ source-repository head type: git - location: git://github.com/factisresearch/graph-core.git + location: https://github.com/factisresearch/graph-core.git diff --git a/src/Data/Core/Graph/NodeManager.hs b/src/Data/Core/Graph/NodeManager.hs --- a/src/Data/Core/Graph/NodeManager.hs +++ b/src/Data/Core/Graph/NodeManager.hs @@ -16,7 +16,6 @@ import Control.Monad.State.Strict import Data.Hashable import Data.Maybe -import Test.QuickCheck (NonNegative(..), Arbitrary(..)) import qualified Data.HashMap.Strict as HM import qualified Data.IntMap.Strict as IM import qualified Data.IntSet as IS @@ -110,6 +109,3 @@ unsafeLookupNode :: Node -> NodeManager k -> k unsafeLookupNode i nm = fromJust $ lookupNode i nm - -instance Arbitrary v => Arbitrary (IM.IntMap v) where - arbitrary = fmap (IM.fromList . map (\(NonNegative i, x) -> (i, x))) arbitrary diff --git a/src/Data/Core/Graph/PureCore.hs b/src/Data/Core/Graph/PureCore.hs --- a/src/Data/Core/Graph/PureCore.hs +++ b/src/Data/Core/Graph/PureCore.hs @@ -18,7 +18,6 @@ import Data.Hashable import Data.Maybe import Data.STRef -import Test.QuickCheck import qualified Data.Foldable as F import qualified Data.HashSet as HS import qualified Data.IntMap.Strict as IM @@ -191,13 +190,3 @@ else do newAcc <- f acc x let succs = IM.findWithDefault VU.empty x adj go (IS.insert x visited) newAcc (xs ++ VU.toList succs) - -instance Arbitrary Graph where - arbitrary = frequency [(1, return empty), (20, denseGraph)] - where denseGraph = - do n <- choose (0, 30::Int) - let nodeList = [1..n] - adj <- forM nodeList $ \i -> - do bits <- vectorOf n arbitrary - return (i, [ x | (x,b) <- zip nodeList bits, b ]) - return $ fromAdj adj diff --git a/src/Test/Arbitrary.hs b/src/Test/Arbitrary.hs new file mode 100644 --- /dev/null +++ b/src/Test/Arbitrary.hs @@ -0,0 +1,23 @@ +module Test.Arbitrary where + +import Test.QuickCheck +import Control.Monad (forM) +import Data.Core.Graph.NodeManager (NodeMap) +import Data.Core.Graph.PureCore (Graph, empty, fromAdj) +import qualified Data.IntMap.Strict as IM + + +newtype TestNodeMap v = TestNodeMap(NodeMap v) deriving Show + +instance Arbitrary v => Arbitrary (TestNodeMap v) where + arbitrary = fmap (TestNodeMap . IM.fromList . map (\(NonNegative i, x) -> (i, x))) arbitrary + +instance Arbitrary Graph where + arbitrary = frequency [(1, return empty), (20, denseGraph)] + where denseGraph = + do n <- choose (0, 30::Int) + let nodeList = [1..n] + adj <- forM nodeList $ \i -> + do bits <- vectorOf n arbitrary + return (i, [ x | (x,b) <- zip nodeList bits, b ]) + return $ fromAdj adj diff --git a/src/Test/Core.hs b/src/Test/Core.hs --- a/src/Test/Core.hs +++ b/src/Test/Core.hs @@ -5,6 +5,7 @@ import Data.Core.Graph.NodeManager (Node) import Control.Monad +import Test.Arbitrary () import Test.Framework import qualified Data.IntSet as IS diff --git a/src/Test/NodeManager.hs b/src/Test/NodeManager.hs --- a/src/Test/NodeManager.hs +++ b/src/Test/NodeManager.hs @@ -3,6 +3,7 @@ import Data.Core.Graph.NodeManager +import Test.Arbitrary import Test.Framework import Control.Monad.State.Strict import qualified Data.IntMap.Strict as IM @@ -11,8 +12,8 @@ assertConsistent :: StateT (NodeManager Char) IO () assertConsistent = get >>= liftIO . assertEqual True . isConsistent -prop_init :: NodeMap String -> Property -prop_init m = uniqueValues m && all (>=0) (IM.keys m) +prop_init :: TestNodeMap String -> Property +prop_init (TestNodeMap m) = uniqueValues m && all (>=0) (IM.keys m) ==> isConsistent new && m == getNodeMap new where new = initNodeManager m uniqueValues im = IM.size im == length (L.nub $ IM.elems im) diff --git a/src/Test/Persistence.hs b/src/Test/Persistence.hs --- a/src/Test/Persistence.hs +++ b/src/Test/Persistence.hs @@ -5,10 +5,11 @@ import Data.Core.Graph.NodeManager import Data.Core.Graph.Persistence +import Test.Arbitrary import Test.Framework -prop_persistence :: NodeMap Char -> Graph -> Bool -prop_persistence nodeMap graph = +prop_persistence :: TestNodeMap Char -> Graph -> Bool +prop_persistence (TestNodeMap nodeMap) graph = let nodeMgr = initNodeManager nodeMap (nodeMgr', graph') = loadGraph (persistGraph nodeMgr graph) in (nodeMgr' == nodeMgr && graph == graph')