901b672 · hakyll · git.iko.soy

git.iko.soy/hakyll

Play with dependency analyzer

commit901b672107ef681830f7c9013bba444eb6c90d84 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateWed 6 Apr 2011, 14:40 (16 years ago) parent80596b1

4 files changed+28−94

compare with master

unifiedsplit

hakyll.cabal−1 src/Hakyll/Core/DirectedGraph/DependencySolver.hs−70 src/Hakyll/Core/Resource/Provider.hs+5−5 src/Hakyll/Core/Run.hs+23−18

hakyll.cabal−1

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

100100 Hakyll.Core.Writable.WritableTuple

101101 Hakyll.Core.Identifier

102102 Hakyll.Core.DirectedGraph.Dot

103− Hakyll.Core.DirectedGraph.DependencySolver

104103 Hakyll.Core.DirectedGraph

105104 Hakyll.Core.Rules

106105 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

5656

5757-- | Check if a resource was modified

5858--

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

60−resourceModified provider resource store = do

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

60+resourceModified provider store resource = do

6161 cache <- readMVar mvar

6262 case M.lookup resource cache of

6363 -- Already in the cache

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

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

6666 Nothing -> do

6767 m <- if resourceExists provider (unResource resource)

68− then digestModified provider resource store

68+ then digestModified provider store resource

6969 else return False

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

7171 return m

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

7474

7575-- | Check if a resource digest was modified

7676--

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

78−digestModified provider resource store = do

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

78+digestModified provider store resource = do

7979 -- Get the latest seen digest from the store

8080 lastDigest <- storeGet store itemName $ unResource resource

8181 -- Calculate the digest for the resource

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

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

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

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

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

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

1514import Data.Map (Map)

1615import qualified Data.Map as M

1716import Data.Monoid (mempty, mappend)

1817import Data.Maybe (fromMaybe)

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

20−import Data.Set (Set)

2119import qualified Data.Set as S

2220

2321import Hakyll.Core.Routes

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

3129import Hakyll.Core.Rules.Internal

3230import Hakyll.Core.DirectedGraph

3331import Hakyll.Core.DirectedGraph.Dot

34−import Hakyll.Core.DirectedGraph.DependencySolver

3532import Hakyll.Core.DependencyAnalyzer

3633import Hakyll.Core.Writable

3734import Hakyll.Core.Store

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

6562 , hakyllRoutes = rulesRoutes ruleSet

6663 , hakyllResourceProvider = provider

6764 , hakyllStore = store

68− , hakyllOldGraph = oldGraph

6965 }

7066

7167 -- Run the program and fetch the resulting state

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

7369 { hakyllAnalyzer = makeDependencyAnalyzer mempty (const False) oldGraph

7470 , hakyllCompilers = M.empty

75− , hakyllModified = S.empty

7671 }

7772

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

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

8984 , hakyllRoutes :: Routes

9085 , hakyllResourceProvider :: ResourceProvider

9186 , hakyllStore :: Store

92− , hakyllOldGraph :: DirectedGraph Identifier

9387 }

9488

9589data RuntimeState = RuntimeState

9690 { hakyllAnalyzer :: DependencyAnalyzer Identifier

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

98− , hakyllModified :: Set Identifier

9992 }

10093

10194newtype Runtime a = Runtime

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

10497

10598-- | Return a set of modified identifiers

10699--

100+{-

107101modified :: ResourceProvider -- ^ Resource provider

108102 -> Store -- ^ Store

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

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

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

112106 resourceModified provider (Resource id') store

107+-}

113108

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

115110--

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

126121 -- Old state information

127122 oldCompilers <- hakyllCompilers <$> get

128123 oldAnalyzer <- hakyllAnalyzer <$> get

129− oldModified <- hakyllModified <$> get

130124

131125 let -- Create a new partial dependency graph

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

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

137131 newGraph = fromList dependencies

138132

139133 -- Check which items have been modified

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

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

135+ liftIO . resourceModified provider store . Resource

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

141137

142138 -- 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

145141 analyzer = mappend oldAnalyzer newAnalyzer

146142

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+

147154 -- Update the state

148155 put $ RuntimeState

149156 { hakyllAnalyzer = analyzer

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

151− , hakyllModified = S.union oldModified newModified

152158 }

153159

154160 -- Continue

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

162168 put $ state { hakyllAnalyzer = analyzer' }

163169

164170 case signal of Done -> return ()

165− Cycle c -> return ()

171+ Cycle _ -> return ()

166172 Build id' -> unRuntime $ build id'

167173

168174build :: Identifier -> Runtime ()

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

171177 routes <- hakyllRoutes <$> ask

172178 provider <- hakyllResourceProvider <$> ask

173179 store <- hakyllStore <$> ask

174− modified' <- hakyllModified <$> get

175180 compilers <- hakyllCompilers <$> get

176181

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

178183

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

180− compiler = compilers M.! id'

184+ -- Fetch the right compiler from the map

185+ let compiler = compilers M.! id'

181186

182− -- Check if the resource was modified

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

187+ -- Check if the resource was modified

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

184189

185190 -- Run the compiler

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