d093910 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Metacompilers now work, todo: cleanup

d093910Jasper Van der Jeugt16 years ago

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

compare with master

unifiedsplit

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

7 , getIdentifier

8 , getRoute

9 , getResourceString

10− , waitFor

10+ , fromDependency

11 , require

12 , requireAll

13 , cached

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

92 ++ show identifier

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

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

96−--

97−waitFor :: Identifier -> Compiler a a

98−waitFor = fromDependencies . const . return

99−

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

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

101-- dependencies

96-- dependencies

102--

97--

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

105 -> (b -> a -> c)

100 -> (b -> a -> c)

106 -> Compiler b c

101 -> Compiler b c

107require identifier f =

102require identifier f =

108− waitFor identifier >>> fromJob require'

103+ fromDependency identifier >>> fromJob require'

109 where

104 where

110 require' x = do

105 require' x = do

111 y <- getDependency identifier

106 y <- getDependency identifier

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

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

10 , runCompilerDependencies

11 , fromJob

12 , fromDependencies

13+ , fromDependency

13 ) where

14 ) where

15import Prelude hiding ((.), id)

16import Prelude hiding ((.), id)

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

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

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

102 -> Compiler b b

103 -> Compiler b b

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

104fromDependencies 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

7 , nodes

8 , neighbours

9 , reverse

10− , filter

11 , reachableNodes

10 , reachableNodes

12 ) where

11 ) where

14−import Prelude hiding (reverse, filter)

13+import Prelude hiding (reverse)

15import Data.Monoid (mconcat)

14import Data.Monoid (mconcat)

16import Data.Set (Set)

15import Data.Set (Set)

17import Data.Maybe (fromMaybe)

16import Data.Maybe (fromMaybe)

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

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

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

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

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

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

57--

56--

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

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

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

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

69 where

59 where

70 reachable next visited

60 reachable next visited

71 | S.null next = visited

61 | S.null next = visited

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

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

73 where

63 where

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

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

65+ neighbours' = setNeighbours (sanitize next)

66+

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

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

76− $ S.toList $ sanitize next

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)

117 -> Rules

118 -- ^ Resulting rules

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

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

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

121 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 @@

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4module Hakyll.Core.Run where

6+import Prelude hiding (reverse)

6import Control.Applicative

7import Control.Applicative

7import Control.Monad.Reader

8import Control.Monad.Reader

8import Control.Monad.State

9import Control.Monad.State

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

30import Hakyll.Core.DirectedGraph

31import Hakyll.Core.DirectedGraph

31import Hakyll.Core.DirectedGraph.Dot

32import Hakyll.Core.DirectedGraph.Dot

32import Hakyll.Core.DirectedGraph.DependencySolver

33import Hakyll.Core.DirectedGraph.DependencySolver

33−import Hakyll.Core.DirectedGraph.ObsoleteFilter

34import Hakyll.Core.Writable

35import Hakyll.Core.Store

36import Hakyll.Core.CompiledItem

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

49 , hakyllResourceProvider = provider

50 , hakyllStore = store

51 , hakyllModified = S.empty

52+ , hakyllObsolete = S.empty

52 }

53 }

54data HakyllEnvironment = HakyllEnvironment

55data HakyllEnvironment = HakyllEnvironment

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

56 , hakyllResourceProvider :: ResourceProvider

57 , hakyllResourceProvider :: ResourceProvider

57 , hakyllStore :: Store

58 , hakyllStore :: Store

58 , hakyllModified :: Set Identifier

59 , hakyllModified :: Set Identifier

60+ , hakyllObsolete :: Set Identifier

59 }

61 }

61newtype Hakyll a = Hakyll

63newtype Hakyll a = Hakyll

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

98 -- Create the dependency graph

100 -- Create the dependency graph

99 graph = fromList dependencies

101 graph = fromList dependencies

100

102

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

104+

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

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

102 -- compilers

106 -- compilers

103 oldModified <- hakyllModified <$> ask

107 oldModified <- hakyllModified <$> ask

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

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

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

109+ oldObsolete <- hakyllObsolete <$> ask

106

110

107− liftIO $ putStrLn $ show modified'

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

108−

112+

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

113+ -- Find obsolete items

110− reducedGraph = filterObsolete modified' graph

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

115+ reverse graph

111

116

112− let -- Solve the graph

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

113− ordered = solveDependencies reducedGraph

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

114

119

115 -- Join the order with the compilers again

120 -- Join the order with the compilers again

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

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

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

118 liftIO $ putStrLn "Adding compilers..."

123 liftIO $ putStrLn "Adding compilers..."

119

124

120 -- Now run the ordered list of compilers

125 -- Now run the ordered list of compilers

126+ local (updateEnv modified' obsolete) $

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

127+ unHakyll $ runCompilers orderedCompilers

122 where

128 where

123 -- Add the modified information for the new compilers

129 -- Add the modified information for the new compilers

124− updateModified modified' env = env

130+ updateEnv modified' obsolete env = env

125 { hakyllModified = modified'

131 { hakyllModified = modified'

132+ , hakyllObsolete = obsolete

126 }

133 }

127

134

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

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