Start playing with dependency analyzer

hakyll.cabal

@@ -83,6 +83,7 @@ library
                       Hakyll.Web.Page.Metadata
                       Hakyll.Core.ResourceProvider.FileResourceProvider
                       Hakyll.Core.Configuration
+                      Hakyll.Core.DependencyAnalyzer
                       Hakyll.Core.Identifier.Pattern
                       Hakyll.Core.UnixFilter
                       Hakyll.Core.Util.Arrow

src/Hakyll/Core/DependencyAnalyzer.hs

@@ -1,5 +1,5 @@
 module Hakyll.Core.DependencyAnalyzer
-    ( DependencyAnalyzer
+    ( DependencyAnalyzer (..)
     , Signal (..)
     , makeDependencyAnalyzer
     , step

src/Hakyll/Core/Run.hs

@@ -10,10 +10,12 @@ import Control.Monad (filterM)
 import Control.Monad.Trans (liftIO)
 import Control.Applicative (Applicative, (<$>))
 import Control.Monad.Reader (ReaderT, runReaderT, ask)
-import Control.Monad.State.Strict (StateT, runStateT, get, modify)
+import Control.Monad.State.Strict (StateT, runStateT, get, put)
 import Control.Arrow ((&&&))
+import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Monoid (mempty, mappend)
+import Data.Maybe (fromMaybe)
 import System.FilePath ((</>))
 import Data.Set (Set)
 import qualified Data.Set as S
@@ -27,7 +29,9 @@ import Hakyll.Core.ResourceProvider
 import Hakyll.Core.ResourceProvider.FileResourceProvider
 import Hakyll.Core.Rules.Internal
 import Hakyll.Core.DirectedGraph
+import Hakyll.Core.DirectedGraph.Dot
 import Hakyll.Core.DirectedGraph.DependencySolver
+import Hakyll.Core.DependencyAnalyzer
 import Hakyll.Core.Writable
 import Hakyll.Core.Store
 import Hakyll.Core.Configuration
@@ -45,35 +49,38 @@ run configuration rules = do
     provider <- timed logger "Creating provider" $
         fileResourceProvider configuration
 
+    -- Fetch the old graph from the store
+    oldGraph <- fromMaybe mempty <$>
+        storeGet store "Hakyll.Core.Run.run" "dependencies"
+
     let ruleSet = runRules rules provider
         compilers = rulesCompilers ruleSet
 
         -- Extract the reader/state
-        reader = unRuntime $ addNewCompilers [] compilers
-        stateT = runReaderT reader $ env logger ruleSet provider store
+        reader = unRuntime $ addNewCompilers compilers
+        stateT = runReaderT reader $ RuntimeEnvironment
+                    { hakyllLogger           = logger
+                    , hakyllConfiguration    = configuration
+                    , hakyllRoutes           = rulesRoutes ruleSet
+                    , hakyllResourceProvider = provider
+                    , hakyllStore            = store
+                    , hakyllOldGraph         = oldGraph
+                    }
 
     -- Run the program and fetch the resulting state
-    ((), state') <- runStateT stateT state
+    ((), state') <- runStateT stateT $ RuntimeState
+        { hakyllAnalyzer  = makeDependencyAnalyzer mempty (const False) oldGraph
+        , hakyllCompilers = M.empty
+        , hakyllModified  = S.empty
+        }
 
     -- We want to save the final dependency graph for the next run
-    storeSet store "Hakyll.Core.Run.run" "dependencies" $ hakyllGraph state'
+    storeSet store "Hakyll.Core.Run.run" "dependencies" $
+        analyzerGraph $ hakyllAnalyzer state'
 
     -- Flush and return
     flushLogger logger
     return ruleSet
-  where
-    env logger ruleSet provider store = RuntimeEnvironment
-        { hakyllLogger           = logger
-        , hakyllConfiguration    = configuration
-        , hakyllRoutes           = rulesRoutes ruleSet
-        , hakyllResourceProvider = provider
-        , hakyllStore            = store
-        }
-
-    state = RuntimeState
-        { hakyllModified = S.empty
-        , hakyllGraph    = mempty
-        }
 
 data RuntimeEnvironment = RuntimeEnvironment
     { hakyllLogger           :: Logger
@@ -81,11 +88,13 @@ data RuntimeEnvironment = RuntimeEnvironment
     , hakyllRoutes           :: Routes
     , hakyllResourceProvider :: ResourceProvider
     , hakyllStore            :: Store
+    , hakyllOldGraph         :: DirectedGraph Identifier
     }
 
 data RuntimeState = RuntimeState
-    { hakyllModified :: Set Identifier
-    , hakyllGraph    :: DirectedGraph Identifier
+    { hakyllAnalyzer  :: DependencyAnalyzer Identifier
+    , hakyllCompilers :: Map Identifier (Compiler () CompileRule)
+    , hakyllModified  :: Set Identifier
     }
 
 newtype Runtime a = Runtime
@@ -106,84 +115,72 @@ modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->
 -- | Add a number of compilers and continue using these compilers
 --
 addNewCompilers :: [(Identifier, Compiler () CompileRule)]
-                -- ^ Remaining compilers yet to be run
-                -> [(Identifier, Compiler () CompileRule)]
                 -- ^ Compilers to add
                 -> Runtime ()
-addNewCompilers oldCompilers newCompilers = Runtime $ do
+addNewCompilers newCompilers = Runtime $ do
     -- Get some information
     logger <- hakyllLogger <$> ask
     section logger "Adding new compilers"
     provider <- hakyllResourceProvider <$> ask
     store <- hakyllStore <$> ask
 
-    let -- All compilers
-        compilers = oldCompilers ++ newCompilers
+    -- Old state information
+    oldCompilers <- hakyllCompilers <$> get
+    oldAnalyzer <- hakyllAnalyzer <$> get
+    oldModified <- hakyllModified <$> get
 
-        -- Get all dependencies for the compilers
-        dependencies = flip map compilers $ \(id', compiler) ->
+    let -- Create a new partial dependency graph
+        dependencies = flip map newCompilers $ \(id', compiler) ->
             let deps = runCompilerDependencies compiler id' provider
             in (id', deps)
 
-        -- Create a compiler map (Id -> Compiler)
-        compilerMap = M.fromList compilers
-
         -- Create the dependency graph
-        currentGraph = fromList dependencies
+        newGraph = fromList dependencies
 
-    -- Find the old graph and append the new graph to it. This forms the
-    -- complete graph
-    completeGraph <- timed logger "Creating graph" $
-        mappend currentGraph . hakyllGraph <$> get
+    -- Check which items have been modified
+    newModified <- liftIO $ modified provider store $ map fst newCompilers
 
-    orderedCompilers <- timed logger "Solving dependencies" $ do
-        -- Check which items are up-to-date. This only needs to happen for the new
-        -- compilers
-        oldModified <- hakyllModified <$> get 
-        newModified <- liftIO $ modified provider store $ map fst newCompilers
+    -- Create a new analyzer and append it to the currect one
+    let newAnalyzer =
+            makeDependencyAnalyzer newGraph (`S.member` newModified) mempty
+        analyzer = mappend oldAnalyzer newAnalyzer
 
-        let modified' = oldModified `S.union` newModified
-            
-            -- Find obsolete items. Every item that is reachable from a modified
-            -- item is considered obsolete. From these obsolete items, we are only
-            -- interested in ones that are in the current subgraph.
-            obsolete = S.filter (`member` currentGraph)
-                     $ reachableNodes modified' $ reverse completeGraph
-
-            -- Solve the graph and retain only the obsolete items
-            ordered = filter (`S.member` obsolete) $ solveDependencies currentGraph
-
-        -- Update the state
-        modify $ updateState modified' completeGraph
-
-        -- Join the order with the compilers again
-        return $ map (id &&& (compilerMap M.!)) ordered
-
-    -- Now run the ordered list of compilers
-    unRuntime $ runCompilers orderedCompilers
-  where
-    -- Add the modified information for the new compilers
-    updateState modified' graph state = state
-        { hakyllModified = modified'
-        , hakyllGraph    = graph
+    -- Update the state
+    put $ RuntimeState
+        { hakyllAnalyzer  = analyzer
+        , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)
+        , hakyllModified  = S.union oldModified newModified
         }
 
-runCompilers :: [(Identifier, Compiler () CompileRule)]
-             -- ^ Ordered list of compilers
-             -> Runtime ()
-             -- ^ No result
-runCompilers [] = return ()
-runCompilers ((id', compiler) : compilers) = Runtime $ do
-    -- Obtain information
+    -- Continue
+    unRuntime stepAnalyzer
+
+stepAnalyzer :: Runtime ()
+stepAnalyzer = Runtime $ do
+    -- Step the analyzer
+    state <- get
+    let (signal, analyzer') = step $ hakyllAnalyzer state
+    put $ state { hakyllAnalyzer = analyzer' }
+
+    case signal of Done      -> return ()
+                   Cycle c   -> return ()
+                   Build id' -> unRuntime $ build id'
+
+build :: Identifier -> Runtime ()
+build id' = Runtime $ do
     logger <- hakyllLogger <$> ask
     routes <- hakyllRoutes <$> ask
     provider <- hakyllResourceProvider <$> ask
     store <- hakyllStore <$> ask
     modified' <- hakyllModified <$> get
+    compilers <- hakyllCompilers <$> get
 
     section logger $ "Compiling " ++ show id'
 
-    let -- Check if the resource was modified
+    let -- Fetch the right compiler from the map
+        compiler = compilers M.! id'
+
+        -- Check if the resource was modified
         isModified = id' `S.member` modified'
 
     -- Run the compiler
@@ -203,14 +200,14 @@ runCompilers ((id', compiler) : compilers) = Runtime $ do
                     liftIO $ write path compiled
 
             -- Continue for the remaining compilers
-            unRuntime $ runCompilers compilers 
+            unRuntime stepAnalyzer
 
         -- Metacompiler, slightly more complicated
         Right (MetaCompileRule newCompilers) ->
             -- Actually I was just kidding, it's not hard at all
-            unRuntime $ addNewCompilers compilers newCompilers
+            unRuntime $ addNewCompilers newCompilers
 
         -- Some error happened, log and continue
         Left err -> do
             thrown logger err 
-            unRuntime $ runCompilers compilers
+            unRuntime stepAnalyzer