@@ -1,41 +1,47 @@
1+--------------------------------------------------------------------------------
12-- | This is the module which binds it all together
2−--
3−{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE OverloadedStrings #-}
45module Hakyll.Core.Run
56 ( run
67 ) where
78
8−import Control.Applicative (Applicative, (<$>))
9−import Control.Monad (filterM, forM_)
10−import Control.Monad.Error (ErrorT, runErrorT, throwError)
11−import Control.Monad.Reader (ReaderT, runReaderT, ask)
12−import Control.Monad.State.Strict (StateT, runStateT, get, put)
13−import Control.Monad.Trans (liftIO)
14−import Data.Map (Map)
15−import Data.Monoid (mempty, mappend)
16−import Prelude hiding (reverse)
17−import System.FilePath ((</>))
18−import qualified Data.Map as M
19−import qualified Data.Set as S
20−
21−import Hakyll.Core.CompiledItem
22−import Hakyll.Core.Compiler
23−import Hakyll.Core.Compiler.Internal
24−import Hakyll.Core.Configuration
25−import Hakyll.Core.DependencyAnalyzer
26−import Hakyll.Core.DirectedGraph
27−import Hakyll.Core.Identifier
28−import Hakyll.Core.Logger
29−import Hakyll.Core.ResourceProvider
30−import Hakyll.Core.Routes
31−import Hakyll.Core.Rules.Internal
32−import Hakyll.Core.Store (Store)
33−import Hakyll.Core.Util.File
34−import Hakyll.Core.Writable
35−import qualified Hakyll.Core.Store as Store
369
10+--------------------------------------------------------------------------------
11+import Control.Applicative (Applicative, (<$>))
12+import Control.DeepSeq (deepseq)
13+import Control.Monad (filterM, forM_)
14+import Control.Monad.Error (ErrorT, runErrorT, throwError)
15+import Control.Monad.Reader (ReaderT, ask, runReaderT)
16+import Control.Monad.Trans (liftIO)
17+import Data.Map (Map)
18+import qualified Data.Map as M
19+import Data.Monoid (mempty)
20+import qualified Data.Set as S
21+import Prelude hiding (reverse)
22+import System.FilePath ((</>))
23+
24+
25+--------------------------------------------------------------------------------
26+import Hakyll.Core.CompiledItem
27+import Hakyll.Core.Compiler
28+import Hakyll.Core.Compiler.Internal
29+import Hakyll.Core.Configuration
30+import Hakyll.Core.DependencyAnalyzer
31+import qualified Hakyll.Core.DirectedGraph as DG
32+import Hakyll.Core.Identifier
33+import Hakyll.Core.Logger
34+import Hakyll.Core.ResourceProvider
35+import Hakyll.Core.Routes
36+import Hakyll.Core.Rules.Internal
37+import Hakyll.Core.Store (Store)
38+import qualified Hakyll.Core.Store as Store
39+import Hakyll.Core.Util.File
40+import Hakyll.Core.Writable
41+
42+
43+--------------------------------------------------------------------------------
3744-- | Run all rules needed, return the rule set used
38−--
3945run :: HakyllConfiguration -> RulesM a -> IO RuleSet
4046run configuration rules = do
4147 logger <- makeLogger putStrLn
@@ -46,136 +52,113 @@ run configuration rules = do
4652 provider <- timed logger "Creating provider" $ newResourceProvider
4753 store (ignoreFile configuration) "."
4854
49− -- Fetch the old graph from the store. If we don't find it, we consider this
50− -- to be the first run
51− graph <- Store.get store ["Hakyll.Core.Run.run", "dependencies"]
52− let (firstRun, oldGraph) = case graph of Store.Found g -> (False, g)
53− _ -> (True, mempty)
54−
5555 ruleSet <- timed logger "Running rules" $ runRules rules provider
5656 let compilers = rulesCompilers ruleSet
5757
5858 -- Extract the reader/state
59− reader = unRuntime $ addNewCompilers compilers
60− stateT = runReaderT reader $ RuntimeEnvironment
61− { hakyllLogger = logger
62− , hakyllConfiguration = configuration
63− , hakyllRoutes = rulesRoutes ruleSet
64− , hakyllResourceProvider = provider
65− , hakyllStore = store
66− , hakyllFirstRun = firstRun
59+ reader = unRuntime analyzeAndBuild
60+ errorT = runReaderT reader $ RuntimeEnvironment
61+ { runtimeLogger = logger
62+ , runtimeConfiguration = configuration
63+ , runtimeRoutes = rulesRoutes ruleSet
64+ , runtimeProvider = provider
65+ , runtimeStore = store
66+ , runtimeCompilers = M.fromList compilers
6767 }
6868
6969 -- Run the program and fetch the resulting state
70− result <- runErrorT $ runStateT stateT $ RuntimeState
71− { hakyllAnalyzer = makeDependencyAnalyzer mempty (const False) oldGraph
72− , hakyllCompilers = M.empty
73− }
74−
70+ result <- runErrorT errorT
7571 case result of
76− Left e ->
77− thrown logger e
78− Right ((), state') ->
79− -- We want to save the final dependency graph for the next run
80− Store.set store ["Hakyll.Core.Run.run", "dependencies"] $
81− analyzerGraph $ hakyllAnalyzer state'
72+ Left e -> thrown logger e
73+ _ -> return ()
8274
8375 -- Flush and return
8476 flushLogger logger
8577 return ruleSet
8678
79+
80+--------------------------------------------------------------------------------
8781data RuntimeEnvironment = RuntimeEnvironment
88− { hakyllLogger :: Logger
89− , hakyllConfiguration :: HakyllConfiguration
90− , hakyllRoutes :: Routes
91− , hakyllResourceProvider :: ResourceProvider
92− , hakyllStore :: Store
93− , hakyllFirstRun :: Bool
82+ { runtimeLogger :: Logger
83+ , runtimeConfiguration :: HakyllConfiguration
84+ , runtimeRoutes :: Routes
85+ , runtimeProvider :: ResourceProvider
86+ , runtimeStore :: Store
87+ , runtimeCompilers :: Map (Identifier ()) (Compiler () CompiledItem)
9488 }
9589
96−data RuntimeState = RuntimeState
97− { hakyllAnalyzer :: DependencyAnalyzer (Identifier ())
98− , hakyllCompilers :: Map (Identifier ()) (Compiler () CompiledItem)
99− }
10090
91+--------------------------------------------------------------------------------
10192newtype Runtime a = Runtime
102− { unRuntime :: ReaderT RuntimeEnvironment
103− (StateT RuntimeState (ErrorT String IO)) a
93+ { unRuntime :: ReaderT RuntimeEnvironment (ErrorT String IO) a
10494 } deriving (Functor, Applicative, Monad)
10595
106−-- | Add a number of compilers and continue using these compilers
107−--
108−addNewCompilers :: [(Identifier (), Compiler () CompiledItem)]
109− -- ^ Compilers to add
110− -> Runtime ()
111−addNewCompilers newCompilers = Runtime $ do
112− -- Get some information
113− logger <- hakyllLogger <$> ask
114− section logger "Adding new compilers"
115− provider <- hakyllResourceProvider <$> ask
116− firstRun <- hakyllFirstRun <$> ask
117−
118− -- Old state information
119− oldCompilers <- hakyllCompilers <$> get
120− oldAnalyzer <- hakyllAnalyzer <$> get
121−
122− let -- All known compilers
123− universe = M.keys oldCompilers ++ map fst newCompilers
124−
125− -- Create a new partial dependency graph
126− dependencies = flip map newCompilers $ \(id', compiler) ->
127− let deps = runCompilerDependencies compiler id' universe
128− in (id', deps)
129−
130− -- Create the dependency graph
131− newGraph = fromList dependencies
132−
133− -- Check which items have been modified
134− modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $
135− liftIO . resourceModified provider
136− let checkModified = if firstRun then const True else (`S.member` modified)
137−
138− -- Create a new analyzer and append it to the currect one
139− let newAnalyzer = makeDependencyAnalyzer newGraph checkModified $
140− analyzerPreviousGraph oldAnalyzer
141− analyzer = mappend oldAnalyzer newAnalyzer
142−
143− -- Update the state
144− put $ RuntimeState
145− { hakyllAnalyzer = analyzer
146− , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)
147− }
148−
149− -- Continue
150− unRuntime stepAnalyzer
151−
152−stepAnalyzer :: Runtime ()
153−stepAnalyzer = Runtime $ do
154− -- Step the analyzer
155− state <- get
156− let (signal, analyzer') = step $ hakyllAnalyzer state
157− put $ state { hakyllAnalyzer = analyzer' }
158−
159− case signal of Done -> return ()
160− Cycle c -> unRuntime $ dumpCycle c
161− Build id' -> unRuntime $ build id'
16296
97+--------------------------------------------------------------------------------
98+analyzeAndBuild :: Runtime ()
99+analyzeAndBuild = Runtime $ do
100+ -- Get some stuff
101+ logger <- runtimeLogger <$> ask
102+ provider <- runtimeProvider <$> ask
103+ store <- runtimeStore <$> ask
104+ compilers <- runtimeCompilers <$> ask
105+
106+ -- Checking which items have been modified
107+ let universe = M.keys compilers
108+ modified <- timed logger "Checking for modified items" $
109+ fmap S.fromList $ flip filterM universe $
110+ liftIO . resourceModified provider
111+
112+ -- Fetch the old graph from the store. If we don't find it, we consider this
113+ -- to be the first run
114+ mOldGraph <- liftIO $ Store.get store graphKey
115+ let (firstRun, oldGraph) = case mOldGraph of Store.Found g -> (False, g)
116+ _ -> (True, mempty)
117+
118+ -- Create a new dependency graph
119+ graph = DG.fromList $
120+ flip map (M.toList compilers) $ \(id', compiler) ->
121+ let deps = runCompilerDependencies compiler id' universe
122+ in (id', S.toList deps)
123+
124+ ood | firstRun = const True
125+ | otherwise = (`S.member` modified)
126+
127+ -- Check for cycles and analyze the graph
128+ analysis = analyze oldGraph graph ood
129+
130+ -- Make sure this stuff is evaluated
131+ () <- timed logger "Analyzing dependency graph" $
132+ oldGraph `deepseq` analysis `deepseq` return ()
133+
134+ -- We want to save the new dependency graph for the next run
135+ liftIO $ Store.set store graphKey graph
136+
137+ case analysis of
138+ Cycle c -> unRuntime $ dumpCycle c
139+ Order o -> mapM_ (unRuntime . build) o
140+ where
141+ graphKey = ["Hakyll.Core.Run.run", "dependencies"]
142+
143+
144+--------------------------------------------------------------------------------
163145-- | Dump cyclic error and quit
164−--
165146dumpCycle :: [Identifier ()] -> Runtime ()
166147dumpCycle cycle' = Runtime $ do
167− logger <- hakyllLogger <$> ask
148+ logger <- runtimeLogger <$> ask
168149 section logger "Dependency cycle detected! Conflict:"
169150 forM_ (zip cycle' $ drop 1 cycle') $ \(x, y) ->
170151 report logger $ show x ++ " -> " ++ show y
171152
153+
154+--------------------------------------------------------------------------------
172155build :: Identifier () -> Runtime ()
173156build id' = Runtime $ do
174− logger <- hakyllLogger <$> ask
175− routes <- hakyllRoutes <$> ask
176− provider <- hakyllResourceProvider <$> ask
177− store <- hakyllStore <$> ask
178− compilers <- hakyllCompilers <$> get
157+ logger <- runtimeLogger <$> ask
158+ routes <- runtimeRoutes <$> ask
159+ provider <- runtimeProvider <$> ask
160+ store <- runtimeStore <$> ask
161+ compilers <- runtimeCompilers <$> ask
179162
180163 section logger $ "Compiling " ++ show id'
181164
@@ -197,13 +180,10 @@ build id' = Runtime $ do
197180 Nothing -> return ()
198181 Just url -> timed logger ("Routing to " ++ url) $ do
199182 destination <-
200− destinationDirectory . hakyllConfiguration <$> ask
183+ destinationDirectory . runtimeConfiguration <$> ask
201184 let path = destination </> url
202185 liftIO $ makeDirectories path
203186 liftIO $ write path compiled
204187
205− -- Continue for the remaining compilers
206− unRuntime stepAnalyzer
207−
208188 -- Some error happened, rethrow in Runtime monad
209189 Left err -> throwError err