git.iko.soy/hakyll
on eabc268 help sign in
hakyll/src/Hakyll/Core/DirectedGraph.hs
87 lines 2.6 kB history raw
1-- | Representation of a directed graph. In Hakyll, this is used for dependency
2-- tracking.
3--
4module Hakyll.Core.DirectedGraph
5 ( DirectedGraph
6 , fromList
7 , neighbours
8 , reverse
9 , filter
10 , reachableNodes
11 ) where
13import Prelude hiding (reverse, filter)
14import Data.Monoid (mconcat)
15import Data.Set (Set)
16import Data.Maybe (fromMaybe)
17import qualified Data.Map as M
18import qualified Data.Set as S
20import Hakyll.Core.DirectedGraph.Internal
22-- | Construction of directed graphs
23--
24fromList :: Ord a
25 => [(a, Set a)] -- ^ List of (node, reachable neighbours)
26 -> DirectedGraph a -- ^ Resulting directed graph
27fromList = DirectedGraph . M.fromList . map (\(t, d) -> (t, Node t d))
29-- | Get a set of reachable neighbours from a directed graph
30--
31neighbours :: Ord a
32 => a -- ^ Node to get the neighbours of
33 -> DirectedGraph a -- ^ Graph to search in
34 -> Set a -- ^ Set containing the neighbours
35neighbours x = fromMaybe S.empty . fmap nodeNeighbours
36 . M.lookup x . unDirectedGraph
38-- | Reverse a directed graph (i.e. flip all edges)
39--
40reverse :: Ord a
41 => DirectedGraph a
42 -> DirectedGraph a
43reverse = mconcat . map reverse' . M.toList . unDirectedGraph
44 where
45 reverse' (id', Node _ neighbours') = fromList $
46 zip (S.toList neighbours') $ repeat $ S.singleton id'
48-- | Filter a directed graph (i.e. remove nodes based on a predicate)
49--
50filter :: Ord a
51 => (a -> Bool) -- ^ Predicate
52 -> DirectedGraph a -- ^ Graph
53 -> DirectedGraph a -- ^ Resulting graph
54filter predicate =
55 DirectedGraph . M.filterWithKey (\k _ -> predicate k) . unDirectedGraph
57-- | Find all reachable nodes from a given node in the directed graph
58--
59reachableNodes :: Ord a => a -> DirectedGraph a -> Set a
60reachableNodes x graph = reachable (neighbours x graph) (S.singleton x)
61 where
62 reachable next visited
63 | S.null next = visited
64 | otherwise = reachable (sanitize neighbours') (next `S.union` visited)
65 where
66 sanitize = S.filter (`S.notMember` visited)
67 neighbours' = S.unions $ map (flip neighbours graph)
68 $ S.toList $ sanitize next
70{-
71exampleGraph :: DirectedGraph Int
72exampleGraph = fromList
73 [ makeNode 8 [2, 4, 6]
74 , makeNode 2 [4, 3]
75 , makeNode 4 [3]
76 , makeNode 6 [4]
77 , makeNode 3 []
78 ]
79 where
80 makeNode tag deps = (tag, S.fromList deps)
82cyclic :: DirectedGraph Int
83cyclic = fromList
84 [ (1, S.fromList [2])
85 , (2, S.fromList [1, 3])
86 ]
87-}