Play with dependency analyzer

3 files changed, 28 insertions, 93 deletions

diff --git a/src/Hakyll/Core/DirectedGraph/DependencySolver.hs b/src/Hakyll/Core/DirectedGraph/DependencySolver.hs
deleted file mode 100644
index 54826ff..0000000
--- a/src/Hakyll/Core/DirectedGraph/DependencySolver.hs
+++ /dev/null
@@ -1,70 +0,0 @@
--- | Given a dependency graph, this module provides a function that will
--- generate an order in which the graph can be visited, so that all the
--- dependencies of a given node have been visited before the node itself is
--- visited.
---
-module Hakyll.Core.DirectedGraph.DependencySolver
-    ( solveDependencies
-    ) where
-
-import Prelude
-import qualified Prelude as P
-import Data.Set (Set)
-import Data.Maybe (mapMaybe)
-import qualified Data.Map as M
-import qualified Data.Set as S
-
-import Hakyll.Core.DirectedGraph
-import Hakyll.Core.DirectedGraph.Internal
-
--- | Solve a dependency graph. This function returns an order to run the
--- different nodes
---
-solveDependencies :: Ord a
-                  => DirectedGraph a  -- ^ Graph
-                  -> [a]              -- ^ Resulting plan
-solveDependencies = P.reverse . order [] [] S.empty
-
--- | Produce a reversed order using a stack
---
-order :: Ord a
-      => [a]              -- ^ Temporary result
-      -> [Node a]         -- ^ Backtrace stack
-      -> Set a            -- ^ Items in the stack
-      -> DirectedGraph a  -- ^ Graph
-      -> [a]              -- ^ Ordered result
-order temp stack set graph@(DirectedGraph graph')
-    -- Empty graph - return our current result
-    | M.null graph' = temp
-    | otherwise = case stack of
-
-        -- Empty stack - pick a node, and add it to the stack
-        [] ->
-            let (tag, node) = M.findMin graph'
-            in order temp (node : stack) (S.insert tag set) graph
-
-        -- At least one item on the stack - continue using this item
-        (node : stackTail) ->
-            -- Check which dependencies are still in the graph
-            let tag = nodeTag node
-                deps = S.toList $ nodeNeighbours node
-                unsatisfied = mapMaybe (`M.lookup` graph') deps
-            in case unsatisfied of
-                
-                -- All dependencies for node are satisfied, we can return it and
-                -- remove it from the graph
-                [] -> order (tag : temp) stackTail (S.delete tag set)
-                            (DirectedGraph $ M.delete tag graph')
-
-                -- There is at least one dependency left. We need to solve that
-                -- one first...
-                (dep : _) -> if nodeTag dep `S.member` set
-                    -- The dependency is already in our stack - cycle detected!
-                    then cycleError
-                    -- Continue with the dependency
-                    else order temp (dep : node : stackTail)
-                                    (S.insert (nodeTag dep) set)
-                                    graph
-  where
-    cycleError = error $  "Hakyll.Core.DirectedGraph.DependencySolver.order: "
-                       ++ "Cycle detected!"  -- TODO: Dump cycle
diff --git a/src/Hakyll/Core/Resource/Provider.hs b/src/Hakyll/Core/Resource/Provider.hs
index 90e93f8..67299a6 100644
--- a/src/Hakyll/Core/Resource/Provider.hs
+++ b/src/Hakyll/Core/Resource/Provider.hs
@@ -56,8 +56,8 @@ resourceDigest provider = digest MD5 <=< resourceLazyByteString provider
 
 -- | Check if a resource was modified
 --
-resourceModified :: ResourceProvider -> Resource -> Store -> IO Bool
-resourceModified provider resource store = do
+resourceModified :: ResourceProvider -> Store -> Resource -> IO Bool
+resourceModified provider store resource = do
     cache <- readMVar mvar
     case M.lookup resource cache of
         -- Already in the cache
@@ -65,7 +65,7 @@ resourceModified provider resource store = do
         -- Not yet in the cache, check digests (if it exists)
         Nothing -> do
             m <- if resourceExists provider (unResource resource)
-                        then digestModified provider resource store
+                        then digestModified provider store resource
                         else return False
             modifyMVar_ mvar (return . M.insert resource m)
             return m
@@ -74,8 +74,8 @@ resourceModified provider resource store = do
 
 -- | Check if a resource digest was modified
 --
-digestModified :: ResourceProvider -> Resource -> Store -> IO Bool
-digestModified provider resource store = do
+digestModified :: ResourceProvider -> Store -> Resource -> IO Bool
+digestModified provider store resource = do
     -- Get the latest seen digest from the store
     lastDigest <- storeGet store itemName $ unResource resource
     -- Calculate the digest for the resource
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index c2cc21b..af2ad22 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -11,13 +11,11 @@ import Control.Monad.Trans (liftIO)
 import Control.Applicative (Applicative, (<$>))
 import Control.Monad.Reader (ReaderT, runReaderT, ask)
 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
 
 import Hakyll.Core.Routes
@@ -31,7 +29,6 @@ import Hakyll.Core.Resource.Provider.File
 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
@@ -65,14 +62,12 @@ run configuration rules = do
                     , hakyllRoutes           = rulesRoutes ruleSet
                     , hakyllResourceProvider = provider
                     , hakyllStore            = store
-                    , hakyllOldGraph         = oldGraph
                     }
 
     -- Run the program and fetch the resulting 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
@@ -89,13 +84,11 @@ data RuntimeEnvironment = RuntimeEnvironment
     , hakyllRoutes           :: Routes
     , hakyllResourceProvider :: ResourceProvider
     , hakyllStore            :: Store
-    , hakyllOldGraph         :: DirectedGraph Identifier
     }
 
 data RuntimeState = RuntimeState
     { hakyllAnalyzer  :: DependencyAnalyzer Identifier
     , hakyllCompilers :: Map Identifier (Compiler () CompileRule)
-    , hakyllModified  :: Set Identifier
     }
 
 newtype Runtime a = Runtime
@@ -104,12 +97,14 @@ newtype Runtime a = Runtime
 
 -- | Return a set of modified identifiers
 --
+{-
 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' ->
     resourceModified provider (Resource id') store
+-}
 
 -- | Add a number of compilers and continue using these compilers
 --
@@ -126,7 +121,6 @@ addNewCompilers newCompilers = Runtime $ do
     -- Old state information
     oldCompilers <- hakyllCompilers <$> get
     oldAnalyzer <- hakyllAnalyzer <$> get
-    oldModified <- hakyllModified <$> get
 
     let -- Create a new partial dependency graph
         dependencies = flip map newCompilers $ \(id', compiler) ->
@@ -137,18 +131,30 @@ addNewCompilers newCompilers = Runtime $ do
         newGraph = fromList dependencies
 
     -- Check which items have been modified
-    newModified <- liftIO $ modified provider store $ map fst newCompilers
+    modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $
+        liftIO . resourceModified provider store . Resource
+    -- 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
+    let newAnalyzer = makeDependencyAnalyzer newGraph (`S.member` modified) $
+            analyzerPreviousGraph oldAnalyzer
         analyzer = mappend oldAnalyzer newAnalyzer
 
+    -- Debugging
+    liftIO $ putStrLn $ "Remains: " ++ show (analyzerRemains newAnalyzer)
+    liftIO $ putStrLn $ "Done: " ++ show (analyzerDone newAnalyzer)
+    liftIO $ writeFile "old-prev.dot" $ toDot show (analyzerPreviousGraph oldAnalyzer)
+    liftIO $ writeFile "old.dot" $ toDot show (analyzerGraph oldAnalyzer)
+    liftIO $ writeFile "old-prev.dot" $ toDot show (analyzerPreviousGraph oldAnalyzer)
+    liftIO $ writeFile "new.dot" $ toDot show (analyzerGraph newAnalyzer)
+    liftIO $ writeFile "new-prev.dot" $ toDot show (analyzerPreviousGraph newAnalyzer)
+    liftIO $ writeFile "result.dot" $ toDot show (analyzerGraph analyzer)
+    liftIO $ writeFile "result-prev.dot" $ toDot show (analyzerPreviousGraph analyzer)
+
     -- Update the state
     put $ RuntimeState
         { hakyllAnalyzer  = analyzer
         , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)
-        , hakyllModified  = S.union oldModified newModified
         }
 
     -- Continue
@@ -162,7 +168,7 @@ stepAnalyzer = Runtime $ do
     put $ state { hakyllAnalyzer = analyzer' }
 
     case signal of Done      -> return ()
-                   Cycle c   -> return ()
+                   Cycle _   -> return ()
                    Build id' -> unRuntime $ build id'
 
 build :: Identifier -> Runtime ()
@@ -171,16 +177,15 @@ build id' = Runtime $ do
     routes <- hakyllRoutes <$> ask
     provider <- hakyllResourceProvider <$> ask
     store <- hakyllStore <$> ask
-    modified' <- hakyllModified <$> get
     compilers <- hakyllCompilers <$> get
 
     section logger $ "Compiling " ++ show id'
 
-    let -- Fetch the right compiler from the map
-        compiler = compilers M.! id'
+    -- Fetch the right compiler from the map
+    let compiler = compilers M.! id'
 
-        -- Check if the resource was modified
-        isModified = id' `S.member` modified'
+    -- Check if the resource was modified
+    isModified <- liftIO $ resourceModified provider store (Resource id')
 
     -- Run the compiler
     result <- timed logger "Total compile time" $ liftIO $