git.iko.soy/hakyll
on master help sign in
Move hakyllWith to hakyll monad
c7d6383Jasper Van der Jeugt
src/Hakyll/Core/Run.hs+38−17
compare with master
unifiedsplit
@@ -1,7 +1,12 @@
1-- | This is the module which binds it all together
1-- | This is the module which binds it all together
2--
2--
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3module Hakyll.Core.Run where
4module Hakyll.Core.Run where
4
5
6+import Control.Applicative
7+import Control.Monad.Reader
8+import Control.Monad.State
9+import Control.Monad.Trans
5import Control.Arrow ((&&&))
10import Control.Arrow ((&&&))
6import Control.Monad (foldM, forM_, forM, filterM)
11import Control.Monad (foldM, forM_, forM, filterM)
7import Data.Map (Map)
12import Data.Map (Map)
@@ -34,10 +39,26 @@ hakyll :: Rules -> IO ()
34hakyll rules = do
39hakyll rules = do
35 store <- makeStore "_store"
40 store <- makeStore "_store"
36 provider <- fileResourceProvider
41 provider <- fileResourceProvider
42+ evalStateT
43+ (runReaderT
37− hakyllWith rules provider store
44+ (unHakyll (hakyllWith rules provider store)) undefined) undefined
38−
45+
46+data HakyllState = HakyllState
47+ { hakyllCompilers :: [(Identifier, Compiler () CompileRule)]
48+ }
49+
50+data HakyllEnvironment = HakyllEnvironment
51+ { hakyllRoute :: Route
39−hakyllWith :: Rules -> ResourceProvider -> Store -> IO ()
52+ , hakyllResourceProvider :: ResourceProvider
53+ , hakyllStore :: Store
54+ }
55+
56+newtype Hakyll a = Hakyll
57+ { unHakyll :: ReaderT HakyllEnvironment (StateT HakyllState IO) a
58+ } deriving (Functor, Applicative, Monad)
59+
60+hakyllWith :: Rules -> ResourceProvider -> Store -> Hakyll ()
40−hakyllWith rules provider store = do
61+hakyllWith rules provider store = Hakyll $ do
41 let -- Get the rule set
62 let -- Get the rule set
42 ruleSet = runRules rules provider
63 ruleSet = runRules rules provider
43
64
@@ -55,17 +76,19 @@ hakyllWith rules provider store = do
55 -- Create the graph
76 -- Create the graph
56 graph = fromList dependencies
77 graph = fromList dependencies
57
78
79+ liftIO $ do
58− putStrLn "Writing dependency graph to dependencies.dot..."
80+ putStrLn "Writing dependency graph to dependencies.dot..."
59− writeDot "dependencies.dot" show graph
81+ writeDot "dependencies.dot" show graph
60
82
61 -- Check which items are up-to-date
83 -- Check which items are up-to-date
62− modified' <- modified provider store $ map fst compilers
84+ modified' <- liftIO $ modified provider store $ map fst compilers
63
85
64 let -- Try to reduce the graph
86 let -- Try to reduce the graph
65 reducedGraph = filterObsolete modified' graph
87 reducedGraph = filterObsolete modified' graph
66
88
89+ liftIO $ do
67− putStrLn "Writing reduced graph to reduced.dot..."
90+ putStrLn "Writing reduced graph to reduced.dot..."
68− writeDot "reduced.dot" show reducedGraph
91+ writeDot "reduced.dot" show reducedGraph
69
92
70 let -- Solve the graph
93 let -- Solve the graph
71 ordered = solveDependencies reducedGraph
94 ordered = solveDependencies reducedGraph
@@ -76,13 +99,10 @@ hakyllWith rules provider store = do
76 -- Fetch the routes
99 -- Fetch the routes
77 route' = rulesRoute ruleSet
100 route' = rulesRoute ruleSet
78
101
79− putStrLn $ show reducedGraph
80− putStrLn $ show ordered
81−
82 -- Generate all the targets in order
102 -- Generate all the targets in order
83 _ <- mapM (addTarget route' modified') orderedCompilers
103 _ <- mapM (addTarget route' modified') orderedCompilers
84
104
85− putStrLn "DONE."
105+ liftIO $ putStrLn "DONE."
86 where
106 where
87 addTarget route' modified' (id', comp) = do
107 addTarget route' modified' (id', comp) = do
88 let url = runRoute route' id'
108 let url = runRoute route' id'
@@ -91,18 +111,19 @@ hakyllWith rules provider store = do
91 let isModified = id' `S.member` modified'
111 let isModified = id' `S.member` modified'
92
112
93 -- Run the compiler
113 -- Run the compiler
114+ ItemRule compiled <- liftIO $
94− ItemRule compiled <- runCompiler comp id' provider url store isModified
115+ runCompiler comp id' provider url store isModified
95− putStrLn $ "Generated target: " ++ show id'
116+ liftIO $ putStrLn $ "Generated target: " ++ show id'
96
117
97 case url of
118 case url of
98 Nothing -> return ()
119 Nothing -> return ()
99− Just r -> do
120+ Just r -> liftIO $ do
100 putStrLn $ "Routing " ++ show id' ++ " to " ++ r
121 putStrLn $ "Routing " ++ show id' ++ " to " ++ r
101 let path = "_site" </> r
122 let path = "_site" </> r
102 makeDirectories path
123 makeDirectories path
103 write path compiled
124 write path compiled
104
125
105− putStrLn ""
126+ liftIO $ putStrLn ""
106
127
107-- | Return a set of modified identifiers
128-- | Return a set of modified identifiers
108--
129--