diff options
| -rw-r--r-- | src/Hakyll/Core/Compiler.hs | 9 | ||||
| -rw-r--r-- | src/Hakyll/Core/Compiler/Internal.hs | 6 | ||||
| -rw-r--r-- | src/Hakyll/Core/DirectedGraph.hs | 23 | ||||
| -rw-r--r-- | src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs | 27 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules.hs | 5 | ||||
| -rw-r--r-- | src/Hakyll/Core/Run.hs | 27 |
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)] |