From 50f8f819f9b67822305350b77117d4cb7a00cf45 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Tue, 13 Nov 2012 19:03:58 +0100 Subject: Stuff works now (somewhat) --- src/Hakyll/Core/Run.hs | 189 --------------------------------------------- src/Hakyll/Core/Runtime.hs | 8 +- 2 files changed, 6 insertions(+), 191 deletions(-) delete mode 100644 src/Hakyll/Core/Run.hs (limited to 'src/Hakyll/Core') diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs deleted file mode 100644 index adbdb60..0000000 --- a/src/Hakyll/Core/Run.hs +++ /dev/null @@ -1,189 +0,0 @@ --------------------------------------------------------------------------------- --- | This is the module which binds it all together -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -module Hakyll.Core.Run - ( run - ) where - - --------------------------------------------------------------------------------- -import Control.Applicative (Applicative, (<$>)) -import Control.DeepSeq (deepseq) -import Control.Monad (filterM, forM_) -import Control.Monad.Error (ErrorT, runErrorT, throwError) -import Control.Monad.Reader (ReaderT, ask, runReaderT) -import Control.Monad.Trans (liftIO) -import Data.Map (Map) -import qualified Data.Map as M -import Data.Monoid (mempty) -import qualified Data.Set as S -import Prelude hiding (reverse) -import System.FilePath (()) - - --------------------------------------------------------------------------------- -import Hakyll.Core.CompiledItem -import Hakyll.Core.Compiler -import Hakyll.Core.Compiler.Internal -import Hakyll.Core.Configuration -import Hakyll.Core.DependencyAnalyzer -import qualified Hakyll.Core.DirectedGraph as DG -import Hakyll.Core.Identifier -import Hakyll.Core.Logger -import Hakyll.Core.ResourceProvider -import Hakyll.Core.Routes -import Hakyll.Core.Rules.Internal -import Hakyll.Core.Store (Store) -import qualified Hakyll.Core.Store as Store -import Hakyll.Core.Util.File -import Hakyll.Core.Writable - - --------------------------------------------------------------------------------- --- | Run all rules needed, return the rule set used -run :: HakyllConfiguration -> RulesM a -> IO RuleSet -run configuration rules = do - logger <- makeLogger putStrLn - - section logger "Initialising" - store <- timed logger "Creating store" $ - Store.new (inMemoryCache configuration) $ storeDirectory configuration - provider <- timed logger "Creating provider" $ newResourceProvider - store (ignoreFile configuration) "." - - ruleSet <- timed logger "Running rules" $ runRules rules provider - let compilers = rulesCompilers ruleSet - - -- Extract the reader/state - reader = unRuntime analyzeAndBuild - errorT = runReaderT reader $ RuntimeEnvironment - { runtimeLogger = logger - , runtimeConfiguration = configuration - , runtimeRoutes = rulesRoutes ruleSet - , runtimeProvider = provider - , runtimeStore = store - , runtimeCompilers = M.fromList compilers - } - - -- Run the program and fetch the resulting state - result <- runErrorT errorT - case result of - Left e -> thrown logger e - _ -> return () - - -- Flush and return - flushLogger logger - return ruleSet - - --------------------------------------------------------------------------------- -data RuntimeEnvironment = RuntimeEnvironment - { runtimeLogger :: Logger - , runtimeConfiguration :: HakyllConfiguration - , runtimeRoutes :: Routes - , runtimeProvider :: ResourceProvider - , runtimeStore :: Store - , runtimeCompilers :: Map (Identifier ()) (Compiler () CompiledItem) - } - - --------------------------------------------------------------------------------- -newtype Runtime a = Runtime - { unRuntime :: ReaderT RuntimeEnvironment (ErrorT String IO) a - } deriving (Functor, Applicative, Monad) - - --------------------------------------------------------------------------------- -analyzeAndBuild :: Runtime () -analyzeAndBuild = Runtime $ do - -- Get some stuff - logger <- runtimeLogger <$> ask - provider <- runtimeProvider <$> ask - store <- runtimeStore <$> ask - compilers <- runtimeCompilers <$> ask - - -- Checking which items have been modified - let universe = M.keys compilers - modified <- timed logger "Checking for modified items" $ - fmap S.fromList $ flip filterM universe $ - liftIO . resourceModified provider - - -- Fetch the old graph from the store. If we don't find it, we consider this - -- to be the first run - mOldGraph <- liftIO $ Store.get store graphKey - let (firstRun, oldGraph) = case mOldGraph of Store.Found g -> (False, g) - _ -> (True, mempty) - - -- Create a new dependency graph - graph = DG.fromList $ - flip map (M.toList compilers) $ \(id', compiler) -> - let deps = runCompilerDependencies compiler id' universe - in (id', S.toList deps) - - ood | firstRun = const True - | otherwise = (`S.member` modified) - - -- Check for cycles and analyze the graph - analysis = analyze oldGraph graph ood - - -- Make sure this stuff is evaluated - () <- timed logger "Analyzing dependency graph" $ - oldGraph `deepseq` analysis `deepseq` return () - - -- We want to save the new dependency graph for the next run - liftIO $ Store.set store graphKey graph - - case analysis of - Cycle c -> unRuntime $ dumpCycle c - Order o -> mapM_ (unRuntime . build) o - where - graphKey = ["Hakyll.Core.Run.run", "dependencies"] - - --------------------------------------------------------------------------------- --- | Dump cyclic error and quit -dumpCycle :: [Identifier ()] -> Runtime () -dumpCycle cycle' = Runtime $ do - logger <- runtimeLogger <$> ask - section logger "Dependency cycle detected! Conflict:" - forM_ (zip cycle' $ drop 1 cycle') $ \(x, y) -> - report logger $ show x ++ " -> " ++ show y - - --------------------------------------------------------------------------------- -build :: Identifier () -> Runtime () -build id' = Runtime $ do - logger <- runtimeLogger <$> ask - routes <- runtimeRoutes <$> ask - provider <- runtimeProvider <$> ask - store <- runtimeStore <$> ask - compilers <- runtimeCompilers <$> ask - - section logger $ "Compiling " ++ show id' - - -- Fetch the right compiler from the map - let compiler = compilers M.! id' - - -- Check if the resource was modified - isModified <- liftIO $ resourceModified provider id' - - -- Run the compiler - result <- timed logger "Total compile time" $ liftIO $ - runCompiler compiler id' provider (M.keys compilers) routes - store isModified logger - - case result of - -- Success - Right compiled -> do - case runRoutes routes id' of - Nothing -> return () - Just url -> timed logger ("Routing to " ++ url) $ do - destination <- - destinationDirectory . runtimeConfiguration <$> ask - let path = destination url - liftIO $ makeDirectories path - liftIO $ write path compiled - - -- Some error happened, rethrow in Runtime monad - Left err -> throwError err diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs index 7354119..2ed3d2c 100644 --- a/src/Hakyll/Core/Runtime.hs +++ b/src/Hakyll/Core/Runtime.hs @@ -132,7 +132,9 @@ scheduleOutOfDate = do -- Update facts and todo items modify $ \s -> s - { runtimeTodo = todo `M.union` todo' + { runtimeDone = runtimeDone s `S.union` + (S.fromList identifiers `S.difference` ood) + , runtimeTodo = todo `M.union` todo' , runtimeFacts = facts' } @@ -143,7 +145,9 @@ pickAndChase = do todo <- runtimeTodo <$> get case M.minViewWithKey todo of Nothing -> return () - Just ((id', _), _) -> chase [] id' + Just ((id', _), _) -> do + chase [] id' + pickAndChase -------------------------------------------------------------------------------- -- cgit v1.2.3