2ceb5f5 · hakyll · git.iko.soy

git.iko.soy/hakyll

Avoid looking at up-to-date items at all

commit2ceb5f59d0728c380ad7b4f319a9282741e715b9 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateMon 3 Jan 2011, 22:13 (16 years ago) parent40c7576

5 files changed+74−28

compare with master

unifiedsplit

src/Hakyll/Core/CompiledItem.hs+1−1 src/Hakyll/Core/Compiler.hs+29−5 src/Hakyll/Core/Compiler/Internal.hs+1−1 src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs+4−2 src/Hakyll/Core/Run.hs+39−19

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

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

44--

55{-# LANGUAGE ExistentialQuantification #-}

66module Hakyll.Core.CompiledItem

7− ( CompiledItem

7+ ( CompiledItem (..)

88 , compiledItem

99 , unCompiledItem

1010 ) where

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

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

66 , getIdentifier

77 , getRoute

88 , getResourceString

9+ , storeResult

910 , require

1011 , requireAll

1112 , cached

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

1718import Control.Monad.Reader (ask)

1819import Control.Monad.Trans (liftIO)

1920import Control.Category (Category, (.))

21+import Data.Maybe (fromMaybe)

2022

2123import Data.Binary (Binary)

2224import Data.Typeable (Typeable)

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

4850 provider <- compilerResourceProvider <$> ask

4951 liftIO $ resourceString provider id'

5052

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+

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

5276-- dependencies

5377--

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

5882require identifier f =

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

6084 where

61− require' x = CompilerM $ do

62− lookup' <- compilerDependencyLookup <$> ask

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

85+ require' x = do

86+ y <- getDependencyOrResult identifier

87+ return $ f x y

6488

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

6690-- of dependencies

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

7599 getDeps = matches pattern . resourceList

76100 requireAll' x = CompilerM $ do

77101 deps <- getDeps . compilerResourceProvider <$> ask

78− lookup' <- compilerDependencyLookup <$> ask

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

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

103+ return $ f x items

80104

81105cached :: (Binary a)

82106 => String

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

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

3232

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

3434--

35−type DependencyLookup = Identifier -> CompiledItem

35+type DependencyLookup = Identifier -> Maybe CompiledItem

3636

3737-- | Environment in which a compiler runs

3838--

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

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

77 ( filterObsolete

88 ) where

10+import Data.Set (Set)

1011import qualified Data.Set as S

1112

1213import Hakyll.Core.DirectedGraph

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

1617-- contains these items

1718--

1819filterObsolete :: Ord a

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

20+ => Set a -- ^ Obsolete items

2021 -> DirectedGraph a -- ^ Dependency graph

2122 -> DirectedGraph a -- ^ Resulting dependency graph

2223filterObsolete obsolete graph =

2324 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

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

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

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

33module Hakyll.Core.Run where

55import Control.Arrow ((&&&))

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

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

7+import Data.Map (Map)

78import qualified Data.Map as M

89import Data.Monoid (mempty)

910import Data.Typeable (Typeable)

1011import Data.Binary (Binary)

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

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

14+import Data.Set (Set)

15+import qualified Data.Set as S

1316

1417import Hakyll.Core.Route

1518import Hakyll.Core.Identifier

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

2225import Hakyll.Core.DirectedGraph

2326import Hakyll.Core.DirectedGraph.Dot

2427import Hakyll.Core.DirectedGraph.DependencySolver

28+import Hakyll.Core.DirectedGraph.ObsoleteFilter

2529import Hakyll.Core.Writable

2630import Hakyll.Core.Store

2731import Hakyll.Core.CompiledItem

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

4852 -- Create a compiler map

4953 compilerMap = M.fromList compilers

5054

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

55+ -- Create the graph

5256 graph = fromList dependencies

53− ordered = solveDependencies graph

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

71+ ordered = solveDependencies reducedGraph

5472

5573 -- Join the order with the compilers again

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

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

5876 -- Fetch the routes

5977 route' = rulesRoute ruleSet

6078

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

62− writeDot "dependencies.dot" show graph

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)

79+ putStrLn $ show reducedGraph

80+ putStrLn $ show ordered

7081

7182 -- Generate all the targets in order

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

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

7384

7485 putStrLn "DONE."

7586 where

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

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

7788 let url = runRoute route' id'

7889

7990 -- Check if the resource was modified

80− let modified = modifiedMap M.! id'

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

8192

8293 -- Run the compiler

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

84− url store modified

95+ url store isModified

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

8697

8798 case url of

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

92103 makeDirectories path

93104 write path compiled

94105

106+ -- Store it in the cache

107+ storeResult store id' compiled

108+

95109 putStrLn ""

96110 return $ M.insert id' compiled map'

97111

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

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

100− Just d -> d

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

113+

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