@@ -1,144 +0,0 @@
1−--------------------------------------------------------------------------------
2−module Hakyll.Core.DependencyAnalyzer
3− ( Analysis (..)
4− , analyze
5− ) where
6−
7−
8−--------------------------------------------------------------------------------
9−import Control.Applicative ((<$>))
10−import Control.DeepSeq (NFData (..))
11−import Control.Monad (filterM, forM_, msum, when)
12−import Control.Monad.Reader (ask)
13−import Control.Monad.RWS (RWS, runRWS)
14−import Control.Monad.State (evalState, get, modify)
15−import Control.Monad.Writer (tell)
16−import qualified Data.Map as M
17−import Data.Set (Set)
18−import qualified Data.Set as S
19−
20−
21−--------------------------------------------------------------------------------
22−import Hakyll.Core.DirectedGraph
23−
24−
25−--------------------------------------------------------------------------------
26−data Analysis a
27− = Cycle [a]
28− | Order [a]
29− deriving (Show)
30−
31−
32−--------------------------------------------------------------------------------
33−instance NFData a => NFData (Analysis a) where
34− rnf (Cycle c) = rnf c `seq` ()
35− rnf (Order o) = rnf o `seq` ()
36−
37−
38−--------------------------------------------------------------------------------
39−analyze :: Ord a
40− => DirectedGraph a -- ^ Old graph
41− -> DirectedGraph a -- ^ New graph
42− -> (a -> Bool) -- ^ Out of date?
43− -> Analysis a -- ^ Result
44−analyze old new ood = case findCycle new of
45− Just c -> Cycle c
46− Nothing -> Order $ findOrder old new ood
47−
48−
49−--------------------------------------------------------------------------------
50−-- | Simple algorithm do find a cycle in a graph, if any exists. This one can
51−-- still be optimised by a lot.
52−findCycle :: Ord a
53− => DirectedGraph a
54− -> Maybe [a]
55−findCycle dg = fmap reverse $ msum
56− [ findCycle' [x] x n
57− | x <- S.toList $ nodes dg
58− , n <- neighbours x dg
59− ]
60− where
61− findCycle' stack start x
62− | x == start = Just (x : stack)
63− | otherwise = msum
64− [ findCycle' (x : stack) start n
65− | n <- neighbours x dg
66− ]
67−
68−
69−--------------------------------------------------------------------------------
70−-- | Do not call this on graphs with cycles
71−findOrder :: Ord a
72− => DirectedGraph a
73− -> DirectedGraph a
74− -> (a -> Bool)
75− -> [a]
76−findOrder old new ood = ls
77− where
78− -- Make an extension of ood: an item is ood when it is actually ood OR if
79− -- the list of its dependencies has changed. Based on that, create a set of
80− -- dirty items.
81− ood' x = ood x || neighbours x old /= neighbours x new
82− dirty' = dirty ood' new
83−
84− -- Run all walks in our own little monad...
85− (_, _, ls) = runRWS walks new dirty'
86−
87−
88−--------------------------------------------------------------------------------
89−type Analyzer i a = RWS (DirectedGraph i) [i] (Set i) a
90−
91−
92−--------------------------------------------------------------------------------
93−isDirty :: Ord a => a -> Analyzer a Bool
94−isDirty x = (x `S.member`) <$> get
95−
96−
97−--------------------------------------------------------------------------------
98−walks :: Ord a
99− => Analyzer a ()
100−walks = do
101− dirty' <- get
102− if S.null dirty'
103− then return ()
104− else do
105− walk $ S.findMin dirty'
106− walks
107−
108−
109−--------------------------------------------------------------------------------
110−-- | Invariant: given node to walk /must/ be dirty
111−walk :: Ord a
112− => a
113− -> Analyzer a ()
114−walk x = do
115− -- Determine dirty neighbours and walk them
116− dg <- ask
117− forM_ (neighbours x dg) $ \n -> do
118− d <- isDirty n
119− when d $ walk n
120−
121− -- Once all dirty neighbours are done, we're safe to go
122− tell [x]
123− modify $ S.delete x
124−
125−
126−--------------------------------------------------------------------------------
127−-- | This auxiliary function checks which nodes are dirty: a node is dirty if
128−-- it's out-of-date or if one of its dependencies is dirty.
129−dirty :: Ord a
130− => (a -> Bool) -- ^ Out of date?
131− -> DirectedGraph a -- ^ Graph
132− -> Set a -- ^ All dirty items
133−dirty ood dg = S.fromList $ flip evalState M.empty $
134− filterM go $ S.toList $ nodes dg
135− where
136− go x = do
137− m <- get
138− case M.lookup x m of
139− Just d -> return d
140− Nothing -> do
141− nd <- mapM go $ neighbours x dg
142− let d = ood x || or nd
143− modify $ M.insert x d
144− return d