2ceb5f5 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Avoid looking at up-to-date items at all

2ceb5f5Jasper Van der Jeugt16 years ago

src/Hakyll/Core/CompiledItem.hs+1−1

compare with master

unifiedsplit

@@ -4,7 +4,7 @@

4--

5{-# LANGUAGE ExistentialQuantification #-}

6module Hakyll.Core.CompiledItem

7− ( CompiledItem

7+ ( CompiledItem (..)

8 , compiledItem

9 , unCompiledItem

10 ) where

src/Hakyll/Core/Compiler.hs+29−5

@@ -6,6 +6,7 @@ module Hakyll.Core.Compiler

6 , getIdentifier

7 , getRoute

8 , getResourceString

9+ , storeResult

9 , require

10 , require

10 , requireAll

11 , requireAll

11 , cached

12 , cached

@@ -17,6 +18,7 @@ import Control.Applicative ((<$>))

17import Control.Monad.Reader (ask)

18import Control.Monad.Reader (ask)

18import Control.Monad.Trans (liftIO)

19import Control.Monad.Trans (liftIO)

19import Control.Category (Category, (.))

20import Control.Category (Category, (.))

21+import Data.Maybe (fromMaybe)

21import Data.Binary (Binary)

23import Data.Binary (Binary)

22import Data.Typeable (Typeable)

24import Data.Typeable (Typeable)

@@ -48,6 +50,28 @@ getResourceString = getIdentifier >>> getResourceString'

48 provider <- compilerResourceProvider <$> ask

50 provider <- compilerResourceProvider <$> ask

49 liftIO $ resourceString provider id'

51 liftIO $ resourceString provider id'

53+-- | Store a finished item in the cache

54+--

55+storeResult :: Store -> Identifier -> CompiledItem -> IO ()

56+storeResult store identifier (CompiledItem x) =

57+ storeSet store "Hakyll.Core.Compiler.storeResult" identifier x

58+

59+-- | Auxiliary: get a dependency

60+--

61+getDependencyOrResult :: (Binary a, Writable a, Typeable a)

62+ => Identifier -> CompilerM a

63+getDependencyOrResult identifier = CompilerM $ do

64+ lookup' <- compilerDependencyLookup <$> ask

65+ store <- compilerStore <$> ask

66+ case lookup' identifier of

67+ -- Found in the dependency lookup

68+ Just r -> return $ unCompiledItem r

69+ -- Not found here, try the main cache

70+ Nothing -> fmap (fromMaybe error') $ liftIO $

71+ storeGet store "Hakyll.Core.Compiler.storeResult" identifier

72+ where

73+ error' = error "Hakyll.Core.Compiler.getDependency: Not found"

74+

51-- | Require another target. Using this function ensures automatic handling of

75-- | Require another target. Using this function ensures automatic handling of

52-- dependencies

76-- dependencies

53--

77--

@@ -58,9 +82,9 @@ require :: (Binary a, Typeable a, Writable a)

58require identifier f =

82require identifier f =

59 fromDependencies (const [identifier]) >>> fromJob require'

83 fromDependencies (const [identifier]) >>> fromJob require'

60 where

84 where

61− require' x = CompilerM $ do

85+ require' x = do

62− lookup' <- compilerDependencyLookup <$> ask

86+ y <- getDependencyOrResult identifier

63− return $ f x $ unCompiledItem $ lookup' identifier

87+ return $ f x y

65-- | Require a number of targets. Using this function ensures automatic handling

89-- | Require a number of targets. Using this function ensures automatic handling

66-- of dependencies

90-- of dependencies

@@ -75,8 +99,8 @@ requireAll pattern f =

75 getDeps = matches pattern . resourceList

99 getDeps = matches pattern . resourceList

76 requireAll' x = CompilerM $ do

100 requireAll' x = CompilerM $ do

77 deps <- getDeps . compilerResourceProvider <$> ask

101 deps <- getDeps . compilerResourceProvider <$> ask

78− lookup' <- compilerDependencyLookup <$> ask

102+ items <- mapM (unCompilerM . getDependencyOrResult) deps

79− return $ f x $ map (unCompiledItem . lookup') deps

103+ return $ f x items

104

81cached :: (Binary a)

105cached :: (Binary a)

82 => String

106 => String

src/Hakyll/Core/Compiler/Internal.hs+1−1

@@ -32,7 +32,7 @@ type Dependencies = Set Identifier

33-- | A lookup with which we can get dependencies

34--

35−type DependencyLookup = Identifier -> CompiledItem

35+type DependencyLookup = Identifier -> Maybe CompiledItem

37-- | Environment in which a compiler runs

38--

src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs+4−2

@@ -7,6 +7,7 @@ module Hakyll.Core.DirectedGraph.ObsoleteFilter

7 ( filterObsolete

8 ) where

10+import Data.Set (Set)

10import qualified Data.Set as S

11import qualified Data.Set as S

12import Hakyll.Core.DirectedGraph

13import Hakyll.Core.DirectedGraph

@@ -16,10 +17,11 @@ import qualified Hakyll.Core.DirectedGraph as DG

16-- contains these items

17-- contains these items

17--

18--

18filterObsolete :: Ord a

19filterObsolete :: Ord a

19− => [a] -- ^ List of obsolete items

20+ => Set a -- ^ Obsolete items

20 -> DirectedGraph a -- ^ Dependency graph

21 -> DirectedGraph a -- ^ Dependency graph

21 -> DirectedGraph a -- ^ Resulting dependency graph

22 -> DirectedGraph a -- ^ Resulting dependency graph

22filterObsolete obsolete graph =

23filterObsolete obsolete graph =

23 let reversed = DG.reverse graph

24 let reversed = DG.reverse graph

24− allObsolete = S.unions $ map (flip reachableNodes reversed) obsolete

25+ allObsolete = S.unions $ map (flip reachableNodes reversed)

26+ $ S.toList obsolete

25 in DG.filter (`S.member` allObsolete) graph

27 in DG.filter (`S.member` allObsolete) graph

src/Hakyll/Core/Run.hs+39−19

@@ -3,13 +3,16 @@

3module Hakyll.Core.Run where

5import Control.Arrow ((&&&))

6−import Control.Monad (foldM, forM_, forM)

6+import Control.Monad (foldM, forM_, forM, filterM)

7+import Data.Map (Map)

7import qualified Data.Map as M

8import qualified Data.Map as M

8import Data.Monoid (mempty)

9import Data.Monoid (mempty)

9import Data.Typeable (Typeable)

10import Data.Typeable (Typeable)

10import Data.Binary (Binary)

11import Data.Binary (Binary)

11import System.FilePath ((</>))

12import System.FilePath ((</>))

12import Control.Applicative ((<$>))

13import Control.Applicative ((<$>))

14+import Data.Set (Set)

15+import qualified Data.Set as S

14import Hakyll.Core.Route

17import Hakyll.Core.Route

15import Hakyll.Core.Identifier

18import Hakyll.Core.Identifier

@@ -22,6 +25,7 @@ import Hakyll.Core.Rules

22import Hakyll.Core.DirectedGraph

25import Hakyll.Core.DirectedGraph

23import Hakyll.Core.DirectedGraph.Dot

26import Hakyll.Core.DirectedGraph.Dot

24import Hakyll.Core.DirectedGraph.DependencySolver

27import Hakyll.Core.DirectedGraph.DependencySolver

28+import Hakyll.Core.DirectedGraph.ObsoleteFilter

25import Hakyll.Core.Writable

29import Hakyll.Core.Writable

26import Hakyll.Core.Store

30import Hakyll.Core.Store

27import Hakyll.Core.CompiledItem

31import Hakyll.Core.CompiledItem

@@ -48,9 +52,23 @@ hakyllWith rules provider store = do

48 -- Create a compiler map

52 -- Create a compiler map

49 compilerMap = M.fromList compilers

53 compilerMap = M.fromList compilers

51− -- Create and solve the graph, creating a compiler order

55+ -- Create the graph

52 graph = fromList dependencies

56 graph = fromList dependencies

57+

58+ putStrLn "Writing dependency graph to dependencies.dot..."

59+ writeDot "dependencies.dot" show graph

60+

61+ -- Check which items are up-to-date

62+ modified' <- modified provider store $ map fst compilers

63+

64+ let -- Try to reduce the graph

65+ reducedGraph = filterObsolete modified' graph

66+

67+ putStrLn "Writing reduced graph to reduced.dot..."

68+ writeDot "reduced.dot" show reducedGraph

69+

70+ let -- Solve the graph

53− ordered = solveDependencies graph

71+ ordered = solveDependencies reducedGraph

55 -- Join the order with the compilers again

73 -- Join the order with the compilers again

56 orderedCompilers = map (id &&& (compilerMap M.!)) ordered

74 orderedCompilers = map (id &&& (compilerMap M.!)) ordered

@@ -58,30 +76,23 @@ hakyllWith rules provider store = do

58 -- Fetch the routes

76 -- Fetch the routes

59 route' = rulesRoute ruleSet

77 route' = rulesRoute ruleSet

61− putStrLn "Writing dependency graph to dependencies.dot..."

79+ putStrLn $ show reducedGraph

62− writeDot "dependencies.dot" show graph

80+ putStrLn $ show ordered

63−

64− -- Check which items are up-to-date: modified will be a Map Identifier Bool

65− modifiedMap <- fmap M.fromList $ forM orderedCompilers $ \(id', _) -> do

66− modified <- if resourceExists provider id'

67− then resourceModified provider id' store

68− else return False

69− return (id', modified)

71 -- Generate all the targets in order

82 -- Generate all the targets in order

72− _ <- foldM (addTarget route' modifiedMap) M.empty orderedCompilers

83+ _ <- foldM (addTarget route' modified') M.empty orderedCompilers

74 putStrLn "DONE."

85 putStrLn "DONE."

75 where

86 where

76− addTarget route' modifiedMap map' (id', comp) = do

87+ addTarget route' modified' map' (id', comp) = do

77 let url = runRoute route' id'

88 let url = runRoute route' id'

79 -- Check if the resource was modified

90 -- Check if the resource was modified

80− let modified = modifiedMap M.! id'

91+ let isModified = id' `S.member` modified'

82 -- Run the compiler

93 -- Run the compiler

83 compiled <- runCompilerJob comp id' provider (dependencyLookup map')

94 compiled <- runCompilerJob comp id' provider (dependencyLookup map')

84− url store modified

95+ url store isModified

85 putStrLn $ "Generated target: " ++ show id'

96 putStrLn $ "Generated target: " ++ show id'

87 case url of

98 case url of

@@ -92,9 +103,18 @@ hakyllWith rules provider store = do

92 makeDirectories path

103 makeDirectories path

93 write path compiled

104 write path compiled

105

106+ -- Store it in the cache

107+ storeResult store id' compiled

108+

95 putStrLn ""

109 putStrLn ""

96 return $ M.insert id' compiled map'

110 return $ M.insert id' compiled map'

111

98− dependencyLookup map' id' = case M.lookup id' map' of

112+ dependencyLookup map' id' = M.lookup id' map'

99− Nothing -> error $ "dependencyLookup: " ++ show id' ++ " not found"

113+

100− Just d -> d

114+modified :: ResourceProvider -- ^ Resource provider

115+ -> Store -- ^ Store

116+ -> [Identifier] -- ^ Identifiers to check

117+ -> IO (Set Identifier) -- ^ Modified resources

118+modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->

119+ if resourceExists provider id' then resourceModified provider id' store

120+ else return False