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
117import Prelude hiding ((.), id)
118import Control.Arrow ((>>>), (&&&), arr, first)
119import Control.Applicative ((<$>))
120import Control.Exception (SomeException, handle)
121import Control.Monad.Reader (ask)
122import Control.Monad.Trans (liftIO)
123import Control.Monad.Error (throwError)
124import Control.Category (Category, (.), id)
125import Data.List (find)
126import System.Environment (getProgName)
127import System.FilePath (takeExtension)
129import Data.Binary (Binary)
130import Data.Typeable (Typeable)
131import Data.ByteString.Lazy (ByteString)
133import Hakyll.Core.Identifier
134import Hakyll.Core.Identifier.Pattern
135import Hakyll.Core.CompiledItem
136import Hakyll.Core.Writable
137import Hakyll.Core.ResourceProvider
138import Hakyll.Core.Compiler.Internal
139import Hakyll.Core.Store (Store)
140import Hakyll.Core.Routes
141import Hakyll.Core.Logger
142import qualified Hakyll.Core.Store as Store
144-- | Run a compiler, yielding the resulting target and it's dependencies. This
145-- version of 'runCompilerJob' also stores the result
147runCompiler :: Compiler () CompiledItem -- ^ Compiler to run
148 -> Identifier () -- ^ Target identifier
149 -> ResourceProvider -- ^ Resource provider
150 -> [Identifier ()] -- ^ Universe
153 -> Bool -- ^ Was the resource modified?
154 -> Logger -- ^ Logger
155 -> IO (Throwing CompiledItem) -- ^ Resulting item
156runCompiler compiler id' provider universe routes store modified logger = do
157 -- Run the compiler job
158 result <- handle (\(e :: SomeException) -> return $ Left $ show e) $
159 runCompilerJob compiler id' provider universe routes store modified
162 -- Inspect the result
164 -- In case we compiled an item, we will store a copy in the cache first,
165 -- before we return control. This makes sure the compiled item can later
166 -- be accessed by e.g. require.
167 Right (CompiledItem x) ->
168 Store.set store ["Hakyll.Core.Compiler.runCompiler", show id'] x
170 -- Otherwise, we do nothing here
175-- | Get the identifier of the item that is currently being compiled
177getIdentifier :: Compiler a (Identifier b)
178getIdentifier = fromJob $ const $ CompilerM $
179 castIdentifier . compilerIdentifier <$> ask
181-- | Get the route we are using for this item
183getRoute :: Compiler a (Maybe FilePath)
184getRoute = getIdentifier >>> getRouteFor
186-- | Get the route for a specified item
188getRouteFor :: Compiler (Identifier a) (Maybe FilePath)
189getRouteFor = fromJob $ \identifier -> CompilerM $ do
190 routes <- compilerRoutes <$> ask
191 return $ runRoutes routes identifier
194--------------------------------------------------------------------------------
195-- | Get the body of the underlying resource
196getResourceBody :: Compiler a String
197getResourceBody = getResourceWith resourceBody
201--------------------------------------------------------------------------------
202-- | Get the resource we are compiling as a string
203getResourceString :: Compiler a String
204getResourceString = getResourceWith $ const resourceString
207--------------------------------------------------------------------------------
208-- | Get the resource we are compiling as a lazy bytestring
210getResourceLBS :: Compiler a ByteString
211getResourceLBS = getResourceWith $ const resourceLBS
214--------------------------------------------------------------------------------
215-- | Overloadable function for 'getResourceString' and 'getResourceLBS'
216getResourceWith :: (ResourceProvider -> Identifier a -> IO b) -> Compiler c b
217getResourceWith reader = fromJob $ \_ -> CompilerM $ do
218 provider <- compilerResourceProvider <$> ask
219 r <- compilerIdentifier <$> ask
220 let filePath = toFilePath r
221 if resourceExists provider r
222 then liftIO $ reader provider $ castIdentifier r
223 else throwError $ error' filePath
225 error' id' = "Hakyll.Core.Compiler.getResourceWith: resource "
226 ++ show id' ++ " not found"
228-- | Auxiliary: get a dependency
230getDependency :: (Binary a, Writable a, Typeable a)
231 => Identifier a -> CompilerM a
232getDependency id' = CompilerM $ do
233 store <- compilerStore <$> ask
235 Store.get store ["Hakyll.Core.Compiler.runCompiler", show id']
237 Store.NotFound -> throwError notFound
238 Store.WrongType e r -> throwError $ wrongType e r
239 Store.Found x -> return x
242 "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was " ++
243 "not found in the cache, the cache might be corrupted or " ++
244 "the item you are referring to might not exist"
246 "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was found " ++
247 "in the cache, but does not have the right type: expected " ++ show e ++
248 " but got " ++ show r
250-- | Variant of 'require' which drops the current value
252require_ :: (Binary a, Typeable a, Writable a)
256 fromDependency identifier >>> fromJob (const $ getDependency identifier)
258-- | Require another target. Using this function ensures automatic handling of
261require :: (Binary a, Typeable a, Writable a)
265require identifier = requireA identifier . arr . uncurry
267-- | Arrow-based variant of 'require'
269requireA :: (Binary a, Typeable a, Writable a)
273requireA identifier = (id &&& require_ identifier >>>)
275-- | Variant of 'requireAll' which drops the current value
277requireAll_ :: (Binary a, Typeable a, Writable a)
280requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'
282 getDeps = map castIdentifier . filterMatches pattern . map castIdentifier
283 requireAll_' = const $ CompilerM $ do
284 deps <- getDeps . compilerUniverse <$> ask
285 mapM (unCompilerM . getDependency) deps
287-- | Require a number of targets. Using this function ensures automatic handling
290requireAll :: (Binary a, Typeable a, Writable a)
294requireAll pattern = requireAllA pattern . arr . uncurry
296-- | Arrow-based variant of 'requireAll'
298requireAllA :: (Binary a, Typeable a, Writable a)
300 -> Compiler (b, [a]) c
302requireAllA pattern = (id &&& requireAll_ pattern >>>)
304cached :: (Binary a, Typeable a, Writable a)
308cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
309 logger <- compilerLogger <$> ask
310 identifier <- castIdentifier . compilerIdentifier <$> ask
311 store <- compilerStore <$> ask
312 modified <- compilerResourceModified <$> ask
313 progName <- liftIO getProgName
314 report logger $ "Checking cache: " ++ if modified then "modified" else "OK"
316 then do v <- unCompilerM $ j ()
317 liftIO $ Store.set store [name, show identifier] v
319 else do v <- liftIO $ Store.get store [name, show identifier]
320 case v of Store.Found v' -> return v'
321 _ -> throwError (error' progName)
324 "Hakyll.Core.Compiler.cached: Cache corrupt! " ++
325 "Try running: " ++ progName ++ " clean"
327-- | Create an unsafe compiler from a function in IO
329unsafeCompiler :: (a -> IO b) -- ^ Function to lift
330 -> Compiler a b -- ^ Resulting compiler
331unsafeCompiler f = fromJob $ CompilerM . liftIO . f
333-- | Compiler for debugging purposes
335traceShowCompiler :: Show a => Compiler a a
336traceShowCompiler = fromJob $ \x -> CompilerM $ do
337 logger <- compilerLogger <$> ask
338 report logger $ show x
341-- | Log and time a compiler
343timedCompiler :: String -- ^ Message
344 -> Compiler a b -- ^ Compiler to time
345 -> Compiler a b -- ^ Resulting compiler
346timedCompiler msg (Compiler d j) = Compiler d $ \x -> CompilerM $ do
347 logger <- compilerLogger <$> ask
348 timed logger msg $ unCompilerM $ j x
350-- | Choose a compiler by identifier
352-- For example, assume that most content files need to be compiled
353-- normally, but a select few need an extra step in the pipeline:
355-- > compile $ pageCompiler >>> byPattern id
356-- > [ ("projects.md", addProjectListCompiler)
357-- > , ("sitemap.md", addSiteMapCompiler)
360byPattern :: Compiler a b -- ^ Default compiler
361 -> [(Pattern (), Compiler a b)] -- ^ Choices
362 -> Compiler a b -- ^ Resulting compiler
363byPattern defaultCompiler choices = Compiler deps job
365 -- Lookup the compiler, give an error when it is not found
366 lookup' identifier = maybe defaultCompiler snd $
367 find (\(p, _) -> matches p identifier) choices
368 -- Collect the dependencies of the choice
370 identifier <- castIdentifier . dependencyIdentifier <$> ask
371 compilerDependencies $ lookup' identifier
372 -- Collect the job of the choice
373 job x = CompilerM $ do
374 identifier <- castIdentifier . compilerIdentifier <$> ask
375 unCompilerM $ compilerJob (lookup' identifier) x
377-- | Choose a compiler by extension
381-- > match "css/*" $ do
382-- > route $ setExtension "css"
383-- > compile $ byExtension (error "Not a (S)CSS file")
384-- > [ (".css", compressCssCompiler)
385-- > , (".scss", sass)
388-- This piece of code will select the @compressCssCompiler@ for @.css@ files,
389-- and the @sass@ compiler (defined elsewhere) for @.scss@ files.
391byExtension :: Compiler a b -- ^ Default compiler
392 -> [(String, Compiler a b)] -- ^ Choices
393 -> Compiler a b -- ^ Resulting compiler
394byExtension defaultCompiler = byPattern defaultCompiler . map (first extPattern)
396 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