6f4ccbd · hakyll · git.iko.soy

git.iko.soy/hakyll

Fix dependency handling for snapshots

commit6f4ccbdc49c5662dcb9be59851310449ad4fd98d authorJasper Van der Jeugt <m@jaspervdj.be> dateFri 12 Dec 2014, 16:33 (12 years ago) parent4ccd994

4 files changed+62−32

compare with master

unifiedsplit

src/Hakyll/Core/Compiler.hs+3−1 src/Hakyll/Core/Compiler/Internal.hs+27−15 src/Hakyll/Core/Compiler/Require.hs+1−7 src/Hakyll/Core/Runtime.hs+31−9

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

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

135135 compilerUnsafeIO $ do

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

137137 Internal.saveSnapshot store snapshot item

138− return item

138+

139+ -- Signal that we saved the snapshot.

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

139141

140142

141143--------------------------------------------------------------------------------

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

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

66{-# LANGUAGE MultiParamTypeClasses #-}

77module Hakyll.Core.Compiler.Internal

88 ( -- * Types

9− CompilerRead (..)

9+ Snapshot

10+ , CompilerRead (..)

1011 , CompilerWrite (..)

1112 , CompilerResult (..)

1213 , Compiler (..)

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

5051import Hakyll.Core.Store

5152

5253

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+

5360--------------------------------------------------------------------------------

5461-- | Environment in which a compiler runs

5562data CompilerRead = CompilerRead

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

8693

8794--------------------------------------------------------------------------------

8895data CompilerResult a where

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

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

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

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

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

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

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

92100

93101

94102--------------------------------------------------------------------------------

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

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

105113 res <- c r

106114 return $ case res of

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

108− CompilerError e -> CompilerError e

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

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

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

117+ CompilerError e -> CompilerError e

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

110119 {-# INLINE fmap #-}

111120

112121

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

121130 CompilerDone x w -> do

122131 res' <- unCompiler (f x) r

123132 return $ case res' of

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

125− CompilerError e -> CompilerError e

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

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

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

135+ CompilerError e -> CompilerError e

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

127137 compilerTell w -- Save dependencies!

128138 c'

129139

130− CompilerError e -> return $ CompilerError e

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

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

141+ CompilerError e -> return $ CompilerError e

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

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

133144

134145 fail = compilerThrow . return

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

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

199210 res <- x r

200211 case res of

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

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

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

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

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

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

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

204216{-# INLINE compilerCatch #-}

205217

206218

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

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

3131import qualified Hakyll.Core.Store as Store

3232

3333

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−

4034--------------------------------------------------------------------------------

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

4236save store item = saveSnapshot store final item

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

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

7165

7266 compilerTellDependencies [IdentifierDependency id']

73− compilerResult $ CompilerRequire id' $ do

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

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

7569 case result of

7670 Store.NotFound -> fail notFound

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

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

7171 , runtimeUniverse = M.fromList compilers

7272 }

7373 state = RuntimeState

74− { runtimeDone = S.empty

75− , runtimeTodo = M.empty

76− , runtimeFacts = oldFacts

74+ { runtimeDone = S.empty

75+ , runtimeSnapshots = S.empty

76+ , runtimeTodo = M.empty

77+ , runtimeFacts = oldFacts

7778 }

7879

7980 -- Run the program and fetch the resulting state

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

109110

110111--------------------------------------------------------------------------------

111112data RuntimeState = RuntimeState

112− { runtimeDone :: Set Identifier

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

114− , runtimeFacts :: DependencyFacts

113+ { runtimeDone :: Set Identifier

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

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

116+ , runtimeFacts :: DependencyFacts

115117 }

116118

117119

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

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

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

206208

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+

207219 -- Huge success

208220 CompilerDone (SomeItem item) cwrite -> do

209221 -- Print some info

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

243255 -- Try something else first

244256 CompilerRequire dep c -> do

245257 -- 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+

247268 modify $ \s -> s

248269 { runtimeTodo = M.insert id'

249270 (if depDone then c else compilerResult result)

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

252273

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

254275 -- chasing that

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

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

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

256278 (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