@@ -10,12 +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)
14−import Control.Arrow ((&&&))
13+import Control.Monad.State.Strict (StateT, runStateT, get, put)
14+import Data.Map (Map)
1515import qualified Data.Map as M
1616import Data.Monoid (mempty, mappend)
17+import Data.Maybe (fromMaybe)
1718import System.FilePath ((</>))
18−import Data.Set (Set)
1919import qualified Data.Set as S
2020
2121import Hakyll.Core.Routes
@@ -28,7 +28,8 @@ import Hakyll.Core.Resource.Provider
2828import Hakyll.Core.Resource.Provider.File
2929import Hakyll.Core.Rules.Internal
3030import Hakyll.Core.DirectedGraph
31−import Hakyll.Core.DirectedGraph.DependencySolver
31+import Hakyll.Core.DirectedGraph.Dot
32+import Hakyll.Core.DependencyAnalyzer
3233import Hakyll.Core.Writable
3334import Hakyll.Core.Store
3435import Hakyll.Core.Configuration
@@ -46,35 +47,36 @@ run configuration rules = do
4647 provider <- timed logger "Creating provider" $
4748 fileResourceProvider configuration
4849
50+ -- Fetch the old graph from the store
51+ oldGraph <- fromMaybe mempty <$>
52+ storeGet store "Hakyll.Core.Run.run" "dependencies"
53+
4954 let ruleSet = runRules rules provider
5055 compilers = rulesCompilers ruleSet
5156
5257 -- Extract the reader/state
53− reader = unRuntime $ addNewCompilers [] compilers
54− stateT = runReaderT reader $ env logger ruleSet provider store
58+ reader = unRuntime $ addNewCompilers compilers
59+ stateT = runReaderT reader $ RuntimeEnvironment
60+ { hakyllLogger = logger
61+ , hakyllConfiguration = configuration
62+ , hakyllRoutes = rulesRoutes ruleSet
63+ , hakyllResourceProvider = provider
64+ , hakyllStore = store
65+ }
5566
5667 -- Run the program and fetch the resulting state
57− ((), state') <- runStateT stateT state
68+ ((), state') <- runStateT stateT $ RuntimeState
69+ { hakyllAnalyzer = makeDependencyAnalyzer mempty (const False) oldGraph
70+ , hakyllCompilers = M.empty
71+ }
5872
5973 -- We want to save the final dependency graph for the next run
60− storeSet store "Hakyll.Core.Run.run" "dependencies" $ hakyllGraph state'
74+ storeSet store "Hakyll.Core.Run.run" "dependencies" $
75+ analyzerGraph $ hakyllAnalyzer state'
6176
6277 -- Flush and return
6378 flushLogger logger
6479 return ruleSet
65− where
66− env logger ruleSet provider store = RuntimeEnvironment
67− { hakyllLogger = logger
68− , hakyllConfiguration = configuration
69− , hakyllRoutes = rulesRoutes ruleSet
70− , hakyllResourceProvider = provider
71− , hakyllStore = store
72− }
73−
74− state = RuntimeState
75− { hakyllModified = S.empty
76− , hakyllGraph = mempty
77− }
7880
7981data RuntimeEnvironment = RuntimeEnvironment
8082 { hakyllLogger :: Logger
@@ -85,8 +87,8 @@ data RuntimeEnvironment = RuntimeEnvironment
8587 }
8688
8789data RuntimeState = RuntimeState
88− { hakyllModified :: Set Identifier
89− , hakyllGraph :: DirectedGraph Identifier
90+ { hakyllAnalyzer :: DependencyAnalyzer Identifier
91+ , hakyllCompilers :: Map Identifier (Compiler () CompileRule)
9092 }
9193
9294newtype Runtime a = Runtime
@@ -95,95 +97,95 @@ newtype Runtime a = Runtime
9597
9698-- | Return a set of modified identifiers
9799--
100+{-
98101modified :: ResourceProvider -- ^ Resource provider
99102 -> Store -- ^ Store
100103 -> [Identifier] -- ^ Identifiers to check
101104 -> IO (Set Identifier) -- ^ Modified resources
102105modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->
103106 resourceModified provider (Resource id') store
107+-}
104108
105109-- | Add a number of compilers and continue using these compilers
106110--
107111addNewCompilers :: [(Identifier, Compiler () CompileRule)]
108− -- ^ Remaining compilers yet to be run
109− -> [(Identifier, Compiler () CompileRule)]
110112 -- ^ Compilers to add
111113 -> Runtime ()
112−addNewCompilers oldCompilers newCompilers = Runtime $ do
114+addNewCompilers newCompilers = Runtime $ do
113115 -- Get some information
114116 logger <- hakyllLogger <$> ask
115117 section logger "Adding new compilers"
116118 provider <- hakyllResourceProvider <$> ask
117119 store <- hakyllStore <$> ask
118120
119− let -- All compilers
120− compilers = oldCompilers ++ newCompilers
121+ -- Old state information
122+ oldCompilers <- hakyllCompilers <$> get
123+ oldAnalyzer <- hakyllAnalyzer <$> get
121124
122− -- Get all dependencies for the compilers
123− dependencies = flip map compilers $ \(id', compiler) ->
125+ let -- Create a new partial dependency graph
126+ dependencies = flip map newCompilers $ \(id', compiler) ->
124127 let deps = runCompilerDependencies compiler id' provider
125128 in (id', deps)
126129
127− -- Create a compiler map (Id -> Compiler)
128− compilerMap = M.fromList compilers
129−
130130 -- Create the dependency graph
131− currentGraph = fromList dependencies
132−
133− -- Find the old graph and append the new graph to it. This forms the
134− -- complete graph
135− completeGraph <- timed logger "Creating graph" $
136− mappend currentGraph . hakyllGraph <$> get
137−
138− orderedCompilers <- timed logger "Solving dependencies" $ do
139− -- Check which items are up-to-date. This only needs to happen for the new
140− -- compilers
141− oldModified <- hakyllModified <$> get
142− newModified <- liftIO $ modified provider store $ map fst newCompilers
143−
144− let modified' = oldModified `S.union` newModified
145−
146− -- Find obsolete items. Every item that is reachable from a modified
147− -- item is considered obsolete. From these obsolete items, we are only
148− -- interested in ones that are in the current subgraph.
149− obsolete = S.filter (`member` currentGraph)
150− $ reachableNodes modified' $ reverse completeGraph
151−
152− -- Solve the graph and retain only the obsolete items
153− ordered = filter (`S.member` obsolete) $ solveDependencies currentGraph
154−
155− -- Update the state
156− modify $ updateState modified' completeGraph
157−
158− -- Join the order with the compilers again
159− return $ map (id &&& (compilerMap M.!)) ordered
160−
161− -- Now run the ordered list of compilers
162− unRuntime $ runCompilers orderedCompilers
163− where
164− -- Add the modified information for the new compilers
165− updateState modified' graph state = state
166− { hakyllModified = modified'
167− , hakyllGraph = graph
131+ newGraph = fromList dependencies
132+
133+ -- Check which items have been modified
134+ modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $
135+ liftIO . resourceModified provider store . Resource
136+ -- newModified <- liftIO $ modified provider store $ map fst newCompilers
137+
138+ -- Create a new analyzer and append it to the currect one
139+ let newAnalyzer = makeDependencyAnalyzer newGraph (`S.member` modified) $
140+ analyzerPreviousGraph oldAnalyzer
141+ analyzer = mappend oldAnalyzer newAnalyzer
142+
143+ -- Debugging
144+ liftIO $ putStrLn $ "Remains: " ++ show (analyzerRemains newAnalyzer)
145+ liftIO $ putStrLn $ "Done: " ++ show (analyzerDone newAnalyzer)
146+ liftIO $ writeFile "old-prev.dot" $ toDot show (analyzerPreviousGraph oldAnalyzer)
147+ liftIO $ writeFile "old.dot" $ toDot show (analyzerGraph oldAnalyzer)
148+ liftIO $ writeFile "old-prev.dot" $ toDot show (analyzerPreviousGraph oldAnalyzer)
149+ liftIO $ writeFile "new.dot" $ toDot show (analyzerGraph newAnalyzer)
150+ liftIO $ writeFile "new-prev.dot" $ toDot show (analyzerPreviousGraph newAnalyzer)
151+ liftIO $ writeFile "result.dot" $ toDot show (analyzerGraph analyzer)
152+ liftIO $ writeFile "result-prev.dot" $ toDot show (analyzerPreviousGraph analyzer)
153+
154+ -- Update the state
155+ put $ RuntimeState
156+ { hakyllAnalyzer = analyzer
157+ , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)
168158 }
169159
170−runCompilers :: [(Identifier, Compiler () CompileRule)]
171− -- ^ Ordered list of compilers
172− -> Runtime ()
173− -- ^ No result
174−runCompilers [] = return ()
175−runCompilers ((id', compiler) : compilers) = Runtime $ do
176− -- Obtain information
160+ -- Continue
161+ unRuntime stepAnalyzer
162+
163+stepAnalyzer :: Runtime ()
164+stepAnalyzer = Runtime $ do
165+ -- Step the analyzer
166+ state <- get
167+ let (signal, analyzer') = step $ hakyllAnalyzer state
168+ put $ state { hakyllAnalyzer = analyzer' }
169+
170+ case signal of Done -> return ()
171+ Cycle _ -> return ()
172+ Build id' -> unRuntime $ build id'
173+
174+build :: Identifier -> Runtime ()
175+build id' = Runtime $ do
177176 logger <- hakyllLogger <$> ask
178177 routes <- hakyllRoutes <$> ask
179178 provider <- hakyllResourceProvider <$> ask
180179 store <- hakyllStore <$> ask
181− modified' <- hakyllModified <$> get
180+ compilers <- hakyllCompilers <$> get
182181
183182 section logger $ "Compiling " ++ show id'
184183
185− let -- Check if the resource was modified
186− isModified = id' `S.member` modified'
184+ -- Fetch the right compiler from the map
185+ let compiler = compilers M.! id'
186+
187+ -- Check if the resource was modified
188+ isModified <- liftIO $ resourceModified provider store (Resource id')
187189
188190 -- Run the compiler
189191 result <- timed logger "Total compile time" $ liftIO $
@@ -202,14 +204,14 @@ runCompilers ((id', compiler) : compilers) = Runtime $ do
202204 liftIO $ write path compiled
203205
204206 -- Continue for the remaining compilers
205− unRuntime $ runCompilers compilers
207+ unRuntime stepAnalyzer
206208
207209 -- Metacompiler, slightly more complicated
208210 Right (MetaCompileRule newCompilers) ->
209211 -- Actually I was just kidding, it's not hard at all
210− unRuntime $ addNewCompilers compilers newCompilers
212+ unRuntime $ addNewCompilers newCompilers
211213
212214 -- Some error happened, log and continue
213215 Left err -> do
214216 thrown logger err
215− unRuntime $ runCompilers compilers
217+ unRuntime stepAnalyzer