git.iko.soy/hakyll
on f104f91 help sign in
hakyll/src/Hakyll/Core/Run.hs
192 lines 6.6 kB history raw
1-- | This is the module which binds it all together
2--
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4module Hakyll.Core.Run where
6import Prelude hiding (reverse)
7import Control.Applicative
8import Control.Monad.Reader
9import Control.Monad.State
10import Control.Monad.Trans
11import Control.Arrow ((&&&))
12import Control.Monad (foldM, forM_, forM, filterM)
13import Data.Map (Map)
14import qualified Data.Map as M
15import Data.Monoid (mempty, mappend)
16import Data.Typeable (Typeable)
17import Data.Binary (Binary)
18import System.FilePath ((</>))
19import Data.Set (Set)
20import qualified Data.Set as S
22import Hakyll.Core.Route
23import Hakyll.Core.Identifier
24import Hakyll.Core.Util.File
25import Hakyll.Core.Compiler
26import Hakyll.Core.Compiler.Internal
27import Hakyll.Core.ResourceProvider
28import Hakyll.Core.ResourceProvider.FileResourceProvider
29import Hakyll.Core.Rules
30import Hakyll.Core.DirectedGraph
31import Hakyll.Core.DirectedGraph.Dot
32import Hakyll.Core.DirectedGraph.DependencySolver
33import Hakyll.Core.Writable
34import Hakyll.Core.Store
35import Hakyll.Core.CompiledItem
37hakyll :: Rules -> IO ()
38hakyll rules = do
39 store <- makeStore "_store"
40 provider <- fileResourceProvider
41 let ruleSet = runRules rules provider
42 compilers = rulesCompilers ruleSet
44 -- Extract the reader/state
45 reader = unHakyll $ addNewCompilers [] compilers
46 state' = runReaderT reader $ env ruleSet provider store
48 evalStateT state' state
49 where
50 env ruleSet provider store = HakyllEnvironment
51 { hakyllRoute = rulesRoute ruleSet
52 , hakyllResourceProvider = provider
53 , hakyllStore = store
54 }
56 state = HakyllState
57 { hakyllModified = S.empty
58 , hakyllGraph = mempty
59 }
61data HakyllEnvironment = HakyllEnvironment
62 { hakyllRoute :: Route
63 , hakyllResourceProvider :: ResourceProvider
64 , hakyllStore :: Store
65 }
67data HakyllState = HakyllState
68 { hakyllModified :: Set Identifier
69 , hakyllGraph :: DirectedGraph Identifier
70 }
72newtype Hakyll a = Hakyll
73 { unHakyll :: ReaderT HakyllEnvironment (StateT HakyllState IO) a
74 } deriving (Functor, Applicative, Monad)
76-- | Return a set of modified identifiers
77--
78modified :: ResourceProvider -- ^ Resource provider
79 -> Store -- ^ Store
80 -> [Identifier] -- ^ Identifiers to check
81 -> IO (Set Identifier) -- ^ Modified resources
82modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->
83 if resourceExists provider id' then resourceModified provider id' store
84 else return False
86-- | Add a number of compilers and continue using these compilers
87--
88addNewCompilers :: [(Identifier, Compiler () CompileRule)]
89 -- ^ Remaining compilers yet to be run
90 -> [(Identifier, Compiler () CompileRule)]
91 -- ^ Compilers to add
92 -> Hakyll ()
93addNewCompilers oldCompilers newCompilers = Hakyll $ do
94 -- Get some information
95 provider <- hakyllResourceProvider <$> ask
96 store <- hakyllStore <$> ask
98 let -- All compilers
99 compilers = oldCompilers ++ newCompilers
101 -- Get all dependencies for the compilers
102 dependencies = flip map compilers $ \(id', compiler) ->
103 let deps = runCompilerDependencies compiler provider
104 in (id', deps)
106 -- Create a compiler map (Id -> Compiler)
107 compilerMap = M.fromList compilers
109 -- Create the dependency graph
110 currentGraph = fromList dependencies
112 -- Find the old graph and append the new graph to it. This forms the
113 -- complete graph
114 completeGraph <- mappend currentGraph . hakyllGraph <$> get
116 liftIO $ writeDot "dependencies.dot" show completeGraph
118 -- Check which items are up-to-date. This only needs to happen for the new
119 -- compilers
120 oldModified <- hakyllModified <$> get
121 newModified <- liftIO $ modified provider store $ map fst newCompilers
123 let modified' = oldModified `S.union` newModified
125 -- Find obsolete items. Every item that is reachable from a modified
126 -- item is considered obsolete. From these obsolete items, we are only
127 -- interested in ones that are in the current subgraph.
128 obsolete = S.filter (`member` currentGraph)
129 $ reachableNodes modified' $ reverse completeGraph
131 -- Solve the graph and retain only the obsolete items
132 ordered = filter (`S.member` obsolete) $ solveDependencies currentGraph
134 -- Join the order with the compilers again
135 orderedCompilers = map (id &&& (compilerMap M.!)) ordered
137 liftIO $ putStrLn "Adding compilers..."
138 liftIO $ putStrLn $ "Added: " ++ show (map fst orderedCompilers)
140 modify $ updateState modified' completeGraph
142 -- Now run the ordered list of compilers
143 unHakyll $ runCompilers orderedCompilers
144 where
145 -- Add the modified information for the new compilers
146 updateState modified' graph state = state
147 { hakyllModified = modified'
148 , hakyllGraph = graph
149 }
151runCompilers :: [(Identifier, Compiler () CompileRule)]
152 -- ^ Ordered list of compilers
153 -> Hakyll ()
154 -- ^ No result
155runCompilers [] = return ()
156runCompilers ((id', compiler) : compilers) = Hakyll $ do
157 -- Obtain information
158 route' <- hakyllRoute <$> ask
159 provider <- hakyllResourceProvider <$> ask
160 store <- hakyllStore <$> ask
161 modified' <- hakyllModified <$> get
163 let -- Determine the URL
164 url = runRoute route' id'
166 -- Check if the resource was modified
167 isModified = id' `S.member` modified'
169 -- Run the compiler
170 result <- liftIO $ runCompiler compiler id' provider url store isModified
171 liftIO $ putStrLn $ "Generated target: " ++ show id'
173 case result of
174 -- Compile rule for one item, easy stuff
175 CompileRule compiled -> do
176 case url of
177 Nothing -> return ()
178 Just r -> liftIO $ do
179 putStrLn $ "Routing " ++ show id' ++ " to " ++ r
180 let path = "_site" </> r
181 makeDirectories path
182 write path compiled
184 liftIO $ putStrLn ""
186 -- Continue for the remaining compilers
187 unHakyll $ runCompilers compilers
189 -- Metacompiler, slightly more complicated
190 MetaCompileRule newCompilers ->
191 -- Actually I was just kidding, it's not hard at all
192 unHakyll $ addNewCompilers compilers newCompilers