Metacompilers now work, todo: cleanup

6 files changed, 35 insertions, 62 deletions

diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index f754860..4c624e2 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -7,7 +7,7 @@ module Hakyll.Core.Compiler
     , getIdentifier
     , getRoute
     , getResourceString
-    , waitFor
+    , fromDependency
     , require
     , requireAll
     , cached
@@ -92,11 +92,6 @@ getDependency identifier = CompilerM $ do
                    ++ show identifier
                    ++ " not found in the cache, the cache might be corrupted"
 
--- | Wait until another compiler has finished before running this compiler
---
-waitFor :: Identifier -> Compiler a a
-waitFor = fromDependencies . const . return
-
 -- | Require another target. Using this function ensures automatic handling of
 -- dependencies
 --
@@ -105,7 +100,7 @@ require :: (Binary a, Typeable a, Writable a)
         -> (b -> a -> c)
         -> Compiler b c
 require identifier f =
-    waitFor identifier >>> fromJob require'
+    fromDependency identifier >>> fromJob require'
   where
     require' x = do
         y <- getDependency identifier
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 0642b85..938d81a 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -10,6 +10,7 @@ module Hakyll.Core.Compiler.Internal
     , runCompilerDependencies
     , fromJob
     , fromDependencies
+    , fromDependency
     ) where
 
 import Prelude hiding ((.), id)
@@ -101,3 +102,8 @@ fromJob = Compiler (return S.empty)
 fromDependencies :: (ResourceProvider -> [Identifier])
                  -> Compiler b b
 fromDependencies deps = Compiler (S.fromList . deps <$> ask) return
+
+-- | Wait until another compiler has finished before running this compiler
+--
+fromDependency :: Identifier -> Compiler a a
+fromDependency = fromDependencies . const . return
diff --git a/src/Hakyll/Core/DirectedGraph.hs b/src/Hakyll/Core/DirectedGraph.hs
index b24ce25..bf52277 100644
--- a/src/Hakyll/Core/DirectedGraph.hs
+++ b/src/Hakyll/Core/DirectedGraph.hs
@@ -7,11 +7,10 @@ module Hakyll.Core.DirectedGraph
     , nodes
     , neighbours
     , reverse
-    , filter
     , reachableNodes
     ) where
 
-import Prelude hiding (reverse, filter)
+import Prelude hiding (reverse)
 import Data.Monoid (mconcat)
 import Data.Set (Set)
 import Data.Maybe (fromMaybe)
@@ -53,24 +52,16 @@ reverse = mconcat . map reverse' . M.toList . unDirectedGraph
     reverse' (id', Node _ neighbours') = fromList $
         zip (S.toList neighbours') $ repeat $ S.singleton id'
 
--- | Filter a directed graph (i.e. remove nodes based on a predicate)
+-- | Find all reachable nodes from a given set of nodes in the directed graph
 --
-filter :: Ord a
-       => (a -> Bool)      -- ^ Predicate
-       -> DirectedGraph a  -- ^ Graph
-       -> DirectedGraph a  -- ^ Resulting graph
-filter predicate =
-    DirectedGraph . M.filterWithKey (\k _ -> predicate k) . unDirectedGraph
-
--- | Find all reachable nodes from a given node in the directed graph
---
-reachableNodes :: Ord a => a -> DirectedGraph a -> Set a
-reachableNodes x graph = reachable (neighbours x graph) (S.singleton x)
+reachableNodes :: Ord a => Set a -> DirectedGraph a -> Set a
+reachableNodes set graph = reachable (setNeighbours set) set
   where
     reachable next visited
         | S.null next = visited
         | otherwise = reachable (sanitize neighbours') (next `S.union` visited)
       where
         sanitize = S.filter (`S.notMember` visited)
-        neighbours' = S.unions $ map (flip neighbours graph)
-                               $ S.toList $ sanitize next
+        neighbours' = setNeighbours (sanitize next)
+
+    setNeighbours = S.unions . map (flip neighbours graph) . S.toList
diff --git a/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs b/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs
deleted file mode 100644
index 9aeb2ff..0000000
--- a/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs
+++ /dev/null
@@ -1,27 +0,0 @@
--- | Module exporting a function that works as a filter on a dependency graph.
--- Given a list of obsolete nodes, this filter will reduce the graph so it only
--- contains obsolete nodes and nodes that depend (directly or indirectly) on
--- obsolete nodes.
---
-module Hakyll.Core.DirectedGraph.ObsoleteFilter
-    ( filterObsolete
-    ) where
-
-import Data.Set (Set)
-import qualified Data.Set as S
-
-import Hakyll.Core.DirectedGraph
-import qualified Hakyll.Core.DirectedGraph as DG
-
--- | Given a list of obsolete items, filter the dependency graph so it only
--- contains these items
---
-filterObsolete :: Ord a
-               => Set a            -- ^ Obsolete items
-               -> DirectedGraph a  -- ^ Dependency graph
-               -> DirectedGraph a  -- ^ Resulting dependency graph
-filterObsolete obsolete graph =
-    let reversed = DG.reverse graph
-        allObsolete = S.unions $ map (flip reachableNodes reversed)
-                               $ S.toList obsolete
-    in DG.filter (`S.member` allObsolete) graph
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index 28ae555..ae476b7 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -117,6 +117,7 @@ addCompilers :: (Binary a, Typeable a, Writable a)
              -> Rules
              -- ^ Resulting rules
 addCompilers identifier compiler = RulesM $ tell $ RuleSet mempty $
-    [(identifier, compiler >>^ makeRule)]
+    [(identifier, compiler >>> arr makeRule )]
   where
-    makeRule = MetaCompileRule . map (second (>>^ CompileRule . compiledItem))
+    makeRule = MetaCompileRule . map (second box)
+    box = (>>> fromDependency identifier >>^ CompileRule . compiledItem)
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index dea848b..324294f 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Hakyll.Core.Run where
 
+import Prelude hiding (reverse)
 import Control.Applicative
 import Control.Monad.Reader
 import Control.Monad.State
@@ -30,7 +31,6 @@ import Hakyll.Core.Rules
 import Hakyll.Core.DirectedGraph
 import Hakyll.Core.DirectedGraph.Dot
 import Hakyll.Core.DirectedGraph.DependencySolver
-import Hakyll.Core.DirectedGraph.ObsoleteFilter
 import Hakyll.Core.Writable
 import Hakyll.Core.Store
 import Hakyll.Core.CompiledItem
@@ -49,6 +49,7 @@ hakyll rules = do
         , hakyllResourceProvider = provider
         , hakyllStore            = store
         , hakyllModified         = S.empty
+        , hakyllObsolete         = S.empty
         }
 
 data HakyllEnvironment = HakyllEnvironment
@@ -56,6 +57,7 @@ data HakyllEnvironment = HakyllEnvironment
     , hakyllResourceProvider :: ResourceProvider
     , hakyllStore            :: Store
     , hakyllModified         :: Set Identifier
+    , hakyllObsolete         :: Set Identifier
     }
 
 newtype Hakyll a = Hakyll
@@ -98,19 +100,22 @@ addNewCompilers oldCompilers newCompilers = Hakyll $ do
         -- Create the dependency graph
         graph = fromList dependencies
 
+    liftIO $ writeDot "dependencies.dot" show graph
+
     -- Check which items are up-to-date. This only needs to happen for the new
     -- compilers
     oldModified <- hakyllModified <$> ask 
     newModified <- liftIO $ modified provider store $ map fst newCompilers
-    let modified' = oldModified `S.union` newModified
+    oldObsolete <- hakyllObsolete <$> ask
 
-    liftIO $ putStrLn $ show modified'
-
-    let -- Try to reduce the graph using this modified information
-        reducedGraph = filterObsolete modified' graph
+    let modified' = oldModified `S.union` newModified
+        
+        -- Find obsolete items
+        obsolete = reachableNodes (oldObsolete `S.union` modified') $
+            reverse graph
 
-    let -- Solve the graph
-        ordered = solveDependencies reducedGraph
+         -- Solve the graph, retain only the obsolete items
+        ordered = filter (`S.member` obsolete) $ solveDependencies graph
 
         -- Join the order with the compilers again
         orderedCompilers = map (id &&& (compilerMap M.!)) ordered
@@ -118,11 +123,13 @@ addNewCompilers oldCompilers newCompilers = Hakyll $ do
     liftIO $ putStrLn "Adding compilers..."
 
     -- Now run the ordered list of compilers
-    local (updateModified modified') $ unHakyll $ runCompilers orderedCompilers
+    local (updateEnv modified' obsolete) $
+        unHakyll $ runCompilers orderedCompilers
   where
     -- Add the modified information for the new compilers
-    updateModified modified' env = env
+    updateEnv modified' obsolete env = env
         { hakyllModified = modified'
+        , hakyllObsolete = obsolete
         }
 
 runCompilers :: [(Identifier, Compiler () CompileRule)]