Restructure hakyllWith for metacompilers

1 files changed, 81 insertions, 60 deletions

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