git.iko.soy/hakyll
on c8a970d help sign in
hakyll/src/Hakyll/Core/Run.hs
211 lines 7.5 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 Prelude hiding (reverse)
9import Control.Monad (filterM, forM_)
10import Control.Monad.Trans (liftIO)
11import Control.Applicative (Applicative, (<$>))
12import Control.Monad.Reader (ReaderT, runReaderT, ask)
13import Control.Monad.State.Strict (StateT, runStateT, get, put)
14import Data.Map (Map)
15import qualified Data.Map as M
16import Data.Monoid (mempty, mappend)
17import System.FilePath ((</>))
18import qualified Data.Set as S
20import Hakyll.Core.Routes
21import Hakyll.Core.Identifier
22import Hakyll.Core.Util.File
23import Hakyll.Core.Compiler
24import Hakyll.Core.Compiler.Internal
25import Hakyll.Core.Resource
26import Hakyll.Core.Resource.Provider
27import Hakyll.Core.Resource.Provider.File
28import Hakyll.Core.Rules.Internal
29import Hakyll.Core.DirectedGraph
30import Hakyll.Core.DependencyAnalyzer
31import Hakyll.Core.Writable
32import Hakyll.Core.Store
33import Hakyll.Core.Configuration
34import Hakyll.Core.Logger
36-- | Run all rules needed, return the rule set used
37--
38run :: HakyllConfiguration -> RulesM a -> IO RuleSet
39run configuration rules = do
40 logger <- makeLogger putStrLn
42 section logger "Initialising"
43 store <- timed logger "Creating store" $
44 makeStore $ storeDirectory configuration
45 provider <- timed logger "Creating provider" $
46 fileResourceProvider configuration
48 -- Fetch the old graph from the store. If we don't find it, we consider this
49 -- to be the first run
50 graph <- storeGet store "Hakyll.Core.Run.run" "dependencies"
51 let (firstRun, oldGraph) = case graph of Found g -> (False, g)
52 _ -> (True, mempty)
54 let ruleSet = runRules rules provider
55 compilers = rulesCompilers ruleSet
57 -- Extract the reader/state
58 reader = unRuntime $ addNewCompilers compilers
59 stateT = runReaderT reader $ RuntimeEnvironment
60 { hakyllLogger = logger
61 , hakyllConfiguration = configuration
62 , hakyllRoutes = rulesRoutes ruleSet
63 , hakyllResourceProvider = provider
64 , hakyllStore = store
65 , hakyllFirstRun = firstRun
66 }
68 -- Run the program and fetch the resulting state
69 ((), state') <- runStateT stateT $ RuntimeState
70 { hakyllAnalyzer = makeDependencyAnalyzer mempty (const False) oldGraph
71 , hakyllCompilers = M.empty
72 }
74 -- We want to save the final dependency graph for the next run
75 storeSet store "Hakyll.Core.Run.run" "dependencies" $
76 analyzerGraph $ hakyllAnalyzer state'
78 -- Flush and return
79 flushLogger logger
80 return ruleSet
82data RuntimeEnvironment = RuntimeEnvironment
83 { hakyllLogger :: Logger
84 , hakyllConfiguration :: HakyllConfiguration
85 , hakyllRoutes :: Routes
86 , hakyllResourceProvider :: ResourceProvider
87 , hakyllStore :: Store
88 , hakyllFirstRun :: Bool
89 }
91data RuntimeState = RuntimeState
92 { hakyllAnalyzer :: DependencyAnalyzer (Identifier ())
93 , hakyllCompilers :: Map (Identifier ()) (Compiler () CompileRule)
94 }
96newtype Runtime a = Runtime
97 { unRuntime :: ReaderT RuntimeEnvironment (StateT RuntimeState IO) a
98 } deriving (Functor, Applicative, Monad)
100-- | Add a number of compilers and continue using these compilers
101--
102addNewCompilers :: [(Identifier (), Compiler () CompileRule)]
103 -- ^ Compilers to add
104 -> Runtime ()
105addNewCompilers newCompilers = Runtime $ do
106 -- Get some information
107 logger <- hakyllLogger <$> ask
108 section logger "Adding new compilers"
109 provider <- hakyllResourceProvider <$> ask
110 store <- hakyllStore <$> ask
111 firstRun <- hakyllFirstRun <$> ask
113 -- Old state information
114 oldCompilers <- hakyllCompilers <$> get
115 oldAnalyzer <- hakyllAnalyzer <$> get
117 let -- All known compilers
118 universe = M.keys oldCompilers ++ map fst newCompilers
120 -- Create a new partial dependency graph
121 dependencies = flip map newCompilers $ \(id', compiler) ->
122 let deps = runCompilerDependencies compiler id' universe
123 in (id', deps)
125 -- Create the dependency graph
126 newGraph = fromList dependencies
128 -- Check which items have been modified
129 modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $
130 liftIO . resourceModified provider store . fromIdentifier
131 let checkModified = if firstRun then const True else (`S.member` modified)
133 -- Create a new analyzer and append it to the currect one
134 let newAnalyzer = makeDependencyAnalyzer newGraph checkModified $
135 analyzerPreviousGraph oldAnalyzer
136 analyzer = mappend oldAnalyzer newAnalyzer
138 -- Update the state
139 put $ RuntimeState
140 { hakyllAnalyzer = analyzer
141 , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)
142 }
144 -- Continue
145 unRuntime stepAnalyzer
147stepAnalyzer :: Runtime ()
148stepAnalyzer = Runtime $ do
149 -- Step the analyzer
150 state <- get
151 let (signal, analyzer') = step $ hakyllAnalyzer state
152 put $ state { hakyllAnalyzer = analyzer' }
154 case signal of Done -> return ()
155 Cycle c -> unRuntime $ dumpCycle c
156 Build id' -> unRuntime $ build id'
158-- | Dump cyclic error and quit
159--
160dumpCycle :: [Identifier ()] -> Runtime ()
161dumpCycle cycle' = Runtime $ do
162 logger <- hakyllLogger <$> ask
163 section logger "Dependency cycle detected! Conflict:"
164 forM_ (zip cycle' $ drop 1 cycle') $ \(x, y) ->
165 report logger $ show x ++ " -> " ++ show y
167build :: Identifier () -> Runtime ()
168build id' = Runtime $ do
169 logger <- hakyllLogger <$> ask
170 routes <- hakyllRoutes <$> ask
171 provider <- hakyllResourceProvider <$> ask
172 store <- hakyllStore <$> ask
173 compilers <- hakyllCompilers <$> get
175 section logger $ "Compiling " ++ show id'
177 -- Fetch the right compiler from the map
178 let compiler = compilers M.! id'
180 -- Check if the resource was modified
181 isModified <- liftIO $ resourceModified provider store $ fromIdentifier id'
183 -- Run the compiler
184 result <- timed logger "Total compile time" $ liftIO $
185 runCompiler compiler id' provider (M.keys compilers) routes
186 store isModified logger
188 case result of
189 -- Compile rule for one item, easy stuff
190 Right (CompileRule compiled) -> do
191 case runRoutes routes id' of
192 Nothing -> return ()
193 Just url -> timed logger ("Routing to " ++ url) $ do
194 destination <-
195 destinationDirectory . hakyllConfiguration <$> ask
196 let path = destination </> url
197 liftIO $ makeDirectories path
198 liftIO $ write path compiled
200 -- Continue for the remaining compilers
201 unRuntime stepAnalyzer
203 -- Metacompiler, slightly more complicated
204 Right (MetaCompileRule newCompilers) ->
205 -- Actually I was just kidding, it's not hard at all
206 unRuntime $ addNewCompilers newCompilers
208 -- Some error happened, log and continue
209 Left err -> do
210 thrown logger err
211 unRuntime stepAnalyzer