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