summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Core/Compiler.hs9
-rw-r--r--src/Hakyll/Core/Compiler/Internal.hs6
-rw-r--r--src/Hakyll/Core/DirectedGraph.hs23
-rw-r--r--src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs27
-rw-r--r--src/Hakyll/Core/Rules.hs5
-rw-r--r--src/Hakyll/Core/Run.hs27
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)]