6f4ccbd · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Fix dependency handling for snapshots

6f4ccbdJasper Van der Jeugt12 years ago

src/Hakyll/Core/Compiler.hs+3−1

compare with master

unifiedsplit

@@ -135,7 +135,9 @@ saveSnapshot snapshot item = do

135 compilerUnsafeIO $ do

136 Logger.debug logger $ "Storing snapshot: " ++ snapshot

137 Internal.saveSnapshot store snapshot item

138− return item

138+

139+ -- Signal that we saved the snapshot.

140+ Compiler $ \_ -> return $ CompilerSnapshot snapshot (return item)

139

141

140

142

141--------------------------------------------------------------------------------

143--------------------------------------------------------------------------------

src/Hakyll/Core/Compiler/Internal.hs+27−15

@@ -6,7 +6,8 @@

6{-# LANGUAGE MultiParamTypeClasses #-}

7module Hakyll.Core.Compiler.Internal

8 ( -- * Types

9+ Snapshot

9− CompilerRead (..)

10+ , CompilerRead (..)

10 , CompilerWrite (..)

11 , CompilerWrite (..)

11 , CompilerResult (..)

12 , CompilerResult (..)

12 , Compiler (..)

13 , Compiler (..)

@@ -50,6 +51,12 @@ import Hakyll.Core.Routes

50import Hakyll.Core.Store

51import Hakyll.Core.Store

54+--------------------------------------------------------------------------------

55+-- | Whilst compiling an item, it possible to save multiple snapshots of it, and

56+-- not just the final result.

57+type Snapshot = String

58+

59+

53--------------------------------------------------------------------------------

60--------------------------------------------------------------------------------

54-- | Environment in which a compiler runs

61-- | Environment in which a compiler runs

55data CompilerRead = CompilerRead

62data CompilerRead = CompilerRead

@@ -86,9 +93,10 @@ instance Monoid CompilerWrite where

87--------------------------------------------------------------------------------

94--------------------------------------------------------------------------------

88data CompilerResult a where

95data CompilerResult a where

89− CompilerDone :: a -> CompilerWrite -> CompilerResult a

96+ CompilerDone :: a -> CompilerWrite -> CompilerResult a

97+ CompilerSnapshot :: Snapshot -> Compiler a -> CompilerResult a

90− CompilerError :: [String] -> CompilerResult a

98+ CompilerError :: [String] -> CompilerResult a

91− CompilerRequire :: Identifier -> Compiler a -> CompilerResult a

99+ CompilerRequire :: (Identifier, Snapshot) -> Compiler a -> CompilerResult a

100

101

94--------------------------------------------------------------------------------

102--------------------------------------------------------------------------------

@@ -104,9 +112,10 @@ instance Functor Compiler where

104 fmap f (Compiler c) = Compiler $ \r -> do

112 fmap f (Compiler c) = Compiler $ \r -> do

105 res <- c r

113 res <- c r

106 return $ case res of

114 return $ case res of

107− CompilerDone x w -> CompilerDone (f x) w

115+ CompilerDone x w -> CompilerDone (f x) w

116+ CompilerSnapshot s c' -> CompilerSnapshot s (fmap f c')

108− CompilerError e -> CompilerError e

117+ CompilerError e -> CompilerError e

109− CompilerRequire i c' -> CompilerRequire i (fmap f c')

118+ CompilerRequire i c' -> CompilerRequire i (fmap f c')

110 {-# INLINE fmap #-}

119 {-# INLINE fmap #-}

111

120

112

121

@@ -121,14 +130,16 @@ instance Monad Compiler where

121 CompilerDone x w -> do

130 CompilerDone x w -> do

122 res' <- unCompiler (f x) r

131 res' <- unCompiler (f x) r

123 return $ case res' of

132 return $ case res' of

124− CompilerDone y w' -> CompilerDone y (w `mappend` w')

133+ CompilerDone y w' -> CompilerDone y (w `mappend` w')

134+ CompilerSnapshot s c' -> CompilerSnapshot s c'

125− CompilerError e -> CompilerError e

135+ CompilerError e -> CompilerError e

126− CompilerRequire i c' -> CompilerRequire i $ do

136+ CompilerRequire i c' -> CompilerRequire i $ do

127 compilerTell w -- Save dependencies!

137 compilerTell w -- Save dependencies!

128 c'

138 c'

129

139

140+ CompilerSnapshot s c' -> return $ CompilerSnapshot s (c' >>= f)

130− CompilerError e -> return $ CompilerError e

141+ CompilerError e -> return $ CompilerError e

131− CompilerRequire i c' -> return $ CompilerRequire i $ c' >>= f

142+ CompilerRequire i c' -> return $ CompilerRequire i (c' >>= f)

132 {-# INLINE (>>=) #-}

143 {-# INLINE (>>=) #-}

133

144

134 fail = compilerThrow . return

145 fail = compilerThrow . return

@@ -198,9 +209,10 @@ compilerCatch :: Compiler a -> ([String] -> Compiler a) -> Compiler a

198compilerCatch (Compiler x) f = Compiler $ \r -> do

209compilerCatch (Compiler x) f = Compiler $ \r -> do

199 res <- x r

210 res <- x r

200 case res of

211 case res of

201− CompilerDone res' w -> return (CompilerDone res' w)

212+ CompilerDone res' w -> return (CompilerDone res' w)

213+ CompilerSnapshot s c -> return (CompilerSnapshot s (compilerCatch c f))

202− CompilerError e -> unCompiler (f e) r

214+ CompilerError e -> unCompiler (f e) r

203− CompilerRequire i c -> return (CompilerRequire i (compilerCatch c f))

215+ CompilerRequire i c -> return (CompilerRequire i (compilerCatch c f))

204{-# INLINE compilerCatch #-}

216{-# INLINE compilerCatch #-}

205

217

206

218

src/Hakyll/Core/Compiler/Require.hs+1−7

@@ -31,12 +31,6 @@ import Hakyll.Core.Store (Store)

31import qualified Hakyll.Core.Store as Store

34−--------------------------------------------------------------------------------

35−-- | Whilst compiling an item, it possible to save multiple snapshots of it, and

36−-- not just the final result.

37−type Snapshot = String

38−

39−

40--------------------------------------------------------------------------------

34--------------------------------------------------------------------------------

41save :: (Binary a, Typeable a) => Store -> Item a -> IO ()

35save :: (Binary a, Typeable a) => Store -> Item a -> IO ()

42save store item = saveSnapshot store final item

36save store item = saveSnapshot store final item

@@ -70,7 +64,7 @@ loadSnapshot id' snapshot = do

70 when (id' `S.notMember` universe) $ fail notFound

64 when (id' `S.notMember` universe) $ fail notFound

72 compilerTellDependencies [IdentifierDependency id']

66 compilerTellDependencies [IdentifierDependency id']

73− compilerResult $ CompilerRequire id' $ do

67+ compilerResult $ CompilerRequire (id', snapshot) $ do

74 result <- compilerUnsafeIO $ Store.get store (key id' snapshot)

68 result <- compilerUnsafeIO $ Store.get store (key id' snapshot)

75 case result of

69 case result of

76 Store.NotFound -> fail notFound

70 Store.NotFound -> fail notFound

src/Hakyll/Core/Runtime.hs+31−9

@@ -71,9 +71,10 @@ run config verbosity rules = do

71 , runtimeUniverse = M.fromList compilers

72 }

73 state = RuntimeState

74− { runtimeDone = S.empty

74+ { runtimeDone = S.empty

75+ , runtimeSnapshots = S.empty

75− , runtimeTodo = M.empty

76+ , runtimeTodo = M.empty

76− , runtimeFacts = oldFacts

77+ , runtimeFacts = oldFacts

77 }

78 }

79 -- Run the program and fetch the resulting state

80 -- Run the program and fetch the resulting state

@@ -109,9 +110,10 @@ data RuntimeRead = RuntimeRead

109

110

110--------------------------------------------------------------------------------

111--------------------------------------------------------------------------------

111data RuntimeState = RuntimeState

112data RuntimeState = RuntimeState

112− { runtimeDone :: Set Identifier

113+ { runtimeDone :: Set Identifier

114+ , runtimeSnapshots :: Set (Identifier, Snapshot)

113− , runtimeTodo :: Map Identifier (Compiler SomeItem)

115+ , runtimeTodo :: Map Identifier (Compiler SomeItem)

114− , runtimeFacts :: DependencyFacts

116+ , runtimeFacts :: DependencyFacts

115 }

117 }

116

118

117

119

@@ -204,6 +206,16 @@ chase trail id'

204 "Compiler failed but no info given, try running with -v?"

206 "Compiler failed but no info given, try running with -v?"

205 CompilerError es -> throwError $ intercalate "; " es

207 CompilerError es -> throwError $ intercalate "; " es

206

208

209+ -- Signal that a snapshot was saved ->

210+ CompilerSnapshot snapshot c -> do

211+ -- Update info and just continue.

212+ modify $ \s -> s

213+ { runtimeSnapshots =

214+ S.insert (id', snapshot) (runtimeSnapshots s)

215+ , runtimeTodo = M.insert id' c (runtimeTodo s)

216+ }

217+ chase trail id'

218+

207 -- Huge success

219 -- Huge success

208 CompilerDone (SomeItem item) cwrite -> do

220 CompilerDone (SomeItem item) cwrite -> do

209 -- Print some info

221 -- Print some info

@@ -243,7 +255,16 @@ chase trail id'

243 -- Try something else first

255 -- Try something else first

244 CompilerRequire dep c -> do

256 CompilerRequire dep c -> do

245 -- Update the compiler so we don't execute it twice

257 -- Update the compiler so we don't execute it twice

246− depDone <- (dep `S.member`) . runtimeDone <$> get

258+ let (depId, depSnapshot) = dep

259+ done <- runtimeDone <$> get

260+ snapshots <- runtimeSnapshots <$> get

261+

262+ -- Done if we either completed the entire item (runtimeDone) or

263+ -- if we previously saved the snapshot (runtimeSnapshots).

264+ let depDone =

265+ depId `S.member` done ||

266+ (depId, depSnapshot) `S.member` snapshots

267+

247 modify $ \s -> s

268 modify $ \s -> s

248 { runtimeTodo = M.insert id'

269 { runtimeTodo = M.insert id'

249 (if depDone then c else compilerResult result)

270 (if depDone then c else compilerResult result)

@@ -252,6 +273,7 @@ chase trail id'

252

273

253 -- If the required item is already compiled, continue, or, start

274 -- If the required item is already compiled, continue, or, start

254 -- chasing that

275 -- chasing that

255− Logger.debug logger $ "Require " ++ show dep ++ ": " ++

276+ Logger.debug logger $ "Require " ++ show depId ++

277+ " (snapshot " ++ depSnapshot ++ "): " ++

256 (if depDone then "OK" else "chasing")

278 (if depDone then "OK" else "chasing")

257− if depDone then chase trail id' else chase (id' : trail) dep

279+ if depDone then chase trail id' else chase (id' : trail) depId