on master help sign in
Restructure hakyllWith for metacompilers
9e88440Jasper Van der Jeugt
src/Hakyll/Core/Run.hs+81−60
@@ -39,98 +39,119 @@ hakyll :: Rules -> IO ()
39hakyll rules = do
39hakyll rules = do
40 store <- makeStore "_store"
40 store <- makeStore "_store"
41 provider <- fileResourceProvider
41 provider <- fileResourceProvider
42− evalStateT
42+ let ruleSet = runRules rules provider
43− (runReaderT
43+ compilers = rulesCompilers ruleSet
44− (unHakyll (hakyllWith rules provider store)) undefined) undefined
44+ runReaderT (unHakyll (addNewCompilers [] compilers)) $
45−
45+ env ruleSet provider store
46−data HakyllState = HakyllState
46+ where
47− { hakyllCompilers :: [(Identifier, Compiler () CompileRule)]
47+ env ruleSet provider store = HakyllEnvironment
48+ { hakyllRoute = rulesRoute ruleSet
49+ , hakyllResourceProvider = provider
50+ , hakyllStore = store
51+ , hakyllModified = S.empty
48− }
52+ }
49
53
50data HakyllEnvironment = HakyllEnvironment
54data HakyllEnvironment = HakyllEnvironment
51 { hakyllRoute :: Route
55 { hakyllRoute :: Route
52 , hakyllResourceProvider :: ResourceProvider
56 , hakyllResourceProvider :: ResourceProvider
53 , hakyllStore :: Store
57 , hakyllStore :: Store
58+ , hakyllModified :: Set Identifier
54 }
59 }
55
60
56newtype Hakyll a = Hakyll
61newtype Hakyll a = Hakyll
57− { unHakyll :: ReaderT HakyllEnvironment (StateT HakyllState IO) a
62+ { unHakyll :: ReaderT HakyllEnvironment IO a
58 } deriving (Functor, Applicative, Monad)
63 } deriving (Functor, Applicative, Monad)
59
64
60−hakyllWith :: Rules -> ResourceProvider -> Store -> Hakyll ()
65+-- | Return a set of modified identifiers
61−hakyllWith rules provider store = Hakyll $ do
66+--
62− let -- Get the rule set
67+modified :: ResourceProvider -- ^ Resource provider
63− ruleSet = runRules rules provider
68+ -> Store -- ^ Store
64−
69+ -> [Identifier] -- ^ Identifiers to check
65− -- Get all identifiers and compilers
70+ -> IO (Set Identifier) -- ^ Modified resources
66− compilers = rulesCompilers ruleSet
71+modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->
72+ if resourceExists provider id' then resourceModified provider id' store
73+ else return False
67
74
75+-- | Add a number of compilers and continue using these compilers
76+--
77+addNewCompilers :: [(Identifier, Compiler () CompileRule)]
78+ -- ^ Remaining compilers yet to be run
79+ -> [(Identifier, Compiler () CompileRule)]
80+ -- ^ Compilers to add
81+ -> Hakyll ()
82+addNewCompilers oldCompilers newCompilers = Hakyll $ do
83+ -- Get some information
84+ provider <- hakyllResourceProvider <$> ask
85+ store <- hakyllStore <$> ask
86+
87+ let -- All compilers
88+ compilers = oldCompilers ++ newCompilers
89+
68− -- Get all dependencies
90+ -- Get all dependencies for the compilers
69 dependencies = flip map compilers $ \(id', compiler) ->
91 dependencies = flip map compilers $ \(id', compiler) ->
70 let deps = runCompilerDependencies compiler provider
92 let deps = runCompilerDependencies compiler provider
71 in (id', deps)
93 in (id', deps)
72
94
73− -- Create a compiler map
95+ -- Create a compiler map (Id -> Compiler)
74 compilerMap = M.fromList compilers
96 compilerMap = M.fromList compilers
75
97
76− -- Create the graph
98+ -- Create the dependency graph
77 graph = fromList dependencies
99 graph = fromList dependencies
78
100
79− liftIO $ do
80− putStrLn "Writing dependency graph to dependencies.dot..."
81− writeDot "dependencies.dot" show graph
82−
83− -- Check which items are up-to-date
101+ -- Check which items are up-to-date. This only needs to happen for the new
102+ -- compilers
84 modified' <- liftIO $ modified provider store $ map fst compilers
103 modified' <- liftIO $ modified provider store $ map fst compilers
85
104
86− let -- Try to reduce the graph
105+ let -- Try to reduce the graph using this modified information
87 reducedGraph = filterObsolete modified' graph
106 reducedGraph = filterObsolete modified' graph
88
107
89− liftIO $ do
90− putStrLn "Writing reduced graph to reduced.dot..."
91− writeDot "reduced.dot" show reducedGraph
92−
93 let -- Solve the graph
108 let -- Solve the graph
94 ordered = solveDependencies reducedGraph
109 ordered = solveDependencies reducedGraph
95
110
96 -- Join the order with the compilers again
111 -- Join the order with the compilers again
97 orderedCompilers = map (id &&& (compilerMap M.!)) ordered
112 orderedCompilers = map (id &&& (compilerMap M.!)) ordered
98
113
99− -- Fetch the routes
114+ -- Now run the ordered list of compilers
100− route' = rulesRoute ruleSet
101−
102− -- Generate all the targets in order
103− _ <- mapM (addTarget route' modified') orderedCompilers
115+ local (updateModified modified') $ unHakyll $ runCompilers orderedCompilers
104−
105− liftIO $ putStrLn "DONE."
106 where
116 where
107− addTarget route' modified' (id', comp) = do
117+ -- Add the modified information for the new compilers
118+ updateModified modified' env = env
119+ { hakyllModified = hakyllModified env `S.union` modified'
120+ }
121+
122+runCompilers :: [(Identifier, Compiler () CompileRule)]
123+ -- ^ Ordered list of compilers
124+ -> Hakyll ()
125+ -- ^ No result
126+runCompilers [] = return ()
127+runCompilers ((id', compiler) : compilers) = Hakyll $ do
128+ -- Obtain information
129+ route' <- hakyllRoute <$> ask
130+ provider <- hakyllResourceProvider <$> ask
131+ store <- hakyllStore <$> ask
132+ modified' <- hakyllModified <$> ask
133+
134+ let -- Determine the URL
108− let url = runRoute route' id'
135+ url = runRoute route' id'
109−
136+
110 -- Check if the resource was modified
137 -- Check if the resource was modified
111− let isModified = id' `S.member` modified'
138+ isModified = id' `S.member` modified'
112
139
113− -- Run the compiler
140+ -- Run the compiler
114− ItemRule compiled <- liftIO $
115− runCompiler comp id' provider url store isModified
141+ result <- liftIO $ runCompiler compiler id' provider url store isModified
116− liftIO $ putStrLn $ "Generated target: " ++ show id'
142+ liftIO $ putStrLn $ "Generated target: " ++ show id'
117
143
118− case url of
144+ let ItemRule compiled = result
119− Nothing -> return ()
120− Just r -> liftIO $ do
121− putStrLn $ "Routing " ++ show id' ++ " to " ++ r
122− let path = "_site" </> r
123− makeDirectories path
124− write path compiled
125
145
146+ case url of
147+ Nothing -> return ()
126− liftIO $ putStrLn ""
148+ Just r -> liftIO $ do
149+ putStrLn $ "Routing " ++ show id' ++ " to " ++ r
150+ let path = "_site" </> r
151+ makeDirectories path
152+ write path compiled
127
153
128−-- | Return a set of modified identifiers
154+ liftIO $ putStrLn ""
129−--
155+
130−modified :: ResourceProvider -- ^ Resource provider
156+ -- Continue for the remaining compilers
131− -> Store -- ^ Store
157+ unHakyll $ runCompilers compilers
132− -> [Identifier] -- ^ Identifiers to check
133− -> IO (Set Identifier) -- ^ Modified resources
134−modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->
135− if resourceExists provider id' then resourceModified provider id' store
136− else return False