summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--hakyll.cabal1
-rw-r--r--src/Hakyll/Core/DirectedGraph/DependencySolver.hs70
-rw-r--r--src/Hakyll/Core/Resource/Provider.hs10
-rw-r--r--src/Hakyll/Core/Run.hs41
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 $