diff options
-rw-r--r-- | src/Hakyll/Core/DirectedGraph.hs | 27 | ||||
-rw-r--r-- | src/Hakyll/Core/DirectedGraph/DependencySolver.hs | 3 | ||||
-rw-r--r-- | src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs | 6 | ||||
-rw-r--r-- | tests/Hakyll/Core/DirectedGraph/Tests.hs | 48 | ||||
-rw-r--r-- | tests/TestSuite.hs | 11 |
5 files changed, 71 insertions, 24 deletions
diff --git a/src/Hakyll/Core/DirectedGraph.hs b/src/Hakyll/Core/DirectedGraph.hs index 6dc6ae5..b24ce25 100644 --- a/src/Hakyll/Core/DirectedGraph.hs +++ b/src/Hakyll/Core/DirectedGraph.hs @@ -4,6 +4,7 @@ module Hakyll.Core.DirectedGraph ( DirectedGraph , fromList + , nodes , neighbours , reverse , filter @@ -26,6 +27,13 @@ fromList :: Ord a -> DirectedGraph a -- ^ Resulting directed graph fromList = DirectedGraph . M.fromList . map (\(t, d) -> (t, Node t d)) +-- | Get all nodes in the graph +-- +nodes :: Ord a + => DirectedGraph a -- ^ Graph to get the nodes from + -> Set a -- ^ All nodes in the graph +nodes = M.keysSet . unDirectedGraph + -- | Get a set of reachable neighbours from a directed graph -- neighbours :: Ord a @@ -66,22 +74,3 @@ reachableNodes x graph = reachable (neighbours x graph) (S.singleton x) sanitize = S.filter (`S.notMember` visited) neighbours' = S.unions $ map (flip neighbours graph) $ S.toList $ sanitize next - -{- -exampleGraph :: DirectedGraph Int -exampleGraph = fromList - [ makeNode 8 [2, 4, 6] - , makeNode 2 [4, 3] - , makeNode 4 [3] - , makeNode 6 [4] - , makeNode 3 [] - ] - where - makeNode tag deps = (tag, S.fromList deps) - -cyclic :: DirectedGraph Int -cyclic = fromList - [ (1, S.fromList [2]) - , (2, S.fromList [1, 3]) - ] --} diff --git a/src/Hakyll/Core/DirectedGraph/DependencySolver.hs b/src/Hakyll/Core/DirectedGraph/DependencySolver.hs index dce59e0..17a4b69 100644 --- a/src/Hakyll/Core/DirectedGraph/DependencySolver.hs +++ b/src/Hakyll/Core/DirectedGraph/DependencySolver.hs @@ -15,7 +15,6 @@ import qualified Data.Map as M import qualified Data.Set as S import Hakyll.Core.DirectedGraph -import qualified Hakyll.Core.DirectedGraph as DG import Hakyll.Core.DirectedGraph.Internal -- | Solve a dependency graph. This function returns an order to run the @@ -55,7 +54,7 @@ order temp stack set graph@(DirectedGraph graph') -- All dependencies for node are satisfied, we can return it and -- remove it from the graph [] -> order (tag : temp) stackTail (S.delete tag set) - (DG.filter (== tag) graph) + (DirectedGraph $ M.delete tag graph') -- There is at least one dependency left. We need to solve that -- one first... diff --git a/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs b/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs index a3bc57a..f781819 100644 --- a/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs +++ b/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs @@ -4,7 +4,7 @@ -- obsolete nodes. -- module Hakyll.Core.DirectedGraph.ObsoleteFilter - ( obsoleteFilter + ( filterObsolete ) where import qualified Data.Set as S @@ -15,11 +15,11 @@ import qualified Hakyll.Core.DirectedGraph as DG -- | Given a list of obsolete items, filter the dependency graph so it only -- contains these items -- -obsoleteFilter :: Ord a +filterObsolete :: Ord a => [a] -- ^ List of obsolete items -> DirectedGraph a -- ^ Dependency graph -> DirectedGraph a -- ^ Resulting dependency graph -obsoleteFilter obsolete graph = +filterObsolete obsolete graph = let reversed = DG.reverse graph allObsolete = S.unions $ map (flip reachableNodes reversed) obsolete in DG.filter (`S.member` allObsolete) graph diff --git a/tests/Hakyll/Core/DirectedGraph/Tests.hs b/tests/Hakyll/Core/DirectedGraph/Tests.hs new file mode 100644 index 0000000..4ce5944 --- /dev/null +++ b/tests/Hakyll/Core/DirectedGraph/Tests.hs @@ -0,0 +1,48 @@ +module Hakyll.Core.DirectedGraph.Tests + ( tests + ) where + +import Data.Set (Set) +import qualified Data.Set as S + +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) + +import Hakyll.Core.DirectedGraph +import Hakyll.Core.DirectedGraph.DependencySolver +import Hakyll.Core.DirectedGraph.ObsoleteFilter + +tests :: [Test] +tests = + [ testCase "solveDependencies01" solveDependencies01 + , testCase "filterObsolete01" filterObsolete01 + , testCase "filterObsolete02" filterObsolete02 + ] + +node :: Ord a => a -> [a] -> (a, Set a) +node t n = (t, S.fromList n) + +testGraph01 :: DirectedGraph Int +testGraph01 = fromList + [ node 8 [2, 4, 6] + , node 2 [4, 3] + , node 4 [3] + , node 6 [4] + , node 3 [] + ] + +solveDependencies01 :: Assertion +solveDependencies01 = result == [3, 4, 2, 6, 8] || result == [3, 4, 2, 6, 8] + @? "solveDependencies01" + where + result = solveDependencies testGraph01 + +filterObsolete01 :: Assertion +filterObsolete01 = nodes (filterObsolete [6] testGraph01) == S.fromList [6, 8] + @? "filterObsolete01" + +filterObsolete02 :: Assertion +filterObsolete02 = + nodes (filterObsolete [4] testGraph01) == S.fromList [4, 2, 6, 8] + @? "filterObsolete02" diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs new file mode 100644 index 0000000..26b26f0 --- /dev/null +++ b/tests/TestSuite.hs @@ -0,0 +1,11 @@ +module TestSuite where + +import Test.Framework (defaultMain, testGroup) + +import qualified Hakyll.Core.DirectedGraph.Tests + +main :: IO () +main = defaultMain + [ testGroup "Hakyll.Core.DirectedGraph.Tests" + Hakyll.Core.DirectedGraph.Tests.tests + ] |