@@ -5,31 +5,32 @@ module Hakyll.Core.Runtime
7--------------------------------------------------------------------------------
7--------------------------------------------------------------------------------
8−import Control.Applicative ((<$>))
8+import Control.Monad (unless)
9−import Control.Monad (filterM)
10−import Control.Monad.Error (ErrorT, runErrorT, throwError)
9+import Control.Monad.Except (ExceptT, runExceptT, throwError)
11import Control.Monad.Reader (ask)
10import Control.Monad.Reader (ask)
12import Control.Monad.RWS (RWST, runRWST)
11import Control.Monad.RWS (RWST, runRWST)
13import Control.Monad.State (get, modify)
12import Control.Monad.State (get, modify)
14import Control.Monad.Trans (liftIO)
13import Control.Monad.Trans (liftIO)
14+import Data.List (intercalate)
15import Data.Map (Map)
15import Data.Map (Map)
16import qualified Data.Map as M
16import qualified Data.Map as M
17−import Data.Monoid (mempty)
18import Data.Set (Set)
17import Data.Set (Set)
19import qualified Data.Set as S
18import qualified Data.Set as S
19+import System.Exit (ExitCode (..))
20import System.FilePath ((</>))
20import System.FilePath ((</>))
23--------------------------------------------------------------------------------
23--------------------------------------------------------------------------------
24−import Hakyll.Core.CompiledItem
25import Hakyll.Core.Compiler.Internal
24import Hakyll.Core.Compiler.Internal
26import Hakyll.Core.Compiler.Require
25import Hakyll.Core.Compiler.Require
27import Hakyll.Core.Configuration
26import Hakyll.Core.Configuration
28import Hakyll.Core.Dependencies
27import Hakyll.Core.Dependencies
29import Hakyll.Core.Identifier
28import Hakyll.Core.Identifier
29+import Hakyll.Core.Item
30+import Hakyll.Core.Item.SomeItem
30import Hakyll.Core.Logger (Logger)
31import Hakyll.Core.Logger (Logger)
31import qualified Hakyll.Core.Logger as Logger
32import qualified Hakyll.Core.Logger as Logger
32−import Hakyll.Core.ResourceProvider
33+import Hakyll.Core.Provider
33import Hakyll.Core.Routes
34import Hakyll.Core.Routes
34import Hakyll.Core.Rules.Internal
35import Hakyll.Core.Rules.Internal
35import Hakyll.Core.Store (Store)
36import Hakyll.Core.Store (Store)
@@ -39,17 +40,16 @@ import Hakyll.Core.Writable
41--------------------------------------------------------------------------------
42--------------------------------------------------------------------------------
42−run :: Configuration -> Rules a -> IO RuleSet
43+run :: Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
43−run configuration rules = do
44+run config logger rules = do
44 -- Initialization
45 -- Initialization
45− logger <- Logger.new Logger.Debug putStrLn
46− Logger.header logger "Initialising"
46+ Logger.header logger "Initialising..."
47− Logger.item logger ["Creating store"]
47+ Logger.message logger "Creating store..."
48− store <- Store.new (inMemoryCache configuration) $
48+ store <- Store.new (inMemoryCache config) $ storeDirectory config
49− storeDirectory configuration
49+ Logger.message logger "Creating provider..."
50− Logger.item logger ["Creating provider"]
50+ provider <- newProvider store (shouldIgnoreFile config) $
51− provider <- newResourceProvider store (ignoreFile configuration) "."
51+ providerDirectory config
52− Logger.item logger ["Running rules"]
52+ Logger.message logger "Running rules..."
53 ruleSet <- runRules rules provider
53 ruleSet <- runRules rules provider
55 -- Get old facts
55 -- Get old facts
@@ -60,28 +60,36 @@ run configuration rules = do
60 -- Build runtime read/state
60 -- Build runtime read/state
61 let compilers = rulesCompilers ruleSet
61 let compilers = rulesCompilers ruleSet
62 read' = RuntimeRead
62 read' = RuntimeRead
63− { runtimeConfiguration = configuration
63+ { runtimeConfiguration = config
64 , runtimeLogger = logger
64 , runtimeLogger = logger
65 , runtimeProvider = provider
65 , runtimeProvider = provider
66 , runtimeStore = store
66 , runtimeStore = store
67 , runtimeRoutes = rulesRoutes ruleSet
67 , runtimeRoutes = rulesRoutes ruleSet
68− , runtimeUniverse = compilers
68+ , runtimeUniverse = M.fromList compilers
70 state = RuntimeState
70 state = RuntimeState
71− { runtimeDone = S.empty
71+ { runtimeDone = S.empty
72+ , runtimeSnapshots = S.empty
72− , runtimeTodo = M.empty
73+ , runtimeTodo = M.empty
73− , runtimeFacts = oldFacts
74+ , runtimeFacts = oldFacts
76 -- Run the program and fetch the resulting state
77 -- Run the program and fetch the resulting state
77− result <- runErrorT $ runRWST build read' state
78+ result <- runExceptT $ runRWST build read' state
78 case result of
79 case result of
79− Left e -> Logger.error logger e
81+ Logger.error logger e
80− Right (_, s, _) -> Store.set store factsKey $ runtimeFacts s
82+ Logger.flush logger
83+ return (ExitFailure 1, ruleSet)
82− -- Flush and return
85+ Right (_, s, _) -> do
86+ Store.set store factsKey $ runtimeFacts s
88+ Logger.debug logger "Removing tmp directory..."
89+ removeDirectory $ tmpDirectory config
83− Logger.flush logger
91+ Logger.flush logger
84− return ruleSet
92+ return (ExitSuccess, ruleSet)
86 factsKey = ["Hakyll.Core.Runtime.run", "facts"]
94 factsKey = ["Hakyll.Core.Runtime.run", "facts"]
@@ -90,23 +98,24 @@ run configuration rules = do
90data RuntimeRead = RuntimeRead
98data RuntimeRead = RuntimeRead
91 { runtimeConfiguration :: Configuration
99 { runtimeConfiguration :: Configuration
92 , runtimeLogger :: Logger
100 , runtimeLogger :: Logger
93− , runtimeProvider :: ResourceProvider
101+ , runtimeProvider :: Provider
94 , runtimeStore :: Store
102 , runtimeStore :: Store
95 , runtimeRoutes :: Routes
103 , runtimeRoutes :: Routes
96− , runtimeUniverse :: [(Identifier, Compiler CompiledItem)]
104+ , runtimeUniverse :: Map Identifier (Compiler SomeItem)
100--------------------------------------------------------------------------------
108--------------------------------------------------------------------------------
101data RuntimeState = RuntimeState
109data RuntimeState = RuntimeState
102− { runtimeDone :: Set Identifier
110+ { runtimeDone :: Set Identifier
111+ , runtimeSnapshots :: Set (Identifier, Snapshot)
103− , runtimeTodo :: Map Identifier (Compiler CompiledItem)
112+ , runtimeTodo :: Map Identifier (Compiler SomeItem)
104− , runtimeFacts :: DependencyFacts
113+ , runtimeFacts :: DependencyFacts
108--------------------------------------------------------------------------------
117--------------------------------------------------------------------------------
109−type Runtime a = RWST RuntimeRead () RuntimeState (ErrorT String IO) a
118+type Runtime a = RWST RuntimeRead () RuntimeState (ExceptT String IO) a
112--------------------------------------------------------------------------------
121--------------------------------------------------------------------------------
@@ -123,17 +132,22 @@ build = do
123--------------------------------------------------------------------------------
132--------------------------------------------------------------------------------
124scheduleOutOfDate :: Runtime ()
133scheduleOutOfDate :: Runtime ()
125scheduleOutOfDate = do
134scheduleOutOfDate = do
135+ logger <- runtimeLogger <$> ask
126 provider <- runtimeProvider <$> ask
136 provider <- runtimeProvider <$> ask
127 universe <- runtimeUniverse <$> ask
137 universe <- runtimeUniverse <$> ask
128 facts <- runtimeFacts <$> get
138 facts <- runtimeFacts <$> get
129 todo <- runtimeTodo <$> get
139 todo <- runtimeTodo <$> get
131− let identifiers = map fst universe
141+ let identifiers = M.keys universe
132− modified <- fmap S.fromList $ flip filterM identifiers $
142+ modified = S.fromList $ flip filter identifiers $
133− liftIO . resourceModified provider
143+ resourceModified provider
134− let (ood, facts', _) = outOfDate identifiers modified facts
145+ let (ood, facts', msgs) = outOfDate identifiers modified facts
135− todo' = M.fromList
146+ todo' = M.filterWithKey
136− [(id', c) | (id', c) <- universe, id' `S.member` ood]
147+ (\id' _ -> id' `S.member` ood) universe
150+ mapM_ (Logger.debug logger) msgs
138 -- Update facts and todo items
152 -- Update facts and todo items
139 modify $ \s -> s
153 modify $ \s -> s
@@ -158,7 +172,9 @@ pickAndChase = do
158--------------------------------------------------------------------------------
172--------------------------------------------------------------------------------
159chase :: [Identifier] -> Identifier -> Runtime ()
173chase :: [Identifier] -> Identifier -> Runtime ()
160chase trail id'
174chase trail id'
161− | id' `elem` trail = return () -- Cycle detected!
175+ | id' `elem` trail = throwError $ "Hakyll.Core.Runtime.chase: " ++
176+ "Dependency cycle detected: " ++ intercalate " depends on "
177+ (map show $ dropWhile (/= id') (reverse trail) ++ [id'])
162 | otherwise = do
178 | otherwise = do
163 logger <- runtimeLogger <$> ask
179 logger <- runtimeLogger <$> ask
164 todo <- runtimeTodo <$> get
180 todo <- runtimeTodo <$> get
@@ -167,12 +183,14 @@ chase trail id'
167 routes <- runtimeRoutes <$> ask
183 routes <- runtimeRoutes <$> ask
168 store <- runtimeStore <$> ask
184 store <- runtimeStore <$> ask
169 config <- runtimeConfiguration <$> ask
185 config <- runtimeConfiguration <$> ask
186+ Logger.debug logger $ "Processing " ++ show id'
171 let compiler = todo M.! id'
188 let compiler = todo M.! id'
172 read' = CompilerRead
189 read' = CompilerRead
173− { compilerIdentifier = id'
190+ { compilerConfig = config
191+ , compilerUnderlying = id'
174 , compilerProvider = provider
192 , compilerProvider = provider
175− , compilerUniverse = map fst universe
193+ , compilerUniverse = M.keysSet universe
176 , compilerRoutes = routes
194 , compilerRoutes = routes
177 , compilerStore = store
195 , compilerStore = store
178 , compilerLogger = logger
196 , compilerLogger = logger
@@ -181,27 +199,48 @@ chase trail id'
181 result <- liftIO $ runCompiler compiler read'
199 result <- liftIO $ runCompiler compiler read'
182 case result of
200 case result of
183 -- Rethrow error
201 -- Rethrow error
184− CompilerError e -> throwError e
202+ CompilerError e -> throwError $ case compilerErrorMessages e of
203+ [] -> "Compiler failed but no info given, try running with -v?"
204+ es -> intercalate "; " es
206+ -- Signal that a snapshot was saved ->
207+ CompilerSnapshot snapshot c -> do
208+ -- Update info. The next 'chase' will pick us again at some
209+ -- point so we can continue then.
211+ { runtimeSnapshots =
212+ S.insert (id', snapshot) (runtimeSnapshots s)
213+ , runtimeTodo = M.insert id' c (runtimeTodo s)
186 -- Huge success
216 -- Huge success
187− CompilerDone (CompiledItem compiled) cwrite -> do
217+ CompilerDone (SomeItem item) cwrite -> do
188− let facts = compilerDependencies cwrite
219+ let facts = compilerDependencies cwrite
189 cacheHits
220 cacheHits
190− | compilerCacheHits cwrite <= 0 = "modified"
221+ | compilerCacheHits cwrite <= 0 = "updated"
191− | otherwise = "cache hit"
222+ | otherwise = "cached "
192− Logger.item logger [show id', cacheHits]
223+ Logger.message logger $ cacheHits ++ " " ++ show id'
226+ unless (itemIdentifier item == id') $ throwError $
227+ "The compiler yielded an Item with Identifier " ++
228+ show (itemIdentifier item) ++ ", but we were expecting " ++
229+ "an Item with Identifier " ++ show id' ++ " " ++
230+ "(you probably want to call makeItem to solve this problem)"
194 -- Write if necessary
232 -- Write if necessary
195− case runRoutes routes id' of
233+ (mroute, _) <- liftIO $ runRoutes routes provider id'
196− Nothing -> return ()
235+ Nothing -> return ()
197− Just url -> do
236+ Just route -> do
198− let path = destinationDirectory config </> url
237+ let path = destinationDirectory config </> route
199− Logger.subitem logger ["-> " ++ path]
200 liftIO $ makeDirectories path
238 liftIO $ makeDirectories path
201− liftIO $ write path compiled
239+ liftIO $ write path item
240+ Logger.debug logger $ "Routed to " ++ path
203− -- Save! (For require)
242+ -- Save! (For load)
204− liftIO $ save store id' compiled
243+ liftIO $ save store item
206 -- Update state
245 -- Update state
207 modify $ \s -> s
246 modify $ \s -> s
@@ -213,7 +252,16 @@ chase trail id'
213 -- Try something else first
252 -- Try something else first
214 CompilerRequire dep c -> do
253 CompilerRequire dep c -> do
215 -- Update the compiler so we don't execute it twice
254 -- Update the compiler so we don't execute it twice
216− depDone <- (dep `S.member`) . runtimeDone <$> get
255+ let (depId, depSnapshot) = dep
256+ done <- runtimeDone <$> get
257+ snapshots <- runtimeSnapshots <$> get
259+ -- Done if we either completed the entire item (runtimeDone) or
260+ -- if we previously saved the snapshot (runtimeSnapshots).
262+ depId `S.member` done ||
263+ (depId, depSnapshot) `S.member` snapshots
217 modify $ \s -> s
265 modify $ \s -> s
218 { runtimeTodo = M.insert id'
266 { runtimeTodo = M.insert id'
219 (if depDone then c else compilerResult result)
267 (if depDone then c else compilerResult result)
@@ -222,4 +270,7 @@ chase trail id'
223 -- If the required item is already compiled, continue, or, start
271 -- If the required item is already compiled, continue, or, start
224 -- chasing that
272 -- chasing that
273+ Logger.debug logger $ "Require " ++ show depId ++
274+ " (snapshot " ++ depSnapshot ++ "): " ++
275+ (if depDone then "OK" else "chasing")
225− if depDone then chase trail id' else chase (id' : trail) dep
276+ if depDone then chase trail id' else chase (id' : trail) depId