b37da38 · hakyll · git.iko.soy

git.iko.soy/hakyll

Major refactoring of identifiers/resources/groups

commitb37da38d3911bbc8381a39fe526e69599d9ddcf1 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateTue 12 Apr 2011, 10:09 (16 years ago) parent0a3cd37

11 files changed+88−63

compare with master

unifiedsplit

src-inotify/Hakyll/Web/Preview/Poll.hs+1−2 src-interval/Hakyll/Web/Preview/Poll.hs+1−2 src/Hakyll/Core/Compiler.hs+9−8 src/Hakyll/Core/Compiler/Internal.hs+16−12 src/Hakyll/Core/DirectedGraph/Dot.hs+4−2 src/Hakyll/Core/Resource.hs+13−3 src/Hakyll/Core/Resource/Provider.hs+6−6 src/Hakyll/Core/Resource/Provider/File.hs+4−5 src/Hakyll/Core/Rules.hs+3−3 src/Hakyll/Core/Run.hs+26−18 src/Hakyll/Core/Store.hs+5−2

src-inotify/Hakyll/Web/Preview/Poll.hs+1−2

@@ -14,7 +14,6 @@ import System.INotify

1414

1515import Hakyll.Core.Configuration

1616import Hakyll.Core.Resource

17−import Hakyll.Core.Identifier

1817

1918-- | Calls the given callback when the directory tree changes

2019--

@@ -27,7 +26,7 @@ previewPoll _ resources callback = do

2726 inotify <- initINotify

2827

2928 let -- A set of file paths

30− paths = S.map (toFilePath . unResource) resources

29+ paths = S.map unResource resources

3130

3231 -- A list of directories. Run it through a set so we have every

3332 -- directory only once.

src-interval/Hakyll/Web/Preview/Poll.hs+1−2

@@ -14,7 +14,6 @@ import qualified Data.Set as S

1414import System.Directory (getModificationTime, doesFileExist)

1515

1616import Hakyll.Core.Configuration

17−import Hakyll.Core.Identifier

1817import Hakyll.Core.Resource

1918

2019-- | A preview thread that periodically recompiles the site.

@@ -24,7 +23,7 @@ previewPoll :: HakyllConfiguration -- ^ Configuration

2423 -> IO () -- ^ Action called when something changes

2524 -> IO () -- ^ Can block forever

2625previewPoll _ resources callback = do

27− let files = map (toFilePath . unResource) $ S.toList resources

26+ let files = map unResource $ S.toList resources

2827 time <- getClockTime

2928 loop files time

3029 where

src/Hakyll/Core/Compiler.hs+9−8

@@ -138,15 +138,16 @@ import Hakyll.Core.Logger

138138runCompiler :: Compiler () CompileRule -- ^ Compiler to run

139139 -> Identifier -- ^ Target identifier

140140 -> ResourceProvider -- ^ Resource provider

141+ -> [Identifier] -- ^ Universe

141142 -> Routes -- ^ Route

142143 -> Store -- ^ Store

143144 -> Bool -- ^ Was the resource modified?

144145 -> Logger -- ^ Logger

145146 -> IO (Throwing CompileRule) -- ^ Resulting item

146−runCompiler compiler identifier provider routes store modified logger = do

147+runCompiler compiler id' provider universe routes store modified logger = do

147148 -- Run the compiler job

148− result <-

149− runCompilerJob compiler identifier provider routes store modified logger

149+ result <- runCompilerJob compiler id' provider universe

150+ routes store modified logger

150151

151152 -- Inspect the result

152153 case result of

@@ -154,7 +155,7 @@ runCompiler compiler identifier provider routes store modified logger = do

154155 -- before we return control. This makes sure the compiled item can later

155156 -- be accessed by e.g. require.

156157 Right (CompileRule (CompiledItem x)) ->

157− storeSet store "Hakyll.Core.Compiler.runCompiler" identifier x

158+ storeSet store "Hakyll.Core.Compiler.runCompiler" id' x

158159

159160 -- Otherwise, we do nothing here

160161 _ -> return ()

@@ -184,7 +185,7 @@ getResourceString :: Compiler Resource String

184185getResourceString = fromJob $ \resource -> CompilerM $ do

185186 let identifier = unResource resource

186187 provider <- compilerResourceProvider <$> ask

187− if resourceExists provider identifier

188+ if resourceExists provider resource

188189 then liftIO $ resourceString provider resource

189190 else throwError $ error' identifier

190191 where

@@ -238,9 +239,9 @@ requireAll_ :: (Binary a, Typeable a, Writable a)

238239 -> Compiler b [a]

239240requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'

240241 where

241− getDeps = filterMatches pattern . map unResource . resourceList

242+ getDeps = filterMatches pattern

242243 requireAll_' = const $ CompilerM $ do

243− deps <- getDeps . compilerResourceProvider <$> ask

244+ deps <- getDeps . compilerUniverse <$> ask

244245 mapM (unCompilerM . getDependency) deps

245246

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

@@ -271,7 +272,7 @@ cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do

271272 modified <- compilerResourceModified <$> ask

272273 report logger $ "Checking cache: " ++ if modified then "modified" else "OK"

273274 if modified

274− then do v <- unCompilerM $ j $ Resource identifier

275+ then do v <- unCompilerM $ j $ fromIdentifier identifier

275276 liftIO $ storeSet store name identifier v

276277 return v

277278 else do v <- liftIO $ storeGet store name identifier

src/Hakyll/Core/Compiler/Internal.hs+16−12

@@ -39,9 +39,9 @@ type Dependencies = Set Identifier

3939--

4040data DependencyEnvironment = DependencyEnvironment

4141 { -- | Target identifier

42− dependencyIdentifier :: Identifier

43− , -- | Resource provider

44− dependencyResourceProvider :: ResourceProvider

42+ dependencyIdentifier :: Identifier

43+ , -- | List of available identifiers we can depend upon

44+ dependencyUniverse :: [Identifier]

4545 }

4646

4747-- | Environment in which a compiler runs

@@ -51,6 +51,8 @@ data CompilerEnvironment = CompilerEnvironment

5151 compilerIdentifier :: Identifier

5252 , -- | Resource provider

5353 compilerResourceProvider :: ResourceProvider

54+ , -- | List of all known identifiers

55+ compilerUniverse :: [Identifier]

5456 , -- | Site routes

5557 compilerRoutes :: Routes

5658 , -- | Compiler store

@@ -107,17 +109,19 @@ instance ArrowChoice Compiler where

107109runCompilerJob :: Compiler () a -- ^ Compiler to run

108110 -> Identifier -- ^ Target identifier

109111 -> ResourceProvider -- ^ Resource provider

112+ -> [Identifier] -- ^ Universe

110113 -> Routes -- ^ Route

111114 -> Store -- ^ Store

112115 -> Bool -- ^ Was the resource modified?

113116 -> Logger -- ^ Logger

114117 -> IO (Throwing a) -- ^ Result

115−runCompilerJob compiler identifier provider route store modified logger =

118+runCompilerJob compiler id' provider universe route store modified logger =

116119 runReaderT (runErrorT $ unCompilerM $ compilerJob compiler ()) env

117120 where

118121 env = CompilerEnvironment

119− { compilerIdentifier = identifier

122+ { compilerIdentifier = id'

120123 , compilerResourceProvider = provider

124+ , compilerUniverse = universe

121125 , compilerRoutes = route

122126 , compilerStore = store

123127 , compilerResourceModified = modified

@@ -126,25 +130,25 @@ runCompilerJob compiler identifier provider route store modified logger =

126130

127131runCompilerDependencies :: Compiler () a

128132 -> Identifier

129− -> ResourceProvider

133+ -> [Identifier]

130134 -> Dependencies

131−runCompilerDependencies compiler identifier provider =

135+runCompilerDependencies compiler identifier universe =

132136 runReader (compilerDependencies compiler) env

133137 where

134138 env = DependencyEnvironment

135− { dependencyIdentifier = identifier

136− , dependencyResourceProvider = provider

139+ { dependencyIdentifier = identifier

140+ , dependencyUniverse = universe

137141 }

138142

139143fromJob :: (a -> CompilerM b)

140144 -> Compiler a b

141145fromJob = Compiler (return S.empty)

142146

143−fromDependencies :: (Identifier -> ResourceProvider -> [Identifier])

147+fromDependencies :: (Identifier -> [Identifier] -> [Identifier])

144148 -> Compiler b b

145149fromDependencies collectDeps = flip Compiler return $ do

146− DependencyEnvironment identifier provider <- ask

147− return $ S.fromList $ collectDeps identifier provider

150+ DependencyEnvironment identifier universe <- ask

151+ return $ S.fromList $ collectDeps identifier universe

148152

149153-- | Wait until another compiler has finished before running this compiler

150154--

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

@@ -16,11 +16,13 @@ toDot :: Ord a

1616 -> String -- ^ Resulting string

1717toDot showTag graph = unlines $ concat

1818 [ return "digraph dependencies {"

19− , concatMap showNode (S.toList $ nodes graph)

19+ , map showNode (S.toList $ nodes graph)

20+ , concatMap showEdges (S.toList $ nodes graph)

2021 , return "}"

2122 ]

2223 where

23− showNode node = map (showEdge node) $ S.toList $ neighbours node graph

24+ showNode node = " \"" ++ showTag node ++ "\";"

25+ showEdges node = map (showEdge node) $ S.toList $ neighbours node graph

2426 showEdge x y = " \"" ++ showTag x ++ "\" -> \"" ++ showTag y ++ "\";"

2527

2628-- | Write out the @.dot@ file to a given file path. See 'toDot' for more

src/Hakyll/Core/Resource.hs+13−3

@@ -2,13 +2,23 @@

22--

33module Hakyll.Core.Resource

44 ( Resource (..)

5+ , fromIdentifier

6+ , toIdentifier

57 ) where

79import Hakyll.Core.Identifier

810

911-- | A resource

1012--

11−-- Invariant: the resource specified by the given identifier must exist

12−--

13−newtype Resource = Resource {unResource :: Identifier}

13+newtype Resource = Resource {unResource :: String}

1414 deriving (Eq, Show, Ord)

15+

16+-- | Create a resource from an identifier

17+--

18+fromIdentifier :: Identifier -> Resource

19+fromIdentifier = Resource . toFilePath

20+

21+-- | Map the resource to an identifier. Note that the group will not be set!

22+--

23+toIdentifier :: Resource -> Identifier

24+toIdentifier = parseIdentifier . unResource

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

@@ -27,7 +27,6 @@ import qualified Data.ByteString.Lazy as LB

2727import OpenSSL.Digest.ByteString.Lazy (digest)

2828import OpenSSL.Digest (MessageDigest (MD5))

2929

30−import Hakyll.Core.Identifier

3130import Hakyll.Core.Store

3231import Hakyll.Core.Resource

3332

@@ -46,8 +45,8 @@ data ResourceProvider = ResourceProvider

4645

4746-- | Check if a given identifier has a resource

4847--

49−resourceExists :: ResourceProvider -> Identifier -> Bool

50−resourceExists provider = flip elem $ map unResource $ resourceList provider

48+resourceExists :: ResourceProvider -> Resource -> Bool

49+resourceExists provider = flip elem $ resourceList provider

5150

5251-- | Retrieve a digest for a given resource

5352--

@@ -64,7 +63,7 @@ resourceModified provider store resource = do

6463 Just m -> return m

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

6665 Nothing -> do

67− m <- if resourceExists provider (unResource resource)

66+ m <- if resourceExists provider resource

6867 then digestModified provider store resource

6968 else return False

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

@@ -77,7 +76,7 @@ resourceModified provider store resource = do

7776digestModified :: ResourceProvider -> Store -> Resource -> IO Bool

7877digestModified provider store resource = do

7978 -- Get the latest seen digest from the store

80− lastDigest <- storeGet store itemName $ unResource resource

79+ lastDigest <- storeGet store itemName identifier

8180 -- Calculate the digest for the resource

8281 newDigest <- resourceDigest provider resource

8382 -- Check digests

@@ -85,7 +84,8 @@ digestModified provider store resource = do

8584 -- All is fine, not modified

8685 then return False

8786 -- Resource modified; store new digest

88− else do storeSet store itemName (unResource resource) newDigest

87+ else do storeSet store itemName identifier newDigest

8988 return True

9089 where

90+ identifier = toIdentifier resource

9191 itemName = "Hakyll.Core.ResourceProvider.digestModified"

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

@@ -12,7 +12,6 @@ import qualified Data.ByteString.Lazy as LB

1212

1313import Hakyll.Core.Resource

1414import Hakyll.Core.Resource.Provider

15−import Hakyll.Core.Identifier

1615import Hakyll.Core.Util.File

1716import Hakyll.Core.Configuration

1817

@@ -20,8 +19,8 @@ import Hakyll.Core.Configuration

2019--

2120fileResourceProvider :: HakyllConfiguration -> IO ResourceProvider

2221fileResourceProvider configuration = do

23− -- Retrieve a list of identifiers

24− list <- map parseIdentifier . filter (not . ignoreFile configuration) <$>

22+ -- Retrieve a list of paths

23+ list <- filter (not . ignoreFile configuration) <$>

2524 getRecursiveContents False "."

2625

2726 -- MVar for the cache

@@ -30,7 +29,7 @@ fileResourceProvider configuration = do

3029 -- Construct a resource provider

3130 return ResourceProvider

3231 { resourceList = map Resource list

33− , resourceString = readFile . toFilePath . unResource

34− , resourceLazyByteString = LB.readFile . toFilePath . unResource

32+ , resourceString = readFile . unResource

33+ , resourceLazyByteString = LB.readFile . unResource

3534 , resourceModifiedCache = mvar

3635 }

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

@@ -102,11 +102,11 @@ compile :: (Binary a, Typeable a, Writable a)

102102compile compiler = RulesM $ do

103103 pattern <- rulesPattern <$> ask

104104 provider <- rulesResourceProvider <$> ask

105− let ids = filterMatches pattern $ map unResource $ resourceList provider

105+ let ids = filterMatches pattern $ map toIdentifier $ resourceList provider

106106 unRulesM $ do

107107 tellCompilers $ flip map ids $ \identifier ->

108− (identifier, constA (Resource identifier) >>> compiler)

109− tellResources $ map Resource ids

108+ (identifier, constA (fromIdentifier identifier) >>> compiler)

109+ tellResources $ map fromIdentifier ids

110110

111111-- | Add a compilation rule

112112--

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

@@ -64,6 +64,9 @@ run configuration rules = do

6464 , hakyllStore = store

6565 }

6666

67+ -- DEBUG

68+ report logger $ "Compilers: " ++ show (map fst compilers)

69+

6770 -- Run the program and fetch the resulting state

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

6972 { hakyllAnalyzer = makeDependencyAnalyzer mempty (const False) oldGraph

@@ -118,39 +121,43 @@ addNewCompilers newCompilers = Runtime $ do

118121 provider <- hakyllResourceProvider <$> ask

119122 store <- hakyllStore <$> ask

120123

124+ -- DEBUG

125+ report logger $ "Adding: " ++ show (map fst newCompilers)

126+

121127 -- Old state information

122128 oldCompilers <- hakyllCompilers <$> get

123129 oldAnalyzer <- hakyllAnalyzer <$> get

124130

125− let -- Create a new partial dependency graph

131+ let -- All known compilers

132+ universe = M.keys oldCompilers ++ map fst newCompilers

133+

134+ -- Create a new partial dependency graph

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

127− let deps = runCompilerDependencies compiler id' provider

136+ let deps = runCompilerDependencies compiler id' universe

128137 in (id', deps)

129138

130139 -- Create the dependency graph

131140 newGraph = fromList dependencies

132141

142+ -- DEBUG

143+ report logger $ "Dependencies: " ++ show dependencies

144+ liftIO $ writeFile "newGraph.dot" $ toDot show newGraph

145+

146+

133147 -- Check which items have been modified

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

148+ modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $ \id' -> do

149+ m <- liftIO $ resourceModified provider store $ fromIdentifier id'

150+ liftIO $ putStrLn $ show id' ++ " " ++ show m

151+ return m

152+

153+ -- DEBUG

154+ report logger $ "Modified: " ++ show modified

137155

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

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

140158 analyzerPreviousGraph oldAnalyzer

141159 analyzer = mappend oldAnalyzer newAnalyzer

142160

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−

154161 -- Update the state

155162 put $ RuntimeState

156163 { hakyllAnalyzer = analyzer

@@ -185,11 +192,12 @@ build id' = Runtime $ do

185192 let compiler = compilers M.! id'

186193

187194 -- Check if the resource was modified

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

195+ isModified <- liftIO $ resourceModified provider store $ fromIdentifier id'

189196

190197 -- Run the compiler

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

192− runCompiler compiler id' provider routes store isModified logger

199+ runCompiler compiler id' provider (M.keys compilers) routes

200+ store isModified logger

193201

194202 case result of

195203 -- Compile rule for one item, easy stuff

src/Hakyll/Core/Store.hs+5−2

@@ -11,6 +11,7 @@ module Hakyll.Core.Store

1111import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_)

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

1313import System.Directory (doesFileExist)

14+import Data.Maybe (fromMaybe)

1415import Data.Map (Map)

1516import qualified Data.Map as M

1617

@@ -52,8 +53,10 @@ addToMap store path value =

5253-- | Create a path

5354--

5455makePath :: Store -> String -> Identifier -> FilePath

55−makePath store name identifier =

56− storeDirectory store </> name </> toFilePath identifier </> "hakyllstore"

56+makePath store name identifier = storeDirectory store </> name

57+ </> group </> toFilePath identifier </> "hakyllstore"

58+ where

59+ group = fromMaybe "" $ identifierGroup identifier

5760

5861-- | Store an item

5962--