d093910 · hakyll · git.iko.soy

git.iko.soy/hakyll

Metacompilers now work, todo: cleanup

commitd0939102bf26ed81b4e57dc96f44e5330913ab6f authorJasper Van der Jeugt <jaspervdj@gmail.com> dateFri 7 Jan 2011, 19:17 (16 years ago) parentddb8ea2

6 files changed+35−62

compare with master

unifiedsplit

src/Hakyll/Core/Compiler.hs+2−7 src/Hakyll/Core/Compiler/Internal.hs+6 src/Hakyll/Core/DirectedGraph.hs+7−16 src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs−27 src/Hakyll/Core/Rules.hs+3−2 src/Hakyll/Core/Run.hs+17−10

src/Hakyll/Core/Compiler.hs+2−7

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

77 , getIdentifier

88 , getRoute

99 , getResourceString

10− , waitFor

10+ , fromDependency

1111 , require

1212 , requireAll

1313 , cached

@@ -92,11 +92,6 @@ getDependency identifier = CompilerM $ do

9292 ++ show identifier

9393 ++ " not found in the cache, the cache might be corrupted"

9494

95−-- | Wait until another compiler has finished before running this compiler

96−--

97−waitFor :: Identifier -> Compiler a a

98−waitFor = fromDependencies . const . return

99−

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

10196-- dependencies

10297--

@@ -105,7 +100,7 @@ require :: (Binary a, Typeable a, Writable a)

105100 -> (b -> a -> c)

106101 -> Compiler b c

107102require identifier f =

108− waitFor identifier >>> fromJob require'

103+ fromDependency identifier >>> fromJob require'

109104 where

110105 require' x = do

111106 y <- getDependency identifier

src/Hakyll/Core/Compiler/Internal.hs+6

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

1010 , runCompilerDependencies

1111 , fromJob

1212 , fromDependencies

13+ , fromDependency

1314 ) where

1415

1516import Prelude hiding ((.), id)

@@ -101,3 +102,8 @@ fromJob = Compiler (return S.empty)

101102fromDependencies :: (ResourceProvider -> [Identifier])

102103 -> Compiler b b

103104fromDependencies deps = Compiler (S.fromList . deps <$> ask) return

105+

106+-- | Wait until another compiler has finished before running this compiler

107+--

108+fromDependency :: Identifier -> Compiler a a

109+fromDependency = fromDependencies . const . return

src/Hakyll/Core/DirectedGraph.hs+7−16

@@ -7,11 +7,10 @@ module Hakyll.Core.DirectedGraph

77 , nodes

88 , neighbours

99 , reverse

10− , filter

1110 , reachableNodes

1211 ) where

1312

14−import Prelude hiding (reverse, filter)

13+import Prelude hiding (reverse)

1514import Data.Monoid (mconcat)

1615import Data.Set (Set)

1716import Data.Maybe (fromMaybe)

@@ -53,24 +52,16 @@ reverse = mconcat . map reverse' . M.toList . unDirectedGraph

5352 reverse' (id', Node _ neighbours') = fromList $

5453 zip (S.toList neighbours') $ repeat $ S.singleton id'

5554

56−-- | Filter a directed graph (i.e. remove nodes based on a predicate)

55+-- | Find all reachable nodes from a given set of nodes in the directed graph

5756--

58−filter :: Ord a

59− => (a -> Bool) -- ^ Predicate

60− -> DirectedGraph a -- ^ Graph

61− -> DirectedGraph a -- ^ Resulting graph

62−filter predicate =

63− DirectedGraph . M.filterWithKey (\k _ -> predicate k) . unDirectedGraph

64−

65−-- | Find all reachable nodes from a given node in the directed graph

66−--

67−reachableNodes :: Ord a => a -> DirectedGraph a -> Set a

68−reachableNodes x graph = reachable (neighbours x graph) (S.singleton x)

57+reachableNodes :: Ord a => Set a -> DirectedGraph a -> Set a

58+reachableNodes set graph = reachable (setNeighbours set) set

6959 where

7060 reachable next visited

7161 | S.null next = visited

7262 | otherwise = reachable (sanitize neighbours') (next `S.union` visited)

7363 where

7464 sanitize = S.filter (`S.notMember` visited)

75− neighbours' = S.unions $ map (flip neighbours graph)

76− $ S.toList $ sanitize next

65+ neighbours' = setNeighbours (sanitize next)

66+

67+ setNeighbours = S.unions . map (flip neighbours graph) . S.toList

src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hsdeleted−27

@@ -1,27 +0,0 @@

1−-- | Module exporting a function that works as a filter on a dependency graph.

2−-- Given a list of obsolete nodes, this filter will reduce the graph so it only

3−-- contains obsolete nodes and nodes that depend (directly or indirectly) on

4−-- obsolete nodes.

5−--

6−module Hakyll.Core.DirectedGraph.ObsoleteFilter

7− ( filterObsolete

8− ) where

9−

10−import Data.Set (Set)

11−import qualified Data.Set as S

12−

13−import Hakyll.Core.DirectedGraph

14−import qualified Hakyll.Core.DirectedGraph as DG

15−

16−-- | Given a list of obsolete items, filter the dependency graph so it only

17−-- contains these items

18−--

19−filterObsolete :: Ord a

20− => Set a -- ^ Obsolete items

21− -> DirectedGraph a -- ^ Dependency graph

22− -> DirectedGraph a -- ^ Resulting dependency graph

23−filterObsolete obsolete graph =

24− let reversed = DG.reverse graph

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

26− $ S.toList obsolete

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

src/Hakyll/Core/Rules.hs+3−2

@@ -117,6 +117,7 @@ addCompilers :: (Binary a, Typeable a, Writable a)

117117 -> Rules

118118 -- ^ Resulting rules

119119addCompilers identifier compiler = RulesM $ tell $ RuleSet mempty $

120− [(identifier, compiler >>^ makeRule)]

120+ [(identifier, compiler >>> arr makeRule )]

121121 where

122− makeRule = MetaCompileRule . map (second (>>^ CompileRule . compiledItem))

122+ makeRule = MetaCompileRule . map (second box)

123+ box = (>>> fromDependency identifier >>^ CompileRule . compiledItem)

src/Hakyll/Core/Run.hs+17−10

@@ -3,6 +3,7 @@

33{-# LANGUAGE GeneralizedNewtypeDeriving #-}

44module Hakyll.Core.Run where

6+import Prelude hiding (reverse)

67import Control.Applicative

78import Control.Monad.Reader

89import Control.Monad.State

@@ -30,7 +31,6 @@ import Hakyll.Core.Rules

3031import Hakyll.Core.DirectedGraph

3132import Hakyll.Core.DirectedGraph.Dot

3233import Hakyll.Core.DirectedGraph.DependencySolver

33−import Hakyll.Core.DirectedGraph.ObsoleteFilter

3434import Hakyll.Core.Writable

3535import Hakyll.Core.Store

3636import Hakyll.Core.CompiledItem

@@ -49,6 +49,7 @@ hakyll rules = do

4949 , hakyllResourceProvider = provider

5050 , hakyllStore = store

5151 , hakyllModified = S.empty

52+ , hakyllObsolete = S.empty

5253 }

5354

5455data HakyllEnvironment = HakyllEnvironment

@@ -56,6 +57,7 @@ data HakyllEnvironment = HakyllEnvironment

5657 , hakyllResourceProvider :: ResourceProvider

5758 , hakyllStore :: Store

5859 , hakyllModified :: Set Identifier

60+ , hakyllObsolete :: Set Identifier

5961 }

6062

6163newtype Hakyll a = Hakyll

@@ -98,19 +100,22 @@ addNewCompilers oldCompilers newCompilers = Hakyll $ do

98100 -- Create the dependency graph

99101 graph = fromList dependencies

100102

103+ liftIO $ writeDot "dependencies.dot" show graph

104+

101105 -- Check which items are up-to-date. This only needs to happen for the new

102106 -- compilers

103107 oldModified <- hakyllModified <$> ask

104108 newModified <- liftIO $ modified provider store $ map fst newCompilers

105− let modified' = oldModified `S.union` newModified

109+ oldObsolete <- hakyllObsolete <$> ask

106110

107− liftIO $ putStrLn $ show modified'

108−

109− let -- Try to reduce the graph using this modified information

110− reducedGraph = filterObsolete modified' graph

111+ let modified' = oldModified `S.union` newModified

112+

113+ -- Find obsolete items

114+ obsolete = reachableNodes (oldObsolete `S.union` modified') $

115+ reverse graph

111116

112− let -- Solve the graph

113− ordered = solveDependencies reducedGraph

117+ -- Solve the graph, retain only the obsolete items

118+ ordered = filter (`S.member` obsolete) $ solveDependencies graph

114119

115120 -- Join the order with the compilers again

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

@@ -118,11 +123,13 @@ addNewCompilers oldCompilers newCompilers = Hakyll $ do

118123 liftIO $ putStrLn "Adding compilers..."

119124

120125 -- Now run the ordered list of compilers

121− local (updateModified modified') $ unHakyll $ runCompilers orderedCompilers

126+ local (updateEnv modified' obsolete) $

127+ unHakyll $ runCompilers orderedCompilers

122128 where

123129 -- Add the modified information for the new compilers

124− updateModified modified' env = env

130+ updateEnv modified' obsolete env = env

125131 { hakyllModified = modified'

132+ , hakyllObsolete = obsolete

126133 }

127134

128135runCompilers :: [(Identifier, Compiler () CompileRule)]