summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Hakyll/Core/CompiledItem.hs2
-rw-r--r--src/Hakyll/Core/Compiler.hs34
-rw-r--r--src/Hakyll/Core/Compiler/Internal.hs2
-rw-r--r--src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs6
-rw-r--r--src/Hakyll/Core/Run.hs58
5 files changed, 74 insertions, 28 deletions
diff --git a/src/Hakyll/Core/CompiledItem.hs b/src/Hakyll/Core/CompiledItem.hs
index d191e2a..d12d172 100644
--- a/src/Hakyll/Core/CompiledItem.hs
+++ b/src/Hakyll/Core/CompiledItem.hs
@@ -4,7 +4,7 @@
--
{-# LANGUAGE ExistentialQuantification #-}
module Hakyll.Core.CompiledItem
- ( CompiledItem
+ ( CompiledItem (..)
, compiledItem
, unCompiledItem
) where
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index fdc7d20..df1caeb 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -6,6 +6,7 @@ module Hakyll.Core.Compiler
, getIdentifier
, getRoute
, getResourceString
+ , storeResult
, require
, requireAll
, cached
@@ -17,6 +18,7 @@ import Control.Applicative ((<$>))
import Control.Monad.Reader (ask)
import Control.Monad.Trans (liftIO)
import Control.Category (Category, (.))
+import Data.Maybe (fromMaybe)
import Data.Binary (Binary)
import Data.Typeable (Typeable)
@@ -48,6 +50,28 @@ getResourceString = getIdentifier >>> getResourceString'
provider <- compilerResourceProvider <$> ask
liftIO $ resourceString provider id'
+-- | Store a finished item in the cache
+--
+storeResult :: Store -> Identifier -> CompiledItem -> IO ()
+storeResult store identifier (CompiledItem x) =
+ storeSet store "Hakyll.Core.Compiler.storeResult" identifier x
+
+-- | Auxiliary: get a dependency
+--
+getDependencyOrResult :: (Binary a, Writable a, Typeable a)
+ => Identifier -> CompilerM a
+getDependencyOrResult identifier = CompilerM $ do
+ lookup' <- compilerDependencyLookup <$> ask
+ store <- compilerStore <$> ask
+ case lookup' identifier of
+ -- Found in the dependency lookup
+ Just r -> return $ unCompiledItem r
+ -- Not found here, try the main cache
+ Nothing -> fmap (fromMaybe error') $ liftIO $
+ storeGet store "Hakyll.Core.Compiler.storeResult" identifier
+ where
+ error' = error "Hakyll.Core.Compiler.getDependency: Not found"
+
-- | Require another target. Using this function ensures automatic handling of
-- dependencies
--
@@ -58,9 +82,9 @@ require :: (Binary a, Typeable a, Writable a)
require identifier f =
fromDependencies (const [identifier]) >>> fromJob require'
where
- require' x = CompilerM $ do
- lookup' <- compilerDependencyLookup <$> ask
- return $ f x $ unCompiledItem $ lookup' identifier
+ require' x = do
+ y <- getDependencyOrResult identifier
+ return $ f x y
-- | Require a number of targets. Using this function ensures automatic handling
-- of dependencies
@@ -75,8 +99,8 @@ requireAll pattern f =
getDeps = matches pattern . resourceList
requireAll' x = CompilerM $ do
deps <- getDeps . compilerResourceProvider <$> ask
- lookup' <- compilerDependencyLookup <$> ask
- return $ f x $ map (unCompiledItem . lookup') deps
+ items <- mapM (unCompilerM . getDependencyOrResult) deps
+ return $ f x items
cached :: (Binary a)
=> String
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index a4dd695..262cda0 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -32,7 +32,7 @@ type Dependencies = Set Identifier
-- | A lookup with which we can get dependencies
--
-type DependencyLookup = Identifier -> CompiledItem
+type DependencyLookup = Identifier -> Maybe CompiledItem
-- | Environment in which a compiler runs
--
diff --git a/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs b/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs
index f781819..9aeb2ff 100644
--- a/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs
+++ b/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs
@@ -7,6 +7,7 @@ module Hakyll.Core.DirectedGraph.ObsoleteFilter
( filterObsolete
) where
+import Data.Set (Set)
import qualified Data.Set as S
import Hakyll.Core.DirectedGraph
@@ -16,10 +17,11 @@ import qualified Hakyll.Core.DirectedGraph as DG
-- contains these items
--
filterObsolete :: Ord a
- => [a] -- ^ List of obsolete items
+ => 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) obsolete
+ allObsolete = S.unions $ map (flip reachableNodes reversed)
+ $ S.toList obsolete
in DG.filter (`S.member` allObsolete) graph
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index 6898b3a..e9ec47e 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -3,13 +3,16 @@
module Hakyll.Core.Run where
import Control.Arrow ((&&&))
-import Control.Monad (foldM, forM_, forM)
+import Control.Monad (foldM, forM_, forM, filterM)
+import Data.Map (Map)
import qualified Data.Map as M
import Data.Monoid (mempty)
import Data.Typeable (Typeable)
import Data.Binary (Binary)
import System.FilePath ((</>))
import Control.Applicative ((<$>))
+import Data.Set (Set)
+import qualified Data.Set as S
import Hakyll.Core.Route
import Hakyll.Core.Identifier
@@ -22,6 +25,7 @@ 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
@@ -48,9 +52,23 @@ hakyllWith rules provider store = do
-- Create a compiler map
compilerMap = M.fromList compilers
- -- Create and solve the graph, creating a compiler order
+ -- Create the graph
graph = fromList dependencies
- ordered = solveDependencies graph
+
+ putStrLn "Writing dependency graph to dependencies.dot..."
+ writeDot "dependencies.dot" show graph
+
+ -- Check which items are up-to-date
+ modified' <- modified provider store $ map fst compilers
+
+ let -- Try to reduce the graph
+ reducedGraph = filterObsolete modified' graph
+
+ 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
@@ -58,30 +76,23 @@ hakyllWith rules provider store = do
-- Fetch the routes
route' = rulesRoute ruleSet
- putStrLn "Writing dependency graph to dependencies.dot..."
- writeDot "dependencies.dot" show graph
-
- -- Check which items are up-to-date: modified will be a Map Identifier Bool
- modifiedMap <- fmap M.fromList $ forM orderedCompilers $ \(id', _) -> do
- modified <- if resourceExists provider id'
- then resourceModified provider id' store
- else return False
- return (id', modified)
+ putStrLn $ show reducedGraph
+ putStrLn $ show ordered
-- Generate all the targets in order
- _ <- foldM (addTarget route' modifiedMap) M.empty orderedCompilers
+ _ <- foldM (addTarget route' modified') M.empty orderedCompilers
putStrLn "DONE."
where
- addTarget route' modifiedMap map' (id', comp) = do
+ addTarget route' modified' map' (id', comp) = do
let url = runRoute route' id'
-- Check if the resource was modified
- let modified = modifiedMap M.! id'
+ let isModified = id' `S.member` modified'
-- Run the compiler
compiled <- runCompilerJob comp id' provider (dependencyLookup map')
- url store modified
+ url store isModified
putStrLn $ "Generated target: " ++ show id'
case url of
@@ -92,9 +103,18 @@ hakyllWith rules provider store = do
makeDirectories path
write path compiled
+ -- Store it in the cache
+ storeResult store id' compiled
+
putStrLn ""
return $ M.insert id' compiled map'
- dependencyLookup map' id' = case M.lookup id' map' of
- Nothing -> error $ "dependencyLookup: " ++ show id' ++ " not found"
- Just d -> d
+ dependencyLookup map' id' = M.lookup id' map'
+
+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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 23:18:00 +0000