diff options
| -rw-r--r-- | hakyll.cabal | 1 | ||||
| -rw-r--r-- | src/Hakyll/Core/DirectedGraph/DependencySolver.hs | 70 | ||||
| -rw-r--r-- | src/Hakyll/Core/Resource/Provider.hs | 10 | ||||
| -rw-r--r-- | src/Hakyll/Core/Run.hs | 41 |
4 files changed, 28 insertions, 94 deletions
diff --git a/hakyll.cabal b/hakyll.cabal index 6336dd5..98fc845 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -100,7 +100,6 @@ library Hakyll.Core.Writable.WritableTuple Hakyll.Core.Identifier Hakyll.Core.DirectedGraph.Dot - Hakyll.Core.DirectedGraph.DependencySolver Hakyll.Core.DirectedGraph Hakyll.Core.Rules Hakyll.Core.Routes 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 $ |