From 9e88440102842ca7fbed342e7f29ab9ea1dfea6f Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 7 Jan 2011 14:22:15 +0100 Subject: Restructure hakyllWith for metacompilers --- src/Hakyll/Core/Run.hs | 141 ++++++++++++++++++++++++++++--------------------- 1 file changed, 81 insertions(+), 60 deletions(-) (limited to 'src') diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index 2670c8e..ed9cea6 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -39,98 +39,119 @@ hakyll :: Rules -> IO () hakyll rules = do store <- makeStore "_store" provider <- fileResourceProvider - evalStateT - (runReaderT - (unHakyll (hakyllWith rules provider store)) undefined) undefined - -data HakyllState = HakyllState - { hakyllCompilers :: [(Identifier, Compiler () CompileRule)] - } + let ruleSet = runRules rules provider + compilers = rulesCompilers ruleSet + runReaderT (unHakyll (addNewCompilers [] compilers)) $ + env ruleSet provider store + where + env ruleSet provider store = HakyllEnvironment + { hakyllRoute = rulesRoute ruleSet + , hakyllResourceProvider = provider + , hakyllStore = store + , hakyllModified = S.empty + } data HakyllEnvironment = HakyllEnvironment { hakyllRoute :: Route , hakyllResourceProvider :: ResourceProvider , hakyllStore :: Store + , hakyllModified :: Set Identifier } newtype Hakyll a = Hakyll - { unHakyll :: ReaderT HakyllEnvironment (StateT HakyllState IO) a + { unHakyll :: ReaderT HakyllEnvironment IO a } deriving (Functor, Applicative, Monad) -hakyllWith :: Rules -> ResourceProvider -> Store -> Hakyll () -hakyllWith rules provider store = Hakyll $ do - let -- Get the rule set - ruleSet = runRules rules provider - - -- Get all identifiers and compilers - compilers = rulesCompilers ruleSet +-- | 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' -> + if resourceExists provider id' then resourceModified provider id' store + else return False - -- Get all dependencies +-- | 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 + -> Hakyll () +addNewCompilers oldCompilers newCompilers = Hakyll $ do + -- Get some information + provider <- hakyllResourceProvider <$> ask + store <- hakyllStore <$> ask + + let -- All compilers + compilers = oldCompilers ++ newCompilers + + -- Get all dependencies for the compilers dependencies = flip map compilers $ \(id', compiler) -> let deps = runCompilerDependencies compiler provider in (id', deps) - -- Create a compiler map + -- Create a compiler map (Id -> Compiler) compilerMap = M.fromList compilers - -- Create the graph + -- Create the dependency graph graph = fromList dependencies - liftIO $ do - putStrLn "Writing dependency graph to dependencies.dot..." - writeDot "dependencies.dot" show graph - - -- Check which items are up-to-date + -- Check which items are up-to-date. This only needs to happen for the new + -- compilers modified' <- liftIO $ modified provider store $ map fst compilers - let -- Try to reduce the graph + let -- Try to reduce the graph using this modified information reducedGraph = filterObsolete modified' graph - liftIO $ do - putStrLn "Writing reduced graph to reduced.dot..." - writeDot "reduced.dot" show reducedGraph - let -- Solve the graph ordered = solveDependencies reducedGraph -- Join the order with the compilers again orderedCompilers = map (id &&& (compilerMap M.!)) ordered - -- Fetch the routes - route' = rulesRoute ruleSet - - -- Generate all the targets in order - _ <- mapM (addTarget route' modified') orderedCompilers - - liftIO $ putStrLn "DONE." + -- Now run the ordered list of compilers + local (updateModified modified') $ unHakyll $ runCompilers orderedCompilers where - addTarget route' modified' (id', comp) = do - let url = runRoute route' id' - + -- Add the modified information for the new compilers + updateModified modified' env = env + { hakyllModified = hakyllModified env `S.union` modified' + } + +runCompilers :: [(Identifier, Compiler () CompileRule)] + -- ^ Ordered list of compilers + -> Hakyll () + -- ^ No result +runCompilers [] = return () +runCompilers ((id', compiler) : compilers) = Hakyll $ do + -- Obtain information + route' <- hakyllRoute <$> ask + provider <- hakyllResourceProvider <$> ask + store <- hakyllStore <$> ask + modified' <- hakyllModified <$> ask + + let -- Determine the URL + url = runRoute route' id' + -- Check if the resource was modified - let isModified = id' `S.member` modified' + isModified = id' `S.member` modified' - -- Run the compiler - ItemRule compiled <- liftIO $ - runCompiler comp id' provider url store isModified - liftIO $ putStrLn $ "Generated target: " ++ show id' + -- Run the compiler + result <- liftIO $ runCompiler compiler id' provider url store isModified + liftIO $ putStrLn $ "Generated target: " ++ show id' - case url of - Nothing -> return () - Just r -> liftIO $ do - putStrLn $ "Routing " ++ show id' ++ " to " ++ r - let path = "_site" r - makeDirectories path - write path compiled + let ItemRule compiled = result - liftIO $ putStrLn "" + case url of + Nothing -> return () + Just r -> liftIO $ do + putStrLn $ "Routing " ++ show id' ++ " to " ++ r + let path = "_site" r + makeDirectories path + write path compiled --- | 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' -> - if resourceExists provider id' then resourceModified provider id' store - else return False + liftIO $ putStrLn "" + + -- Continue for the remaining compilers + unHakyll $ runCompilers compilers -- cgit v1.2.3