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