@@ -1,189 +0,0 @@
1−--------------------------------------------------------------------------------
2−-- | This is the module which binds it all together
3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−module Hakyll.Core.Run
6− ( run
7− ) where
8−
9−
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−--------------------------------------------------------------------------------
44−-- | Run all rules needed, return the rule set used
45−run :: HakyllConfiguration -> RulesM a -> IO RuleSet
46−run configuration rules = do
47− logger <- makeLogger putStrLn
48−
49− section logger "Initialising"
50− store <- timed logger "Creating store" $
51− Store.new (inMemoryCache configuration) $ storeDirectory configuration
52− provider <- timed logger "Creating provider" $ newResourceProvider
53− store (ignoreFile configuration) "."
54−
55− ruleSet <- timed logger "Running rules" $ runRules rules provider
56− let compilers = rulesCompilers ruleSet
57−
58− -- Extract the reader/state
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
67− }
68−
69− -- Run the program and fetch the resulting state
70− result <- runErrorT errorT
71− case result of
72− Left e -> thrown logger e
73− _ -> return ()
74−
75− -- Flush and return
76− flushLogger logger
77− return ruleSet
78−
79−
80−--------------------------------------------------------------------------------
81−data RuntimeEnvironment = RuntimeEnvironment
82− { runtimeLogger :: Logger
83− , runtimeConfiguration :: HakyllConfiguration
84− , runtimeRoutes :: Routes
85− , runtimeProvider :: ResourceProvider
86− , runtimeStore :: Store
87− , runtimeCompilers :: Map (Identifier ()) (Compiler () CompiledItem)
88− }
89−
90−
91−--------------------------------------------------------------------------------
92−newtype Runtime a = Runtime
93− { unRuntime :: ReaderT RuntimeEnvironment (ErrorT String IO) a
94− } deriving (Functor, Applicative, Monad)
95−
96−
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−--------------------------------------------------------------------------------
145−-- | Dump cyclic error and quit
146−dumpCycle :: [Identifier ()] -> Runtime ()
147−dumpCycle cycle' = Runtime $ do
148− logger <- runtimeLogger <$> ask
149− section logger "Dependency cycle detected! Conflict:"
150− forM_ (zip cycle' $ drop 1 cycle') $ \(x, y) ->
151− report logger $ show x ++ " -> " ++ show y
152−
153−
154−--------------------------------------------------------------------------------
155−build :: Identifier () -> Runtime ()
156−build id' = Runtime $ do
157− logger <- runtimeLogger <$> ask
158− routes <- runtimeRoutes <$> ask
159− provider <- runtimeProvider <$> ask
160− store <- runtimeStore <$> ask
161− compilers <- runtimeCompilers <$> ask
162−
163− section logger $ "Compiling " ++ show id'
164−
165− -- Fetch the right compiler from the map
166− let compiler = compilers M.! id'
167−
168− -- Check if the resource was modified
169− isModified <- liftIO $ resourceModified provider id'
170−
171− -- Run the compiler
172− result <- timed logger "Total compile time" $ liftIO $
173− runCompiler compiler id' provider (M.keys compilers) routes
174− store isModified logger
175−
176− case result of
177− -- Success
178− Right compiled -> do
179− case runRoutes routes id' of
180− Nothing -> return ()
181− Just url -> timed logger ("Routing to " ++ url) $ do
182− destination <-
183− destinationDirectory . runtimeConfiguration <$> ask
184− let path = destination </> url
185− liftIO $ makeDirectories path
186− liftIO $ write path compiled
187−
188− -- Some error happened, rethrow in Runtime monad
189− Left err -> throwError err