git.iko.soy/hakyll
on 5cc710d help sign in
hakyll/src/Hakyll/Core/Compiler.hs
340 lines 12 kB history raw
1-- | A Compiler manages targets and dependencies between targets
2--
3-- The most distinguishing property of a 'Compiler' is that it is an Arrow. A
4-- compiler of the type @Compiler a b@ is simply a compilation phase which takes
5-- an @a@ as input, and produces a @b@ as output.
6--
7-- Compilers are chained using the '>>>' arrow operation. If we have a compiler
8--
9-- > getResourceString :: Compiler Resource String
10--
11-- which reads the resource, and a compiler
12--
13-- > readPage :: Compiler String (Page String)
14--
15-- we can chain these two compilers to get a
16--
17-- > (getResourceString >>> readPage) :: Compiler Resource (Page String)
18--
19-- Most compilers can be created by combining smaller compilers using '>>>'.
20--
21-- More advanced constructions are also possible using arrow, and sometimes
22-- these are needed. For a good introduction to arrow, you can refer to
23--
24-- <http://en.wikibooks.org/wiki/Haskell/Understanding_arrows>
25--
26-- A construction worth writing a few paragraphs about here are the 'require'
27-- functions. Different variants of this function are exported here, but they
28-- all serve more or less the same goal.
29--
30-- When you use only '>>>' to chain your compilers, you get a linear pipeline --
31-- it is not possible to add extra items from other compilers along the way.
32-- This is where the 'require' functions come in.
33--
34-- This function allows you to reference other items, which are then added to
35-- the pipeline. Let's look at this crappy ASCII illustration which represents
36-- a pretty common scenario:
37--
38-- > read resource >>> pandoc render >>> layout >>> relativize URL's
39-- >
40-- > @templates/fancy.html@
41--
42-- We want to construct a pipeline of compilers to go from our resource to a
43-- proper webpage. However, the @layout@ compiler takes more than just the
44-- rendered page as input: it needs the @templates/fancy.html@ template as well.
45--
46-- This is an example of where we need the @require@ function. We can solve
47-- this using a construction that looks like:
48--
49-- > ... >>> pandoc render >>> require >>> layout >>> ...
50-- > |
51-- > @templates/fancy.html@ ------/
52--
53-- This illustration can help us understand the type signature of 'require'.
54--
55-- > require :: (Binary a, Typeable a, Writable a)
56-- > => Identifier
57-- > -> (b -> a -> c)
58-- > -> Compiler b c
59--
60-- Let's look at it in detail:
61--
62-- > (Binary a, Typeable a, Writable a)
63--
64-- These are constraints for the @a@ type. @a@ (the template) needs to have
65-- certain properties for it to be required.
66--
67-- > Identifier
68--
69-- This is simply @templates/fancy.html@: the 'Identifier' of the item we want
70-- to 'require', in other words, the name of the item we want to add to the
71-- pipeline somehow.
72--
73-- > (b -> a -> c)
74--
75-- This is a function given by the user, specifying /how/ the two items shall be
76-- merged. @b@ is the output of the previous compiler, and @a@ is the item we
77-- just required -- the template. This means @c@ will be the final output of the
78-- 'require' combinator.
79--
80-- > Compiler b c
81--
82-- Indeed, we have now constructed a compiler which takes a @b@ and produces a
83-- @c@. This means that we have a linear pipeline again, thanks to the 'require'
84-- function. So, the 'require' function actually helps to reduce to complexity
85-- of Hakyll applications!
86--
87{-# LANGUAGE GeneralizedNewtypeDeriving #-}
88module Hakyll.Core.Compiler
89 ( Compiler
90 , runCompiler
91 , getIdentifier
92 , getRoute
93 , getRouteFor
94 , getResourceString
95 , fromDependency
96 , require_
97 , require
98 , requireA
99 , requireAll_
100 , requireAll
101 , requireAllA
102 , cached
103 , unsafeCompiler
104 , traceShowCompiler
105 , mapCompiler
106 , timedCompiler
107 , byExtension
108 ) where
110import Prelude hiding ((.), id)
111import Control.Arrow ((>>>), (&&&), arr)
112import Control.Applicative ((<$>))
113import Control.Monad.Reader (ask)
114import Control.Monad.Trans (liftIO)
115import Control.Monad.Error (throwError)
116import Control.Category (Category, (.), id)
117import Data.Maybe (fromMaybe)
118import System.FilePath (takeExtension)
120import Data.Binary (Binary)
121import Data.Typeable (Typeable)
123import Hakyll.Core.Identifier
124import Hakyll.Core.Identifier.Pattern
125import Hakyll.Core.CompiledItem
126import Hakyll.Core.Writable
127import Hakyll.Core.ResourceProvider
128import Hakyll.Core.Compiler.Internal
129import Hakyll.Core.Store
130import Hakyll.Core.Rules.Internal
131import Hakyll.Core.Routes
132import Hakyll.Core.Logger
134-- | Run a compiler, yielding the resulting target and it's dependencies. This
135-- version of 'runCompilerJob' also stores the result
136--
137runCompiler :: Compiler () CompileRule -- ^ Compiler to run
138 -> Identifier -- ^ Target identifier
139 -> ResourceProvider -- ^ Resource provider
140 -> Routes -- ^ Route
141 -> Store -- ^ Store
142 -> Bool -- ^ Was the resource modified?
143 -> Logger -- ^ Logger
144 -> IO (Throwing CompileRule) -- ^ Resulting item
145runCompiler compiler identifier provider routes store modified logger = do
146 -- Run the compiler job
147 result <-
148 runCompilerJob compiler identifier provider routes store modified logger
150 -- Inspect the result
151 case result of
152 -- In case we compiled an item, we will store a copy in the cache first,
153 -- before we return control. This makes sure the compiled item can later
154 -- be accessed by e.g. require.
155 Right (CompileRule (CompiledItem x)) ->
156 storeSet store "Hakyll.Core.Compiler.runCompiler" identifier x
158 -- Otherwise, we do nothing here
159 _ -> return ()
161 return result
163-- | Get the identifier of the item that is currently being compiled
164--
165getIdentifier :: Compiler a Identifier
166getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask
168-- | Get the route we are using for this item
169--
170getRoute :: Compiler a (Maybe FilePath)
171getRoute = getIdentifier >>> getRouteFor
173-- | Get the route for a specified item
174--
175getRouteFor :: Compiler Identifier (Maybe FilePath)
176getRouteFor = fromJob $ \identifier -> CompilerM $ do
177 routes <- compilerRoutes <$> ask
178 return $ runRoutes routes identifier
180-- | Get the resource we are compiling as a string
181--
182getResourceString :: Compiler Resource String
183getResourceString = fromJob $ \resource -> CompilerM $ do
184 let identifier = unResource resource
185 provider <- compilerResourceProvider <$> ask
186 if resourceExists provider identifier
187 then liftIO $ resourceString provider resource
188 else throwError $ error' identifier
189 where
190 error' id' = "Hakyll.Core.Compiler.getResourceString: resource "
191 ++ show id' ++ " not found"
193-- | Auxiliary: get a dependency
194--
195getDependency :: (Binary a, Writable a, Typeable a)
196 => Identifier -> CompilerM a
197getDependency id' = CompilerM $ do
198 store <- compilerStore <$> ask
199 result <- liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" id'
200 case result of
201 Nothing -> throwError error'
202 Just x -> return x
203 where
204 error' = "Hakyll.Core.Compiler.getDependency: " ++ show id'
205 ++ " not found in the cache, the cache might be corrupted or"
206 ++ " the item you are referring to might not exist"
208-- | Variant of 'require' which drops the current value
209--
210require_ :: (Binary a, Typeable a, Writable a)
211 => Identifier
212 -> Compiler b a
213require_ identifier =
214 fromDependency identifier >>> fromJob (const $ getDependency identifier)
216-- | Require another target. Using this function ensures automatic handling of
217-- dependencies
218--
219require :: (Binary a, Typeable a, Writable a)
220 => Identifier
221 -> (b -> a -> c)
222 -> Compiler b c
223require identifier = requireA identifier . arr . uncurry
225-- | Arrow-based variant of 'require'
226--
227requireA :: (Binary a, Typeable a, Writable a)
228 => Identifier
229 -> Compiler (b, a) c
230 -> Compiler b c
231requireA identifier = (id &&& require_ identifier >>>)
233-- | Variant of 'requireAll' which drops the current value
234--
235requireAll_ :: (Binary a, Typeable a, Writable a)
236 => Pattern
237 -> Compiler b [a]
238requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'
239 where
240 getDeps = matches pattern . map unResource . resourceList
241 requireAll_' = const $ CompilerM $ do
242 deps <- getDeps . compilerResourceProvider <$> ask
243 mapM (unCompilerM . getDependency) deps
245-- | Require a number of targets. Using this function ensures automatic handling
246-- of dependencies
247--
248requireAll :: (Binary a, Typeable a, Writable a)
249 => Pattern
250 -> (b -> [a] -> c)
251 -> Compiler b c
252requireAll pattern = requireAllA pattern . arr . uncurry
254-- | Arrow-based variant of 'requireAll'
255--
256requireAllA :: (Binary a, Typeable a, Writable a)
257 => Pattern
258 -> Compiler (b, [a]) c
259 -> Compiler b c
260requireAllA pattern = (id &&& requireAll_ pattern >>>)
262cached :: (Binary a, Typeable a, Writable a)
263 => String
264 -> Compiler Resource a
265 -> Compiler Resource a
266cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
267 logger <- compilerLogger <$> ask
268 identifier <- compilerIdentifier <$> ask
269 store <- compilerStore <$> ask
270 modified <- compilerResourceModified <$> ask
271 report logger $ "Checking cache: " ++ if modified then "modified" else "OK"
272 if modified
273 then do v <- unCompilerM $ j $ Resource identifier
274 liftIO $ storeSet store name identifier v
275 return v
276 else do v <- liftIO $ storeGet store name identifier
277 case v of Just v' -> return v'
278 Nothing -> throwError error'
279 where
280 error' = "Hakyll.Core.Compiler.cached: Cache corrupt!"
282-- | Create an unsafe compiler from a function in IO
283--
284unsafeCompiler :: (a -> IO b) -- ^ Function to lift
285 -> Compiler a b -- ^ Resulting compiler
286unsafeCompiler f = fromJob $ CompilerM . liftIO . f
288-- | Compiler for debugging purposes
289--
290traceShowCompiler :: Show a => Compiler a a
291traceShowCompiler = fromJob $ \x -> CompilerM $ do
292 logger <- compilerLogger <$> ask
293 report logger $ show x
294 return x
296-- | Map over a compiler
297--
298mapCompiler :: Compiler a b
299 -> Compiler [a] [b]
300mapCompiler (Compiler d j) = Compiler d $ mapM j
302-- | Log and time a compiler
303--
304timedCompiler :: String -- ^ Message
305 -> Compiler a b -- ^ Compiler to time
306 -> Compiler a b -- ^ Resulting compiler
307timedCompiler msg (Compiler d j) = Compiler d $ \x -> CompilerM $ do
308 logger <- compilerLogger <$> ask
309 timed logger msg $ unCompilerM $ j x
311-- | Choose a compiler by extension
312--
313-- Example:
314--
315-- > route "css/*" $ setExtension "css"
316-- > compile "css/*" $ byExtension (error "Not a (S)CSS file")
317-- > [ (".css", compressCssCompiler)
318-- > , (".scss", sass)
319-- > ]
320--
321-- This piece of code will select the @compressCssCompiler@ for @.css@ files,
322-- and the @sass@ compiler (defined elsewhere) for @.scss@ files.
323--
324byExtension :: Compiler a b -- ^ Default compiler
325 -> [(String, Compiler a b)] -- ^ Choices
326 -> Compiler a b -- ^ Resulting compiler
327byExtension defaultCompiler choices = Compiler deps job
328 where
329 -- Lookup the compiler, give an error when it is not found
330 lookup' identifier =
331 let extension = takeExtension $ toFilePath identifier
332 in fromMaybe defaultCompiler $ lookup extension choices
333 -- Collect the dependencies of the choice
334 deps = do
335 identifier <- dependencyIdentifier <$> ask
336 compilerDependencies $ lookup' identifier
337 -- Collect the job of the choice
338 job x = CompilerM $ do
339 identifier <- compilerIdentifier <$> ask
340 unCompilerM $ compilerJob (lookup' identifier) x