1 files changed, 39 insertions, 19 deletions
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index 6898b3a..e9ec47e 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -3,13 +3,16 @@
 module Hakyll.Core.Run where
 
 import Control.Arrow ((&&&))
-import Control.Monad (foldM, forM_, forM)
+import Control.Monad (foldM, forM_, forM, filterM)
+import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Monoid (mempty)
 import Data.Typeable (Typeable)
 import Data.Binary (Binary)
 import System.FilePath ((</>))
 import Control.Applicative ((<$>))
+import Data.Set (Set)
+import qualified Data.Set as S
 
 import Hakyll.Core.Route
 import Hakyll.Core.Identifier
@@ -22,6 +25,7 @@ import Hakyll.Core.Rules
 import Hakyll.Core.DirectedGraph
 import Hakyll.Core.DirectedGraph.Dot
 import Hakyll.Core.DirectedGraph.DependencySolver
+import Hakyll.Core.DirectedGraph.ObsoleteFilter
 import Hakyll.Core.Writable
 import Hakyll.Core.Store
 import Hakyll.Core.CompiledItem
@@ -48,9 +52,23 @@ hakyllWith rules provider store = do
         -- Create a compiler map
         compilerMap = M.fromList compilers
 
-        -- Create and solve the graph, creating a compiler order
+        -- Create the graph
         graph = fromList dependencies
-        ordered = solveDependencies graph
+
+    putStrLn "Writing dependency graph to dependencies.dot..."
+    writeDot "dependencies.dot" show graph
+
+    -- Check which items are up-to-date
+    modified' <- modified provider store $ map fst compilers
+
+    let -- Try to reduce the graph
+        reducedGraph = filterObsolete modified' graph
+
+    putStrLn "Writing reduced graph to reduced.dot..."
+    writeDot "reduced.dot" show reducedGraph
+
+    let -- Solve the graph
+        ordered = solveDependencies reducedGraph
 
         -- Join the order with the compilers again
         orderedCompilers = map (id &&& (compilerMap M.!)) ordered
@@ -58,30 +76,23 @@ hakyllWith rules provider store = do
         -- Fetch the routes
         route' = rulesRoute ruleSet
 
-    putStrLn "Writing dependency graph to dependencies.dot..."
-    writeDot "dependencies.dot" show graph
-
-    -- Check which items are up-to-date: modified will be a Map Identifier Bool
-    modifiedMap <- fmap M.fromList $ forM orderedCompilers $ \(id', _) -> do
-        modified <- if resourceExists provider id'
-                        then resourceModified provider id' store
-                        else return False
-        return (id', modified)
+    putStrLn $ show reducedGraph
+    putStrLn $ show ordered
 
     -- Generate all the targets in order
-    _ <- foldM (addTarget route' modifiedMap) M.empty orderedCompilers
+    _ <- foldM (addTarget route' modified') M.empty orderedCompilers
 
     putStrLn "DONE."
   where
-    addTarget route' modifiedMap map' (id', comp) = do
+    addTarget route' modified' map' (id', comp) = do
         let url = runRoute route' id'
         
         -- Check if the resource was modified
-        let modified = modifiedMap M.! id'
+        let isModified = id' `S.member` modified'
 
         -- Run the compiler
         compiled <- runCompilerJob comp id' provider (dependencyLookup map')
-                                   url store modified
+                                   url store isModified
         putStrLn $ "Generated target: " ++ show id'
 
         case url of
@@ -92,9 +103,18 @@ hakyllWith rules provider store = do
                 makeDirectories path
                 write path compiled
 
+        -- Store it in the cache
+        storeResult store id' compiled
+
         putStrLn ""
         return $ M.insert id' compiled map'
 
-    dependencyLookup map' id' = case M.lookup id' map' of
-        Nothing -> error $ "dependencyLookup: " ++ show id' ++ " not found"
-        Just d  -> d
+    dependencyLookup map' id' = M.lookup id' map'
+
+modified :: ResourceProvider     -- ^ Resource provider
+         -> Store                -- ^ Store
+         -> [Identifier]         -- ^ Identifiers to check
+         -> IO (Set Identifier)  -- ^ Modified resources
+modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->
+    if resourceExists provider id' then resourceModified provider id' store
+                                   else return False