1-- | A Compiler manages targets and dependencies between targets
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.
7-- Compilers are chained using the '>>>' arrow operation. If we have a compiler
9-- > getResourceString :: Compiler Resource String
11-- which reads the resource, and a compiler
13-- > readPage :: Compiler String (Page String)
15-- we can chain these two compilers to get a
17-- > (getResourceString >>> readPage) :: Compiler Resource (Page String)
19-- Most compilers can be created by combining smaller compilers using '>>>'.
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
24-- <http://en.wikibooks.org/wiki/Haskell/Understanding_arrows>
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.
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.
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:
38-- > read resource >>> pandoc render >>> layout >>> relativize URL's
40-- > @templates/fancy.html@
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.
46-- This is an example of where we need the @require@ function. We can solve
47-- this using a construction that looks like:
49-- > ... >>> pandoc render >>> require >>> layout >>> ...
51-- > @templates/fancy.html@ ------/
53-- This illustration can help us understand the type signature of 'require'.
55-- > require :: (Binary a, Typeable a, Writable a)
60-- Let's look at it in detail:
62-- > (Binary a, Typeable a, Writable a)
64-- These are constraints for the @a@ type. @a@ (the template) needs to have
65-- certain properties for it to be required.
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
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.
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!
87-- Note that require will fetch a previously compiled item: in our example of
88-- the type @a@. It is /very/ important that the compiler which produced this
89-- value, produced the right type as well!
91{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
92module Hakyll.Core.Compiler
118import Prelude hiding ((.), id)
119import Control.Arrow ((>>>), (&&&), arr, first)
120import Control.Applicative ((<$>))
121import Control.Exception (SomeException, handle)
122import Control.Monad.Reader (ask)
123import Control.Monad.Trans (liftIO)
124import Control.Monad.Error (throwError)
125import Control.Category (Category, (.), id)
126import Data.List (find)
127import System.Environment (getProgName)
128import System.FilePath (takeExtension)
130import Data.Binary (Binary)
131import Data.Typeable (Typeable)
132import Data.ByteString.Lazy (ByteString)
134import Hakyll.Core.Identifier
135import Hakyll.Core.Identifier.Pattern
136import Hakyll.Core.CompiledItem
137import Hakyll.Core.Writable
138import Hakyll.Core.Resource
139import Hakyll.Core.Resource.Provider
140import Hakyll.Core.Compiler.Internal
141import Hakyll.Core.Store (Store)
142import Hakyll.Core.Rules.Internal
143import Hakyll.Core.Routes
144import Hakyll.Core.Logger
145import qualified Hakyll.Core.Store as Store
147-- | Run a compiler, yielding the resulting target and it's dependencies. This
148-- version of 'runCompilerJob' also stores the result
150runCompiler :: Compiler () CompileRule -- ^ Compiler to run
151 -> Identifier () -- ^ Target identifier
152 -> ResourceProvider -- ^ Resource provider
153 -> [Identifier ()] -- ^ Universe
156 -> Bool -- ^ Was the resource modified?
157 -> Logger -- ^ Logger
158 -> IO (Throwing CompileRule) -- ^ Resulting item
159runCompiler compiler id' provider universe routes store modified logger = do
160 -- Run the compiler job
161 result <- handle (\(e :: SomeException) -> return $ Left $ show e) $
162 runCompilerJob compiler id' provider universe routes store modified
165 -- Inspect the result
167 -- In case we compiled an item, we will store a copy in the cache first,
168 -- before we return control. This makes sure the compiled item can later
169 -- be accessed by e.g. require.
170 Right (CompileRule (CompiledItem x)) ->
171 Store.set store ["Hakyll.Core.Compiler.runCompiler", show id'] x
173 -- Otherwise, we do nothing here
178-- | Get the identifier of the item that is currently being compiled
180getIdentifier :: Compiler a (Identifier b)
181getIdentifier = fromJob $ const $ CompilerM $
182 castIdentifier . compilerIdentifier <$> ask
184-- | Get the resource that is currently being compiled
186getResource :: Compiler a Resource
187getResource = getIdentifier >>> arr fromIdentifier
189-- | Get the route we are using for this item
191getRoute :: Compiler a (Maybe FilePath)
192getRoute = getIdentifier >>> getRouteFor
194-- | Get the route for a specified item
196getRouteFor :: Compiler (Identifier a) (Maybe FilePath)
197getRouteFor = fromJob $ \identifier -> CompilerM $ do
198 routes <- compilerRoutes <$> ask
199 return $ runRoutes routes identifier
201-- | Get the resource we are compiling as a string
203getResourceString :: Compiler Resource String
204getResourceString = getResourceWith resourceString
206-- | Get the resource we are compiling as a lazy bytestring
208getResourceLBS :: Compiler Resource ByteString
209getResourceLBS = getResourceWith resourceLBS
211-- | Overloadable function for 'getResourceString' and 'getResourceLBS'
213getResourceWith :: (Resource -> IO a) -> Compiler Resource a
214getResourceWith reader = fromJob $ \r -> CompilerM $ do
215 let filePath = unResource r
216 provider <- compilerResourceProvider <$> ask
217 if resourceExists provider r
218 then liftIO $ reader r
219 else throwError $ error' filePath
221 error' id' = "Hakyll.Core.Compiler.getResourceWith: resource "
222 ++ show id' ++ " not found"
224-- | Auxiliary: get a dependency
226getDependency :: (Binary a, Writable a, Typeable a)
227 => Identifier a -> CompilerM a
228getDependency id' = CompilerM $ do
229 store <- compilerStore <$> ask
231 Store.get store ["Hakyll.Core.Compiler.runCompiler", show id']
233 Store.NotFound -> throwError notFound
234 Store.WrongType e r -> throwError $ wrongType e r
235 Store.Found x -> return x
238 "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was " ++
239 "not found in the cache, the cache might be corrupted or " ++
240 "the item you are referring to might not exist"
242 "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was found " ++
243 "in the cache, but does not have the right type: expected " ++ show e ++
244 " but got " ++ show r
246-- | Variant of 'require' which drops the current value
248require_ :: (Binary a, Typeable a, Writable a)
252 fromDependency identifier >>> fromJob (const $ getDependency identifier)
254-- | Require another target. Using this function ensures automatic handling of
257require :: (Binary a, Typeable a, Writable a)
261require identifier = requireA identifier . arr . uncurry
263-- | Arrow-based variant of 'require'
265requireA :: (Binary a, Typeable a, Writable a)
269requireA identifier = (id &&& require_ identifier >>>)
271-- | Variant of 'requireAll' which drops the current value
273requireAll_ :: (Binary a, Typeable a, Writable a)
276requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'
278 getDeps = map castIdentifier . filterMatches pattern . map castIdentifier
279 requireAll_' = const $ CompilerM $ do
280 deps <- getDeps . compilerUniverse <$> ask
281 mapM (unCompilerM . getDependency) deps
283-- | Require a number of targets. Using this function ensures automatic handling
286requireAll :: (Binary a, Typeable a, Writable a)
290requireAll pattern = requireAllA pattern . arr . uncurry
292-- | Arrow-based variant of 'requireAll'
294requireAllA :: (Binary a, Typeable a, Writable a)
296 -> Compiler (b, [a]) c
298requireAllA pattern = (id &&& requireAll_ pattern >>>)
300cached :: (Binary a, Typeable a, Writable a)
302 -> Compiler Resource a
303 -> Compiler Resource a
304cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
305 logger <- compilerLogger <$> ask
306 identifier <- castIdentifier . compilerIdentifier <$> ask
307 store <- compilerStore <$> ask
308 modified <- compilerResourceModified <$> ask
309 progName <- liftIO getProgName
310 report logger $ "Checking cache: " ++ if modified then "modified" else "OK"
312 then do v <- unCompilerM $ j $ fromIdentifier identifier
313 liftIO $ Store.set store [name, show identifier] v
315 else do v <- liftIO $ Store.get store [name, show identifier]
316 case v of Store.Found v' -> return v'
317 _ -> throwError (error' progName)
320 "Hakyll.Core.Compiler.cached: Cache corrupt! " ++
321 "Try running: " ++ progName ++ " clean"
323-- | Create an unsafe compiler from a function in IO
325unsafeCompiler :: (a -> IO b) -- ^ Function to lift
326 -> Compiler a b -- ^ Resulting compiler
327unsafeCompiler f = fromJob $ CompilerM . liftIO . f
329-- | Compiler for debugging purposes
331traceShowCompiler :: Show a => Compiler a a
332traceShowCompiler = fromJob $ \x -> CompilerM $ do
333 logger <- compilerLogger <$> ask
334 report logger $ show x
337-- | Map over a compiler
339mapCompiler :: Compiler a b
341mapCompiler (Compiler d j) = Compiler d $ mapM j
343-- | Log and time a compiler
345timedCompiler :: String -- ^ Message
346 -> Compiler a b -- ^ Compiler to time
347 -> Compiler a b -- ^ Resulting compiler
348timedCompiler msg (Compiler d j) = Compiler d $ \x -> CompilerM $ do
349 logger <- compilerLogger <$> ask
350 timed logger msg $ unCompilerM $ j x
352-- | Choose a compiler by identifier
354-- For example, assume that most content files need to be compiled
355-- normally, but a select few need an extra step in the pipeline:
357-- > compile $ pageCompiler >>> byPattern id
358-- > [ ("projects.md", addProjectListCompiler)
359-- > , ("sitemap.md", addSiteMapCompiler)
362byPattern :: Compiler a b -- ^ Default compiler
363 -> [(Pattern (), Compiler a b)] -- ^ Choices
364 -> Compiler a b -- ^ Resulting compiler
365byPattern defaultCompiler choices = Compiler deps job
367 -- Lookup the compiler, give an error when it is not found
368 lookup' identifier = maybe defaultCompiler snd $
369 find (\(p, _) -> matches p identifier) choices
370 -- Collect the dependencies of the choice
372 identifier <- castIdentifier . dependencyIdentifier <$> ask
373 compilerDependencies $ lookup' identifier
374 -- Collect the job of the choice
375 job x = CompilerM $ do
376 identifier <- castIdentifier . compilerIdentifier <$> ask
377 unCompilerM $ compilerJob (lookup' identifier) x
379-- | Choose a compiler by extension
383-- > match "css/*" $ do
384-- > route $ setExtension "css"
385-- > compile $ byExtension (error "Not a (S)CSS file")
386-- > [ (".css", compressCssCompiler)
387-- > , (".scss", sass)
390-- This piece of code will select the @compressCssCompiler@ for @.css@ files,
391-- and the @sass@ compiler (defined elsewhere) for @.scss@ files.
393byExtension :: Compiler a b -- ^ Default compiler
394 -> [(String, Compiler a b)] -- ^ Choices
395 -> Compiler a b -- ^ Resulting compiler
396byExtension defaultCompiler = byPattern defaultCompiler . map (first extPattern)
398 extPattern c = predicate $ (== c) . takeExtension . toFilePath
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list