@@ -0,0 +1,155 @@
1+module Hakyll.Core.DependencyAnalyzer
2+ ( DependencyAnalyzer
3+ , Signal (..)
4+ , makeDependencyAnalyzer
5+ , step
6+ , stepAll
7+ ) where
8+
9+import Prelude hiding (reverse)
10+import qualified Prelude as P (reverse)
11+import Control.Arrow (first)
12+import Data.Set (Set)
13+import qualified Data.Set as S
14+import Data.Monoid (Monoid, mappend, mempty)
15+
16+import Hakyll.Core.DirectedGraph
17+
18+-- | This data structure represents the state of the dependency analyzer. It
19+-- holds a complete graph in 'analyzerGraph', which always contains all items,
20+-- whether they are to be compiled or not.
21+--
22+-- The 'analyzerRemains' fields holds the items that still need to be compiled,
23+-- and 'analyzerDone' holds the items which are already compiled. This means
24+-- that initally, 'analyzerDone' is empty and 'analyzerRemains' contains the
25+-- items which are out-of-date (or items which have out-of-date dependencies).
26+--
27+-- We also hold the dependency graph from the previous run because we need it
28+-- when we want to determine when an item is out-of-date. An item is out-of-date
29+-- when:
30+--
31+-- * the resource from which it compiles is out-of-date, or;
32+--
33+-- * any of it's dependencies is out-of-date, or;
34+--
35+-- * it's set of dependencies has changed since the previous run.
36+--
37+data DependencyAnalyzer a = DependencyAnalyzer
38+ { -- | The complete dependency graph
39+ analyzerGraph :: DirectedGraph a
40+ , -- | A set of items yet to be compiled
41+ analyzerRemains :: Set a
42+ , -- | A set of items already compiled
43+ analyzerDone :: Set a
44+ , -- | The dependency graph from the previous run
45+ analyzerPreviousGraph :: DirectedGraph a
46+ } deriving (Show)
47+
48+data Signal a = Build a
49+ | Cycle [a]
50+ | Done
51+
52+instance (Ord a, Show a) => Monoid (DependencyAnalyzer a) where
53+ mempty = DependencyAnalyzer mempty mempty mempty mempty
54+ mappend x y = growRemains $ DependencyAnalyzer
55+ (analyzerGraph x `mappend` analyzerGraph y)
56+ (analyzerRemains x `mappend` analyzerRemains y)
57+ (analyzerDone x `mappend` analyzerDone y)
58+ (analyzerPreviousGraph x `mappend` analyzerPreviousGraph y)
59+
60+-- | Construct a dependency analyzer
61+--
62+makeDependencyAnalyzer :: (Ord a, Show a)
63+ => DirectedGraph a -- ^ The dependency graph
64+ -> (a -> Bool) -- ^ Is an item out-of-date?
65+ -> DirectedGraph a -- ^ The old dependency graph
66+ -> DependencyAnalyzer a -- ^ Resulting analyzer
67+makeDependencyAnalyzer graph isOutOfDate prev =
68+ growRemains $ DependencyAnalyzer graph remains S.empty prev
69+ where
70+ -- Construct the remains set by filtering using the given predicate
71+ remains = S.fromList $ filter isOutOfDate $ map fst $ toList graph
72+
73+-- | The 'analyzerRemains' field of a 'DependencyAnalyzer' is supposed to
74+-- contain all out-of-date items, including the items with out-of-date
75+-- dependencies. However, it is easier to just set up the directly out-of-date
76+-- items initially -- and then grow the remains fields.
77+--
78+-- This function assumes the 'analyzerRemains' fields in incomplete, and tries
79+-- to correct it. Running it when the field is complete has no effect -- but it
80+-- is a pretty expensive function, and it should be used with care.
81+--
82+growRemains :: (Ord a, Show a) => DependencyAnalyzer a -> DependencyAnalyzer a
83+growRemains (DependencyAnalyzer graph remains done prev) =
84+ (DependencyAnalyzer graph remains' done prev)
85+ where
86+ -- Grow the remains set using the indirect and changedDeps values, then
87+ -- filter out the items already done
88+ remains' = S.filter (`S.notMember` done) indirect
89+
90+ -- Select the nodes which are reachable from the remaining nodes in the
91+ -- reversed dependency graph: these are the indirectly out-of-date items
92+ indirect = reachableNodes (remains `S.union` changedDeps) $ reverse graph
93+
94+ -- For all nodes in the graph, check which items have a different dependency
95+ -- set compared to the previous run
96+ changedDeps = S.fromList $ map fst $
97+ filter (uncurry (/=) . first (`neighbours` prev)) $ toList graph
98+
99+-- | Step a dependency analyzer
100+--
101+step :: (Ord a, Show a) => DependencyAnalyzer a -> (Signal a, DependencyAnalyzer a)
102+step analyzer@(DependencyAnalyzer graph remains done prev)
103+ -- No remaining items
104+ | S.null remains = (Done, analyzer)
105+ -- An item remains, let's find a ready item
106+ | otherwise =
107+ let item = S.findMin remains
108+ in case findReady analyzer item of
109+ Done -> (Done, analyzer)
110+ Cycle c -> (Cycle c, analyzer)
111+ -- A ready item was found, signal a build
112+ Build build ->
113+ let remains' = S.delete build remains
114+ done' = S.insert build done
115+ in (Build build, DependencyAnalyzer graph remains' done' prev)
116+
117+-- | Step until done, creating a set of items we need to build -- mostly used
118+-- for debugging purposes
119+--
120+stepAll :: (Ord a, Show a) => DependencyAnalyzer a -> Maybe (Set a)
121+stepAll = stepAll' S.empty
122+ where
123+ stepAll' xs analyzer = case step analyzer of
124+ (Build x, analyzer') -> stepAll' (S.insert x xs) analyzer'
125+ (Done, _) -> Just xs
126+ (Cycle _, _) -> Nothing
127+
128+-- | Find an item ready to be compiled
129+--
130+findReady :: (Ord a, Show a) => DependencyAnalyzer a -> a -> Signal a
131+findReady analyzer = findReady' [] S.empty
132+ where
133+ -- The dependency graph
134+ graph = analyzerGraph analyzer
135+
136+ -- Items to do
137+ todo = analyzerRemains analyzer `S.difference` analyzerDone analyzer
138+
139+ -- Worker
140+ findReady' stack visited item
141+ -- We already visited this item, the cycle is the reversed stack
142+ | item `S.member` visited = Cycle $ P.reverse stack'
143+ -- Look at the neighbours we to do
144+ | otherwise = case filter (`S.member` todo) neighbours' of
145+ -- No neighbours available to be done: it's ready!
146+ [] -> Build item
147+ -- At least one neighbour is available, search for that one
148+ (x : _) -> findReady' stack' visited' x
149+ where
150+ -- Our neighbours
151+ neighbours' = S.toList $ neighbours item graph
152+
153+ -- The new visited stack/set
154+ stack' = item : stack
155+ visited' = S.insert item visited