git.iko.soy/hakyll
on 5dba607 help sign in
hakyll/src/Hakyll/Core/Run.hs
215 lines 7.7 kB history raw
1-- | This is the module which binds it all together
2--
3{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}
4module Hakyll.Core.Run
5 ( run
6 ) where
8import Control.Applicative (Applicative, (<$>))
9import Control.Monad (filterM, forM_)
10import Control.Monad.Error (ErrorT, runErrorT, throwError)
11import Control.Monad.Reader (ReaderT, runReaderT, ask)
12import Control.Monad.State.Strict (StateT, runStateT, get, put)
13import Control.Monad.Trans (liftIO)
14import Data.Map (Map)
15import Data.Monoid (mempty, mappend)
16import Prelude hiding (reverse)
17import System.FilePath ((</>))
18import qualified Data.Map as M
19import qualified Data.Set as S
21import Hakyll.Core.Compiler
22import Hakyll.Core.Compiler.Internal
23import Hakyll.Core.Configuration
24import Hakyll.Core.DependencyAnalyzer
25import Hakyll.Core.DirectedGraph
26import Hakyll.Core.Identifier
27import Hakyll.Core.Logger
28import Hakyll.Core.Resource
29import Hakyll.Core.Resource.Provider
30import Hakyll.Core.Resource.Provider.File
31import Hakyll.Core.Routes
32import Hakyll.Core.Rules.Internal
33import Hakyll.Core.Store
34import Hakyll.Core.Util.File
35import Hakyll.Core.Writable
37-- | Run all rules needed, return the rule set used
38--
39run :: HakyllConfiguration -> RulesM a -> IO RuleSet
40run configuration rules = do
41 logger <- makeLogger putStrLn
43 section logger "Initialising"
44 store <- timed logger "Creating store" $
45 makeStore $ storeDirectory configuration
46 provider <- timed logger "Creating provider" $
47 fileResourceProvider configuration
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 <- storeGet store "Hakyll.Core.Run.run" "dependencies"
52 let (firstRun, oldGraph) = case graph of Found g -> (False, g)
53 _ -> (True, mempty)
55 let ruleSet = runRules rules provider
56 compilers = rulesCompilers ruleSet
58 -- 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
67 }
69 -- 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 }
75 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 storeSet store "Hakyll.Core.Run.run" "dependencies" $
81 analyzerGraph $ hakyllAnalyzer state'
83 -- Flush and return
84 flushLogger logger
85 return ruleSet
87data RuntimeEnvironment = RuntimeEnvironment
88 { hakyllLogger :: Logger
89 , hakyllConfiguration :: HakyllConfiguration
90 , hakyllRoutes :: Routes
91 , hakyllResourceProvider :: ResourceProvider
92 , hakyllStore :: Store
93 , hakyllFirstRun :: Bool
94 }
96data RuntimeState = RuntimeState
97 { hakyllAnalyzer :: DependencyAnalyzer (Identifier ())
98 , hakyllCompilers :: Map (Identifier ()) (Compiler () CompileRule)
99 }
101newtype Runtime a = Runtime
102 { unRuntime :: ReaderT RuntimeEnvironment
103 (StateT RuntimeState (ErrorT String IO)) a
104 } deriving (Functor, Applicative, Monad)
106-- | Add a number of compilers and continue using these compilers
107--
108addNewCompilers :: [(Identifier (), Compiler () CompileRule)]
109 -- ^ Compilers to add
110 -> Runtime ()
111addNewCompilers newCompilers = Runtime $ do
112 -- Get some information
113 logger <- hakyllLogger <$> ask
114 section logger "Adding new compilers"
115 provider <- hakyllResourceProvider <$> ask
116 store <- hakyllStore <$> ask
117 firstRun <- hakyllFirstRun <$> ask
119 -- Old state information
120 oldCompilers <- hakyllCompilers <$> get
121 oldAnalyzer <- hakyllAnalyzer <$> get
123 let -- All known compilers
124 universe = M.keys oldCompilers ++ map fst newCompilers
126 -- Create a new partial dependency graph
127 dependencies = flip map newCompilers $ \(id', compiler) ->
128 let deps = runCompilerDependencies compiler id' universe
129 in (id', deps)
131 -- Create the dependency graph
132 newGraph = fromList dependencies
134 -- Check which items have been modified
135 modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $
136 liftIO . resourceModified provider store . fromIdentifier
137 let checkModified = if firstRun then const True else (`S.member` modified)
139 -- Create a new analyzer and append it to the currect one
140 let newAnalyzer = makeDependencyAnalyzer newGraph checkModified $
141 analyzerPreviousGraph oldAnalyzer
142 analyzer = mappend oldAnalyzer newAnalyzer
144 -- Update the state
145 put $ RuntimeState
146 { hakyllAnalyzer = analyzer
147 , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)
148 }
150 -- Continue
151 unRuntime stepAnalyzer
153stepAnalyzer :: Runtime ()
154stepAnalyzer = Runtime $ do
155 -- Step the analyzer
156 state <- get
157 let (signal, analyzer') = step $ hakyllAnalyzer state
158 put $ state { hakyllAnalyzer = analyzer' }
160 case signal of Done -> return ()
161 Cycle c -> unRuntime $ dumpCycle c
162 Build id' -> unRuntime $ build id'
164-- | Dump cyclic error and quit
165--
166dumpCycle :: [Identifier ()] -> Runtime ()
167dumpCycle cycle' = Runtime $ do
168 logger <- hakyllLogger <$> ask
169 section logger "Dependency cycle detected! Conflict:"
170 forM_ (zip cycle' $ drop 1 cycle') $ \(x, y) ->
171 report logger $ show x ++ " -> " ++ show y
173build :: Identifier () -> Runtime ()
174build id' = Runtime $ do
175 logger <- hakyllLogger <$> ask
176 routes <- hakyllRoutes <$> ask
177 provider <- hakyllResourceProvider <$> ask
178 store <- hakyllStore <$> ask
179 compilers <- hakyllCompilers <$> get
181 section logger $ "Compiling " ++ show id'
183 -- Fetch the right compiler from the map
184 let compiler = compilers M.! id'
186 -- Check if the resource was modified
187 isModified <- liftIO $ resourceModified provider store $ fromIdentifier id'
189 -- Run the compiler
190 result <- timed logger "Total compile time" $ liftIO $
191 runCompiler compiler id' provider (M.keys compilers) routes
192 store isModified logger
194 case result of
195 -- Compile rule for one item, easy stuff
196 Right (CompileRule compiled) -> do
197 case runRoutes routes id' of
198 Nothing -> return ()
199 Just url -> timed logger ("Routing to " ++ url) $ do
200 destination <-
201 destinationDirectory . hakyllConfiguration <$> ask
202 let path = destination </> url
203 liftIO $ makeDirectories path
204 liftIO $ write path compiled
206 -- Continue for the remaining compilers
207 unRuntime stepAnalyzer
209 -- Metacompiler, slightly more complicated
210 Right (MetaCompileRule newCompilers) ->
211 -- Actually I was just kidding, it's not hard at all
212 unRuntime $ addNewCompilers newCompilers
214 -- Some error happened, rethrow in Runtime monad
215 Left err -> throwError err