@@ -10,10 +10,12 @@ import Control.Monad (filterM)
10import Control.Monad.Trans (liftIO)
10import Control.Monad.Trans (liftIO)
11import Control.Applicative (Applicative, (<$>))
11import Control.Applicative (Applicative, (<$>))
12import Control.Monad.Reader (ReaderT, runReaderT, ask)
12import 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)
14import Control.Arrow ((&&&))
14import Control.Arrow ((&&&))
15import qualified Data.Map as M
16import qualified Data.Map as M
16import Data.Monoid (mempty, mappend)
17import Data.Monoid (mempty, mappend)
18+import Data.Maybe (fromMaybe)
17import System.FilePath ((</>))
19import System.FilePath ((</>))
18import Data.Set (Set)
20import Data.Set (Set)
19import qualified Data.Set as S
21import qualified Data.Set as S
@@ -27,7 +29,9 @@ import Hakyll.Core.ResourceProvider
27import Hakyll.Core.ResourceProvider.FileResourceProvider
29import Hakyll.Core.ResourceProvider.FileResourceProvider
28import Hakyll.Core.Rules.Internal
30import Hakyll.Core.Rules.Internal
29import Hakyll.Core.DirectedGraph
31import Hakyll.Core.DirectedGraph
32+import Hakyll.Core.DirectedGraph.Dot
30import Hakyll.Core.DirectedGraph.DependencySolver
33import Hakyll.Core.DirectedGraph.DependencySolver
34+import Hakyll.Core.DependencyAnalyzer
31import Hakyll.Core.Writable
35import Hakyll.Core.Writable
32import Hakyll.Core.Store
36import Hakyll.Core.Store
33import Hakyll.Core.Configuration
37import Hakyll.Core.Configuration
@@ -45,35 +49,38 @@ run configuration rules = do
45 provider <- timed logger "Creating provider" $
49 provider <- timed logger "Creating provider" $
46 fileResourceProvider configuration
50 fileResourceProvider configuration
52+ -- Fetch the old graph from the store
53+ oldGraph <- fromMaybe mempty <$>
54+ storeGet store "Hakyll.Core.Run.run" "dependencies"
48 let ruleSet = runRules rules provider
56 let ruleSet = runRules rules provider
49 compilers = rulesCompilers ruleSet
57 compilers = rulesCompilers ruleSet
51 -- Extract the reader/state
59 -- Extract the reader/state
52− reader = unRuntime $ addNewCompilers [] compilers
60+ reader = unRuntime $ addNewCompilers compilers
53− stateT = runReaderT reader $ env logger ruleSet provider store
61+ stateT = runReaderT reader $ RuntimeEnvironment
62+ { hakyllLogger = logger
63+ , hakyllConfiguration = configuration
64+ , hakyllRoutes = rulesRoutes ruleSet
65+ , hakyllResourceProvider = provider
66+ , hakyllStore = store
67+ , hakyllOldGraph = oldGraph
55 -- Run the program and fetch the resulting state
70 -- 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
58 -- We want to save the final dependency graph for the next run
77 -- 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'
61 -- Flush and return
81 -- Flush and return
62 flushLogger logger
82 flushLogger logger
63 return ruleSet
83 return ruleSet
65− env logger ruleSet provider store = RuntimeEnvironment
66− { hakyllLogger = logger
67− , hakyllConfiguration = configuration
68− , hakyllRoutes = rulesRoutes ruleSet
69− , hakyllResourceProvider = provider
70− , hakyllStore = store
74− { hakyllModified = S.empty
75− , hakyllGraph = mempty
78data RuntimeEnvironment = RuntimeEnvironment
85data RuntimeEnvironment = RuntimeEnvironment
79 { hakyllLogger :: Logger
86 { hakyllLogger :: Logger
@@ -81,11 +88,13 @@ data RuntimeEnvironment = RuntimeEnvironment
81 , hakyllRoutes :: Routes
88 , hakyllRoutes :: Routes
82 , hakyllResourceProvider :: ResourceProvider
89 , hakyllResourceProvider :: ResourceProvider
83 , hakyllStore :: Store
90 , hakyllStore :: Store
91+ , hakyllOldGraph :: DirectedGraph Identifier
86data RuntimeState = RuntimeState
94data RuntimeState = RuntimeState
95+ { hakyllAnalyzer :: DependencyAnalyzer Identifier
96+ , hakyllCompilers :: Map Identifier (Compiler () CompileRule)
87− { hakyllModified :: Set Identifier
97+ , hakyllModified :: Set Identifier
88− , hakyllGraph :: DirectedGraph Identifier
91newtype Runtime a = Runtime
100newtype Runtime a = Runtime
@@ -106,84 +115,72 @@ modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->
106-- | Add a number of compilers and continue using these compilers
115-- | Add a number of compilers and continue using these compilers
108addNewCompilers :: [(Identifier, Compiler () CompileRule)]
117addNewCompilers :: [(Identifier, Compiler () CompileRule)]
109− -- ^ Remaining compilers yet to be run
110− -> [(Identifier, Compiler () CompileRule)]
111 -- ^ Compilers to add
118 -- ^ Compilers to add
112 -> Runtime ()
119 -> Runtime ()
113−addNewCompilers oldCompilers newCompilers = Runtime $ do
120+addNewCompilers newCompilers = Runtime $ do
114 -- Get some information
121 -- Get some information
115 logger <- hakyllLogger <$> ask
122 logger <- hakyllLogger <$> ask
116 section logger "Adding new compilers"
123 section logger "Adding new compilers"
117 provider <- hakyllResourceProvider <$> ask
124 provider <- hakyllResourceProvider <$> ask
118 store <- hakyllStore <$> ask
125 store <- hakyllStore <$> ask
120− let -- All compilers
127+ -- Old state information
121− compilers = oldCompilers ++ newCompilers
128+ oldCompilers <- hakyllCompilers <$> get
129+ oldAnalyzer <- hakyllAnalyzer <$> get
130+ oldModified <- hakyllModified <$> get
123− -- Get all dependencies for the compilers
132+ let -- Create a new partial dependency graph
124− dependencies = flip map compilers $ \(id', compiler) ->
133+ dependencies = flip map newCompilers $ \(id', compiler) ->
125 let deps = runCompilerDependencies compiler id' provider
134 let deps = runCompilerDependencies compiler id' provider
126 in (id', deps)
135 in (id', deps)
128− -- Create a compiler map (Id -> Compiler)
129− compilerMap = M.fromList compilers
131 -- Create the dependency graph
137 -- Create the dependency graph
132− currentGraph = fromList dependencies
138+ newGraph = fromList dependencies
134− -- Find the old graph and append the new graph to it. This forms the
140+ -- Check which items have been modified
136− completeGraph <- timed logger "Creating graph" $
137− mappend currentGraph . hakyllGraph <$> get
139− orderedCompilers <- timed logger "Solving dependencies" $ do
140− -- Check which items are up-to-date. This only needs to happen for the new
142− oldModified <- hakyllModified <$> get
143− newModified <- liftIO $ modified provider store $ map fst newCompilers
141+ newModified <- liftIO $ modified provider store $ map fst newCompilers
145− let modified' = oldModified `S.union` newModified
143+ -- Create a new analyzer and append it to the currect one
146−
144+ let newAnalyzer =
147− -- Find obsolete items. Every item that is reachable from a modified
145+ makeDependencyAnalyzer newGraph (`S.member` newModified) mempty
148− -- item is considered obsolete. From these obsolete items, we are only
146+ analyzer = mappend oldAnalyzer newAnalyzer
149− -- interested in ones that are in the current subgraph.
147+
150− obsolete = S.filter (`member` currentGraph)
151− $ reachableNodes modified' $ reverse completeGraph
153− -- Solve the graph and retain only the obsolete items
154− ordered = filter (`S.member` obsolete) $ solveDependencies currentGraph
156− -- Update the state
148+ -- Update the state
157− modify $ updateState modified' completeGraph
149+ put $ RuntimeState
158−
150+ { hakyllAnalyzer = analyzer
159− -- Join the order with the compilers again
151+ , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)
160− return $ map (id &&& (compilerMap M.!)) ordered
152+ , hakyllModified = S.union oldModified newModified
162− -- Now run the ordered list of compilers
163− unRuntime $ runCompilers orderedCompilers
165− -- Add the modified information for the new compilers
166− updateState modified' graph state = state
167− { hakyllModified = modified'
168− , hakyllGraph = graph
171−runCompilers :: [(Identifier, Compiler () CompileRule)]
155+ -- Continue
172− -- ^ Ordered list of compilers
156+ unRuntime stepAnalyzer
158+stepAnalyzer :: Runtime ()
159+stepAnalyzer = Runtime $ do
160+ -- Step the analyzer
162+ let (signal, analyzer') = step $ hakyllAnalyzer state
163+ put $ state { hakyllAnalyzer = analyzer' }
165+ case signal of Done -> return ()
166+ Cycle c -> return ()
167+ Build id' -> unRuntime $ build id'
173− -> Runtime ()
169+build :: Identifier -> Runtime ()
174− -- ^ No result
170+build id' = Runtime $ do
175−runCompilers [] = return ()
176−runCompilers ((id', compiler) : compilers) = Runtime $ do
177− -- Obtain information
178 logger <- hakyllLogger <$> ask
171 logger <- hakyllLogger <$> ask
179 routes <- hakyllRoutes <$> ask
172 routes <- hakyllRoutes <$> ask
180 provider <- hakyllResourceProvider <$> ask
173 provider <- hakyllResourceProvider <$> ask
181 store <- hakyllStore <$> ask
174 store <- hakyllStore <$> ask
182 modified' <- hakyllModified <$> get
175 modified' <- hakyllModified <$> get
176+ compilers <- hakyllCompilers <$> get
184 section logger $ "Compiling " ++ show id'
178 section logger $ "Compiling " ++ show id'
180+ let -- Fetch the right compiler from the map
181+ compiler = compilers M.! id'
186− let -- Check if the resource was modified
183+ -- Check if the resource was modified
187 isModified = id' `S.member` modified'
184 isModified = id' `S.member` modified'
189 -- Run the compiler
186 -- Run the compiler
@@ -203,14 +200,14 @@ runCompilers ((id', compiler) : compilers) = Runtime $ do
203 liftIO $ write path compiled
200 liftIO $ write path compiled
205 -- Continue for the remaining compilers
202 -- Continue for the remaining compilers
206− unRuntime $ runCompilers compilers
203+ unRuntime stepAnalyzer
208 -- Metacompiler, slightly more complicated
205 -- Metacompiler, slightly more complicated
209 Right (MetaCompileRule newCompilers) ->
206 Right (MetaCompileRule newCompilers) ->
210 -- Actually I was just kidding, it's not hard at all
207 -- Actually I was just kidding, it's not hard at all
211− unRuntime $ addNewCompilers compilers newCompilers
208+ unRuntime $ addNewCompilers newCompilers
213 -- Some error happened, log and continue
210 -- Some error happened, log and continue
214 Left err -> do
211 Left err -> do
215 thrown logger err
212 thrown logger err
216− unRuntime $ runCompilers compilers
213+ unRuntime stepAnalyzer