@@ -10,10 +10,12 @@ import Control.Monad (filterM)
1010import Control.Monad.Trans (liftIO)
1111import Control.Applicative (Applicative, (<$>))
1212import Control.Monad.Reader (ReaderT, runReaderT, ask)
13−import Control.Monad.State.Strict (StateT, runStateT, get, modify)
13+import Control.Monad.State.Strict (StateT, runStateT, get, put)
1414import Control.Arrow ((&&&))
15+import Data.Map (Map)
1516import qualified Data.Map as M
1617import Data.Monoid (mempty, mappend)
18+import Data.Maybe (fromMaybe)
1719import System.FilePath ((</>))
1820import Data.Set (Set)
1921import qualified Data.Set as S
@@ -27,7 +29,9 @@ import Hakyll.Core.ResourceProvider
2729import Hakyll.Core.ResourceProvider.FileResourceProvider
2830import Hakyll.Core.Rules.Internal
2931import Hakyll.Core.DirectedGraph
32+import Hakyll.Core.DirectedGraph.Dot
3033import Hakyll.Core.DirectedGraph.DependencySolver
34+import Hakyll.Core.DependencyAnalyzer
3135import Hakyll.Core.Writable
3236import Hakyll.Core.Store
3337import Hakyll.Core.Configuration
@@ -45,35 +49,38 @@ run configuration rules = do
4549 provider <- timed logger "Creating provider" $
4650 fileResourceProvider configuration
4751
52+ -- Fetch the old graph from the store
53+ oldGraph <- fromMaybe mempty <$>
54+ storeGet store "Hakyll.Core.Run.run" "dependencies"
55+
4856 let ruleSet = runRules rules provider
4957 compilers = rulesCompilers ruleSet
5058
5159 -- Extract the reader/state
52− reader = unRuntime $ addNewCompilers [] compilers
53− stateT = runReaderT reader $ env logger ruleSet provider store
60+ reader = unRuntime $ addNewCompilers compilers
61+ stateT = runReaderT reader $ RuntimeEnvironment
62+ { hakyllLogger = logger
63+ , hakyllConfiguration = configuration
64+ , hakyllRoutes = rulesRoutes ruleSet
65+ , hakyllResourceProvider = provider
66+ , hakyllStore = store
67+ , hakyllOldGraph = oldGraph
68+ }
5469
5570 -- Run the program and fetch the resulting state
56− ((), state') <- runStateT stateT state
71+ ((), state') <- runStateT stateT $ RuntimeState
72+ { hakyllAnalyzer = makeDependencyAnalyzer mempty (const False) oldGraph
73+ , hakyllCompilers = M.empty
74+ , hakyllModified = S.empty
75+ }
5776
5877 -- We want to save the final dependency graph for the next run
59− storeSet store "Hakyll.Core.Run.run" "dependencies" $ hakyllGraph state'
78+ storeSet store "Hakyll.Core.Run.run" "dependencies" $
79+ analyzerGraph $ hakyllAnalyzer state'
6080
6181 -- Flush and return
6282 flushLogger logger
6383 return ruleSet
64− where
65− env logger ruleSet provider store = RuntimeEnvironment
66− { hakyllLogger = logger
67− , hakyllConfiguration = configuration
68− , hakyllRoutes = rulesRoutes ruleSet
69− , hakyllResourceProvider = provider
70− , hakyllStore = store
71− }
72−
73− state = RuntimeState
74− { hakyllModified = S.empty
75− , hakyllGraph = mempty
76− }
7784
7885data RuntimeEnvironment = RuntimeEnvironment
7986 { hakyllLogger :: Logger
@@ -81,11 +88,13 @@ data RuntimeEnvironment = RuntimeEnvironment
8188 , hakyllRoutes :: Routes
8289 , hakyllResourceProvider :: ResourceProvider
8390 , hakyllStore :: Store
91+ , hakyllOldGraph :: DirectedGraph Identifier
8492 }
8593
8694data RuntimeState = RuntimeState
87− { hakyllModified :: Set Identifier
88− , hakyllGraph :: DirectedGraph Identifier
95+ { hakyllAnalyzer :: DependencyAnalyzer Identifier
96+ , hakyllCompilers :: Map Identifier (Compiler () CompileRule)
97+ , hakyllModified :: Set Identifier
8998 }
9099
91100newtype Runtime a = Runtime
@@ -106,84 +115,72 @@ modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->
106115-- | Add a number of compilers and continue using these compilers
107116--
108117addNewCompilers :: [(Identifier, Compiler () CompileRule)]
109− -- ^ Remaining compilers yet to be run
110− -> [(Identifier, Compiler () CompileRule)]
111118 -- ^ Compilers to add
112119 -> Runtime ()
113−addNewCompilers oldCompilers newCompilers = Runtime $ do
120+addNewCompilers newCompilers = Runtime $ do
114121 -- Get some information
115122 logger <- hakyllLogger <$> ask
116123 section logger "Adding new compilers"
117124 provider <- hakyllResourceProvider <$> ask
118125 store <- hakyllStore <$> ask
119126
120− let -- All compilers
121− compilers = oldCompilers ++ newCompilers
127+ -- Old state information
128+ oldCompilers <- hakyllCompilers <$> get
129+ oldAnalyzer <- hakyllAnalyzer <$> get
130+ oldModified <- hakyllModified <$> get
122131
123− -- Get all dependencies for the compilers
124− dependencies = flip map compilers $ \(id', compiler) ->
132+ let -- Create a new partial dependency graph
133+ dependencies = flip map newCompilers $ \(id', compiler) ->
125134 let deps = runCompilerDependencies compiler id' provider
126135 in (id', deps)
127136
128− -- Create a compiler map (Id -> Compiler)
129− compilerMap = M.fromList compilers
130−
131137 -- Create the dependency graph
132− currentGraph = fromList dependencies
133−
134− -- Find the old graph and append the new graph to it. This forms the
135− -- complete graph
136− completeGraph <- timed logger "Creating graph" $
137− mappend currentGraph . hakyllGraph <$> get
138−
139− orderedCompilers <- timed logger "Solving dependencies" $ do
140− -- Check which items are up-to-date. This only needs to happen for the new
141− -- compilers
142− oldModified <- hakyllModified <$> get
143− newModified <- liftIO $ modified provider store $ map fst newCompilers
144−
145− let modified' = oldModified `S.union` newModified
146−
147− -- Find obsolete items. Every item that is reachable from a modified
148− -- item is considered obsolete. From these obsolete items, we are only
149− -- interested in ones that are in the current subgraph.
150− obsolete = S.filter (`member` currentGraph)
151− $ reachableNodes modified' $ reverse completeGraph
152−
153− -- Solve the graph and retain only the obsolete items
154− ordered = filter (`S.member` obsolete) $ solveDependencies currentGraph
155−
156− -- Update the state
157− modify $ updateState modified' completeGraph
158−
159− -- Join the order with the compilers again
160− return $ map (id &&& (compilerMap M.!)) ordered
161−
162− -- Now run the ordered list of compilers
163− unRuntime $ runCompilers orderedCompilers
164− where
165− -- Add the modified information for the new compilers
166− updateState modified' graph state = state
167− { hakyllModified = modified'
168− , hakyllGraph = graph
138+ newGraph = fromList dependencies
139+
140+ -- Check which items have been modified
141+ newModified <- liftIO $ modified provider store $ map fst newCompilers
142+
143+ -- Create a new analyzer and append it to the currect one
144+ let newAnalyzer =
145+ makeDependencyAnalyzer newGraph (`S.member` newModified) mempty
146+ analyzer = mappend oldAnalyzer newAnalyzer
147+
148+ -- Update the state
149+ put $ RuntimeState
150+ { hakyllAnalyzer = analyzer
151+ , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)
152+ , hakyllModified = S.union oldModified newModified
169153 }
170154
171−runCompilers :: [(Identifier, Compiler () CompileRule)]
172− -- ^ Ordered list of compilers
173− -> Runtime ()
174− -- ^ No result
175−runCompilers [] = return ()
176−runCompilers ((id', compiler) : compilers) = Runtime $ do
177− -- Obtain information
155+ -- Continue
156+ unRuntime stepAnalyzer
157+
158+stepAnalyzer :: Runtime ()
159+stepAnalyzer = Runtime $ do
160+ -- Step the analyzer
161+ state <- get
162+ let (signal, analyzer') = step $ hakyllAnalyzer state
163+ put $ state { hakyllAnalyzer = analyzer' }
164+
165+ case signal of Done -> return ()
166+ Cycle c -> return ()
167+ Build id' -> unRuntime $ build id'
168+
169+build :: Identifier -> Runtime ()
170+build id' = Runtime $ do
178171 logger <- hakyllLogger <$> ask
179172 routes <- hakyllRoutes <$> ask
180173 provider <- hakyllResourceProvider <$> ask
181174 store <- hakyllStore <$> ask
182175 modified' <- hakyllModified <$> get
176+ compilers <- hakyllCompilers <$> get
183177
184178 section logger $ "Compiling " ++ show id'
185179
186− let -- Check if the resource was modified
180+ let -- Fetch the right compiler from the map
181+ compiler = compilers M.! id'
182+
183+ -- Check if the resource was modified
187184 isModified = id' `S.member` modified'
188185
189186 -- Run the compiler
@@ -203,14 +200,14 @@ runCompilers ((id', compiler) : compilers) = Runtime $ do
203200 liftIO $ write path compiled
204201
205202 -- Continue for the remaining compilers
206− unRuntime $ runCompilers compilers
203+ unRuntime stepAnalyzer
207204
208205 -- Metacompiler, slightly more complicated
209206 Right (MetaCompileRule newCompilers) ->
210207 -- Actually I was just kidding, it's not hard at all
211− unRuntime $ addNewCompilers compilers newCompilers
208+ unRuntime $ addNewCompilers newCompilers
212209
213210 -- Some error happened, log and continue
214211 Left err -> do
215212 thrown logger err
216− unRuntime $ runCompilers compilers
213+ unRuntime stepAnalyzer