Start playing with dependency analyzer
This commit is contained in:
parent
1e5f2f0691
commit
c3dbb0ca77
3 changed files with 74 additions and 76 deletions
|
@ -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
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
module Hakyll.Core.DependencyAnalyzer
|
||||
( DependencyAnalyzer
|
||||
( DependencyAnalyzer (..)
|
||||
, Signal (..)
|
||||
, makeDependencyAnalyzer
|
||||
, step
|
||||
|
|
|
@ -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,47 +49,52 @@ 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
|
||||
|
||||
-- Run the program and fetch the resulting state
|
||||
((), state') <- runStateT stateT state
|
||||
|
||||
-- We want to save the final dependency graph for the next run
|
||||
storeSet store "Hakyll.Core.Run.run" "dependencies" $ hakyllGraph state'
|
||||
|
||||
-- Flush and return
|
||||
flushLogger logger
|
||||
return ruleSet
|
||||
where
|
||||
env logger ruleSet provider store = RuntimeEnvironment
|
||||
reader = unRuntime $ addNewCompilers compilers
|
||||
stateT = runReaderT reader $ RuntimeEnvironment
|
||||
{ hakyllLogger = logger
|
||||
, hakyllConfiguration = configuration
|
||||
, hakyllRoutes = rulesRoutes ruleSet
|
||||
, hakyllResourceProvider = provider
|
||||
, hakyllStore = store
|
||||
, hakyllOldGraph = oldGraph
|
||||
}
|
||||
|
||||
state = RuntimeState
|
||||
{ hakyllModified = S.empty
|
||||
, hakyllGraph = mempty
|
||||
-- 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
|
||||
storeSet store "Hakyll.Core.Run.run" "dependencies" $
|
||||
analyzerGraph $ hakyllAnalyzer state'
|
||||
|
||||
-- Flush and return
|
||||
flushLogger logger
|
||||
return ruleSet
|
||||
|
||||
data RuntimeEnvironment = RuntimeEnvironment
|
||||
{ hakyllLogger :: Logger
|
||||
, hakyllConfiguration :: HakyllConfiguration
|
||||
, 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
|
||||
|
||||
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
|
||||
-- Check which items have been modified
|
||||
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
|
||||
-- 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
|
||||
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
|
||||
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
|
||||
|
|
Loading…
Reference in a new issue