summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Hakyll/Core/DependencyAnalyzer.hs2
-rw-r--r--src/Hakyll/Core/Run.hs153
2 files changed, 76 insertions, 79 deletions
diff --git a/src/Hakyll/Core/DependencyAnalyzer.hs b/src/Hakyll/Core/DependencyAnalyzer.hs
index 97a571f..2f13b37 100644
--- a/src/Hakyll/Core/DependencyAnalyzer.hs
+++ b/src/Hakyll/Core/DependencyAnalyzer.hs
@@ -1,5 +1,5 @@
module Hakyll.Core.DependencyAnalyzer
- ( DependencyAnalyzer
+ ( DependencyAnalyzer (..)
, Signal (..)
, makeDependencyAnalyzer
, step
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index 54bb104..c2cc21b 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/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
@@ -28,7 +30,9 @@ import Hakyll.Core.Resource.Provider
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
import Hakyll.Core.Configuration
@@ -46,35 +50,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
@@ -82,11 +89,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
@@ -105,84 +114,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
-
- -- 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
-
- 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
-
- 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
+ newGraph = fromList dependencies
+
+ -- Check which items have been modified
+ 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
+
+ -- 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
@@ -202,14 +199,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