901b672 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Play with dependency analyzer

901b672Jasper Van der Jeugt16 years ago

hakyll.cabal−1

compare with master

unifiedsplit

@@ -100,7 +100,6 @@ library

100 Hakyll.Core.Writable.WritableTuple

101 Hakyll.Core.Identifier

102 Hakyll.Core.DirectedGraph.Dot

103− Hakyll.Core.DirectedGraph.DependencySolver

104 Hakyll.Core.DirectedGraph

103 Hakyll.Core.DirectedGraph

105 Hakyll.Core.Rules

104 Hakyll.Core.Rules

106 Hakyll.Core.Routes

105 Hakyll.Core.Routes

src/Hakyll/Core/DirectedGraph/DependencySolver.hsdeleted−70

@@ -1,70 +0,0 @@

1−-- | Given a dependency graph, this module provides a function that will

2−-- generate an order in which the graph can be visited, so that all the

3−-- dependencies of a given node have been visited before the node itself is

4−-- visited.

5−--

6−module Hakyll.Core.DirectedGraph.DependencySolver

7− ( solveDependencies

8− ) where

9−

10−import Prelude

11−import qualified Prelude as P

12−import Data.Set (Set)

13−import Data.Maybe (mapMaybe)

14−import qualified Data.Map as M

15−import qualified Data.Set as S

16−

17−import Hakyll.Core.DirectedGraph

18−import Hakyll.Core.DirectedGraph.Internal

19−

20−-- | Solve a dependency graph. This function returns an order to run the

21−-- different nodes

22−--

23−solveDependencies :: Ord a

24− => DirectedGraph a -- ^ Graph

25− -> [a] -- ^ Resulting plan

26−solveDependencies = P.reverse . order [] [] S.empty

27−

28−-- | Produce a reversed order using a stack

29−--

30−order :: Ord a

31− => [a] -- ^ Temporary result

32− -> [Node a] -- ^ Backtrace stack

33− -> Set a -- ^ Items in the stack

34− -> DirectedGraph a -- ^ Graph

35− -> [a] -- ^ Ordered result

36−order temp stack set graph@(DirectedGraph graph')

37− -- Empty graph - return our current result

38− | M.null graph' = temp

39− | otherwise = case stack of

40−

41− -- Empty stack - pick a node, and add it to the stack

42− [] ->

43− let (tag, node) = M.findMin graph'

44− in order temp (node : stack) (S.insert tag set) graph

45−

46− -- At least one item on the stack - continue using this item

47− (node : stackTail) ->

48− -- Check which dependencies are still in the graph

49− let tag = nodeTag node

50− deps = S.toList $ nodeNeighbours node

51− unsatisfied = mapMaybe (`M.lookup` graph') deps

52− in case unsatisfied of

53−

54− -- All dependencies for node are satisfied, we can return it and

55− -- remove it from the graph

56− [] -> order (tag : temp) stackTail (S.delete tag set)

57− (DirectedGraph $ M.delete tag graph')

58−

59− -- There is at least one dependency left. We need to solve that

60− -- one first...

61− (dep : _) -> if nodeTag dep `S.member` set

62− -- The dependency is already in our stack - cycle detected!

63− then cycleError

64− -- Continue with the dependency

65− else order temp (dep : node : stackTail)

66− (S.insert (nodeTag dep) set)

67− graph

68− where

69− cycleError = error $ "Hakyll.Core.DirectedGraph.DependencySolver.order: "

70− ++ "Cycle detected!" -- TODO: Dump cycle

src/Hakyll/Core/Resource/Provider.hs+5−5

@@ -56,8 +56,8 @@ resourceDigest provider = digest MD5 <=< resourceLazyByteString provider

57-- | Check if a resource was modified

58--

59−resourceModified :: ResourceProvider -> Resource -> Store -> IO Bool

59+resourceModified :: ResourceProvider -> Store -> Resource -> IO Bool

60−resourceModified provider resource store = do

60+resourceModified provider store resource = do

61 cache <- readMVar mvar

62 case M.lookup resource cache of

63 -- Already in the cache

@@ -65,7 +65,7 @@ resourceModified provider resource store = do

65 -- Not yet in the cache, check digests (if it exists)

66 Nothing -> do

67 m <- if resourceExists provider (unResource resource)

68− then digestModified provider resource store

68+ then digestModified provider store resource

69 else return False

70 modifyMVar_ mvar (return . M.insert resource m)

71 return m

@@ -74,8 +74,8 @@ resourceModified provider resource store = do

75-- | Check if a resource digest was modified

76--

77−digestModified :: ResourceProvider -> Resource -> Store -> IO Bool

77+digestModified :: ResourceProvider -> Store -> Resource -> IO Bool

78−digestModified provider resource store = do

78+digestModified provider store resource = do

79 -- Get the latest seen digest from the store

80 lastDigest <- storeGet store itemName $ unResource resource

81 -- Calculate the digest for the resource

src/Hakyll/Core/Run.hs+23−18

@@ -11,13 +11,11 @@ import Control.Monad.Trans (liftIO)

11import Control.Applicative (Applicative, (<$>))

12import Control.Monad.Reader (ReaderT, runReaderT, ask)

13import Control.Monad.State.Strict (StateT, runStateT, get, put)

14−import Control.Arrow ((&&&))

15import Data.Map (Map)

14import Data.Map (Map)

16import qualified Data.Map as M

15import qualified Data.Map as M

17import Data.Monoid (mempty, mappend)

16import Data.Monoid (mempty, mappend)

18import Data.Maybe (fromMaybe)

17import Data.Maybe (fromMaybe)

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

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

20−import Data.Set (Set)

21import qualified Data.Set as S

19import qualified Data.Set as S

23import Hakyll.Core.Routes

21import Hakyll.Core.Routes

@@ -31,7 +29,6 @@ import Hakyll.Core.Resource.Provider.File

31import Hakyll.Core.Rules.Internal

29import Hakyll.Core.Rules.Internal

32import Hakyll.Core.DirectedGraph

30import Hakyll.Core.DirectedGraph

33import Hakyll.Core.DirectedGraph.Dot

31import Hakyll.Core.DirectedGraph.Dot

34−import Hakyll.Core.DirectedGraph.DependencySolver

35import Hakyll.Core.DependencyAnalyzer

32import Hakyll.Core.DependencyAnalyzer

36import Hakyll.Core.Writable

33import Hakyll.Core.Writable

37import Hakyll.Core.Store

34import Hakyll.Core.Store

@@ -65,14 +62,12 @@ run configuration rules = do

65 , hakyllRoutes = rulesRoutes ruleSet

62 , hakyllRoutes = rulesRoutes ruleSet

66 , hakyllResourceProvider = provider

63 , hakyllResourceProvider = provider

67 , hakyllStore = store

64 , hakyllStore = store

68− , hakyllOldGraph = oldGraph

69 }

65 }

71 -- Run the program and fetch the resulting state

67 -- Run the program and fetch the resulting state

72 ((), state') <- runStateT stateT $ RuntimeState

68 ((), state') <- runStateT stateT $ RuntimeState

73 { hakyllAnalyzer = makeDependencyAnalyzer mempty (const False) oldGraph

69 { hakyllAnalyzer = makeDependencyAnalyzer mempty (const False) oldGraph

74 , hakyllCompilers = M.empty

70 , hakyllCompilers = M.empty

75− , hakyllModified = S.empty

76 }

71 }

78 -- We want to save the final dependency graph for the next run

73 -- We want to save the final dependency graph for the next run

@@ -89,13 +84,11 @@ data RuntimeEnvironment = RuntimeEnvironment

89 , hakyllRoutes :: Routes

84 , hakyllRoutes :: Routes

90 , hakyllResourceProvider :: ResourceProvider

85 , hakyllResourceProvider :: ResourceProvider

91 , hakyllStore :: Store

86 , hakyllStore :: Store

92− , hakyllOldGraph :: DirectedGraph Identifier

93 }

87 }

95data RuntimeState = RuntimeState

89data RuntimeState = RuntimeState

96 { hakyllAnalyzer :: DependencyAnalyzer Identifier

90 { hakyllAnalyzer :: DependencyAnalyzer Identifier

97 , hakyllCompilers :: Map Identifier (Compiler () CompileRule)

91 , hakyllCompilers :: Map Identifier (Compiler () CompileRule)

98− , hakyllModified :: Set Identifier

99 }

92 }

100

101newtype Runtime a = Runtime

94newtype Runtime a = Runtime

@@ -104,12 +97,14 @@ newtype Runtime a = Runtime

104

105-- | Return a set of modified identifiers

98-- | Return a set of modified identifiers

106--

99--

100+{-

107modified :: ResourceProvider -- ^ Resource provider

101modified :: ResourceProvider -- ^ Resource provider

108 -> Store -- ^ Store

102 -> Store -- ^ Store

109 -> [Identifier] -- ^ Identifiers to check

103 -> [Identifier] -- ^ Identifiers to check

110 -> IO (Set Identifier) -- ^ Modified resources

104 -> IO (Set Identifier) -- ^ Modified resources

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

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

112 resourceModified provider (Resource id') store

106 resourceModified provider (Resource id') store

107+-}

113

108

114-- | Add a number of compilers and continue using these compilers

109-- | Add a number of compilers and continue using these compilers

115--

110--

@@ -126,7 +121,6 @@ addNewCompilers newCompilers = Runtime $ do

126 -- Old state information

121 -- Old state information

127 oldCompilers <- hakyllCompilers <$> get

122 oldCompilers <- hakyllCompilers <$> get

128 oldAnalyzer <- hakyllAnalyzer <$> get

123 oldAnalyzer <- hakyllAnalyzer <$> get

129− oldModified <- hakyllModified <$> get

130

124

131 let -- Create a new partial dependency graph

125 let -- Create a new partial dependency graph

132 dependencies = flip map newCompilers $ \(id', compiler) ->

126 dependencies = flip map newCompilers $ \(id', compiler) ->

@@ -137,18 +131,30 @@ addNewCompilers newCompilers = Runtime $ do

137 newGraph = fromList dependencies

131 newGraph = fromList dependencies

138

132

139 -- Check which items have been modified

133 -- Check which items have been modified

134+ modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $

135+ liftIO . resourceModified provider store . Resource

140− newModified <- liftIO $ modified provider store $ map fst newCompilers

136+ -- newModified <- liftIO $ modified provider store $ map fst newCompilers

141

137

142 -- Create a new analyzer and append it to the currect one

138 -- Create a new analyzer and append it to the currect one

143− let newAnalyzer =

144− makeDependencyAnalyzer newGraph (`S.member` newModified) mempty

139+ let newAnalyzer = makeDependencyAnalyzer newGraph (`S.member` modified) $

140+ analyzerPreviousGraph oldAnalyzer

145 analyzer = mappend oldAnalyzer newAnalyzer

141 analyzer = mappend oldAnalyzer newAnalyzer

146

142

143+ -- Debugging

144+ liftIO $ putStrLn $ "Remains: " ++ show (analyzerRemains newAnalyzer)

145+ liftIO $ putStrLn $ "Done: " ++ show (analyzerDone newAnalyzer)

146+ liftIO $ writeFile "old-prev.dot" $ toDot show (analyzerPreviousGraph oldAnalyzer)

147+ liftIO $ writeFile "old.dot" $ toDot show (analyzerGraph oldAnalyzer)

148+ liftIO $ writeFile "old-prev.dot" $ toDot show (analyzerPreviousGraph oldAnalyzer)

149+ liftIO $ writeFile "new.dot" $ toDot show (analyzerGraph newAnalyzer)

150+ liftIO $ writeFile "new-prev.dot" $ toDot show (analyzerPreviousGraph newAnalyzer)

151+ liftIO $ writeFile "result.dot" $ toDot show (analyzerGraph analyzer)

152+ liftIO $ writeFile "result-prev.dot" $ toDot show (analyzerPreviousGraph analyzer)

153+

147 -- Update the state

154 -- Update the state

148 put $ RuntimeState

155 put $ RuntimeState

149 { hakyllAnalyzer = analyzer

156 { hakyllAnalyzer = analyzer

150 , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)

157 , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)

151− , hakyllModified = S.union oldModified newModified

152 }

158 }

153

159

154 -- Continue

160 -- Continue

@@ -162,7 +168,7 @@ stepAnalyzer = Runtime $ do

162 put $ state { hakyllAnalyzer = analyzer' }

168 put $ state { hakyllAnalyzer = analyzer' }

163

169

164 case signal of Done -> return ()

170 case signal of Done -> return ()

165− Cycle c -> return ()

171+ Cycle _ -> return ()

166 Build id' -> unRuntime $ build id'

172 Build id' -> unRuntime $ build id'

167

173

168build :: Identifier -> Runtime ()

174build :: Identifier -> Runtime ()

@@ -171,16 +177,15 @@ build id' = Runtime $ do

171 routes <- hakyllRoutes <$> ask

177 routes <- hakyllRoutes <$> ask

172 provider <- hakyllResourceProvider <$> ask

178 provider <- hakyllResourceProvider <$> ask

173 store <- hakyllStore <$> ask

179 store <- hakyllStore <$> ask

174− modified' <- hakyllModified <$> get

175 compilers <- hakyllCompilers <$> get

180 compilers <- hakyllCompilers <$> get

176

181

177 section logger $ "Compiling " ++ show id'

182 section logger $ "Compiling " ++ show id'

178

183

179− let -- Fetch the right compiler from the map

184+ -- Fetch the right compiler from the map

180− compiler = compilers M.! id'

185+ let compiler = compilers M.! id'

181

186

182− -- Check if the resource was modified

187+ -- Check if the resource was modified

183− isModified = id' `S.member` modified'

188+ isModified <- liftIO $ resourceModified provider store (Resource id')

184

189

185 -- Run the compiler

190 -- Run the compiler

186 result <- timed logger "Total compile time" $ liftIO $

191 result <- timed logger "Total compile time" $ liftIO $