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
116import Prelude hiding ((.), id)
117import Control.Arrow ((>>>), (&&&), arr, first)
118import Control.Applicative ((<$>))
119import Control.Exception (SomeException, handle)
120import Control.Monad.Reader (ask)
121import Control.Monad.Trans (liftIO)
122import Control.Monad.Error (throwError)
123import Control.Category (Category, (.), id)
124import Data.List (find)
125import System.Environment (getProgName)
126import System.FilePath (takeExtension)
128import Data.Binary (Binary)
129import Data.Typeable (Typeable)
130import Data.ByteString.Lazy (ByteString)
132import Hakyll.Core.Identifier
133import Hakyll.Core.Identifier.Pattern
134import Hakyll.Core.CompiledItem
135import Hakyll.Core.Writable
136import Hakyll.Core.ResourceProvider
137import Hakyll.Core.Compiler.Internal
138import Hakyll.Core.Store (Store)
139import Hakyll.Core.Rules.Internal
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 () CompileRule -- ^ 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 CompileRule) -- ^ 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 (CompileRule (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
193-- | Get the resource we are compiling as a string
195getResourceString :: Compiler a String
196getResourceString = getResourceWith resourceString
198-- | Get the resource we are compiling as a lazy bytestring
200getResourceLBS :: Compiler a ByteString
201getResourceLBS = getResourceWith resourceLBS
203-- | Overloadable function for 'getResourceString' and 'getResourceLBS'
205getResourceWith :: (Identifier a -> IO b) -> Compiler c b
206getResourceWith reader = fromJob $ \_ -> CompilerM $ do
207 provider <- compilerResourceProvider <$> ask
208 r <- compilerIdentifier <$> ask
209 let filePath = toFilePath r
210 if resourceExists provider r
211 then liftIO $ reader $ castIdentifier r
212 else throwError $ error' filePath
214 error' id' = "Hakyll.Core.Compiler.getResourceWith: resource "
215 ++ show id' ++ " not found"
217-- | Auxiliary: get a dependency
219getDependency :: (Binary a, Writable a, Typeable a)
220 => Identifier a -> CompilerM a
221getDependency id' = CompilerM $ do
222 store <- compilerStore <$> ask
224 Store.get store ["Hakyll.Core.Compiler.runCompiler", show id']
226 Store.NotFound -> throwError notFound
227 Store.WrongType e r -> throwError $ wrongType e r
228 Store.Found x -> return x
231 "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was " ++
232 "not found in the cache, the cache might be corrupted or " ++
233 "the item you are referring to might not exist"
235 "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was found " ++
236 "in the cache, but does not have the right type: expected " ++ show e ++
237 " but got " ++ show r
239-- | Variant of 'require' which drops the current value
241require_ :: (Binary a, Typeable a, Writable a)
245 fromDependency identifier >>> fromJob (const $ getDependency identifier)
247-- | Require another target. Using this function ensures automatic handling of
250require :: (Binary a, Typeable a, Writable a)
254require identifier = requireA identifier . arr . uncurry
256-- | Arrow-based variant of 'require'
258requireA :: (Binary a, Typeable a, Writable a)
262requireA identifier = (id &&& require_ identifier >>>)
264-- | Variant of 'requireAll' which drops the current value
266requireAll_ :: (Binary a, Typeable a, Writable a)
269requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'
271 getDeps = map castIdentifier . filterMatches pattern . map castIdentifier
272 requireAll_' = const $ CompilerM $ do
273 deps <- getDeps . compilerUniverse <$> ask
274 mapM (unCompilerM . getDependency) deps
276-- | Require a number of targets. Using this function ensures automatic handling
279requireAll :: (Binary a, Typeable a, Writable a)
283requireAll pattern = requireAllA pattern . arr . uncurry
285-- | Arrow-based variant of 'requireAll'
287requireAllA :: (Binary a, Typeable a, Writable a)
289 -> Compiler (b, [a]) c
291requireAllA pattern = (id &&& requireAll_ pattern >>>)
293cached :: (Binary a, Typeable a, Writable a)
297cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
298 logger <- compilerLogger <$> ask
299 identifier <- castIdentifier . compilerIdentifier <$> ask
300 store <- compilerStore <$> ask
301 modified <- compilerResourceModified <$> ask
302 progName <- liftIO getProgName
303 report logger $ "Checking cache: " ++ if modified then "modified" else "OK"
305 then do v <- unCompilerM $ j ()
306 liftIO $ Store.set store [name, show identifier] v
308 else do v <- liftIO $ Store.get store [name, show identifier]
309 case v of Store.Found v' -> return v'
310 _ -> throwError (error' progName)
313 "Hakyll.Core.Compiler.cached: Cache corrupt! " ++
314 "Try running: " ++ progName ++ " clean"
316-- | Create an unsafe compiler from a function in IO
318unsafeCompiler :: (a -> IO b) -- ^ Function to lift
319 -> Compiler a b -- ^ Resulting compiler
320unsafeCompiler f = fromJob $ CompilerM . liftIO . f
322-- | Compiler for debugging purposes
324traceShowCompiler :: Show a => Compiler a a
325traceShowCompiler = fromJob $ \x -> CompilerM $ do
326 logger <- compilerLogger <$> ask
327 report logger $ show x
330-- | Log and time a compiler
332timedCompiler :: String -- ^ Message
333 -> Compiler a b -- ^ Compiler to time
334 -> Compiler a b -- ^ Resulting compiler
335timedCompiler msg (Compiler d j) = Compiler d $ \x -> CompilerM $ do
336 logger <- compilerLogger <$> ask
337 timed logger msg $ unCompilerM $ j x
339-- | Choose a compiler by identifier
341-- For example, assume that most content files need to be compiled
342-- normally, but a select few need an extra step in the pipeline:
344-- > compile $ pageCompiler >>> byPattern id
345-- > [ ("projects.md", addProjectListCompiler)
346-- > , ("sitemap.md", addSiteMapCompiler)
349byPattern :: Compiler a b -- ^ Default compiler
350 -> [(Pattern (), Compiler a b)] -- ^ Choices
351 -> Compiler a b -- ^ Resulting compiler
352byPattern defaultCompiler choices = Compiler deps job
354 -- Lookup the compiler, give an error when it is not found
355 lookup' identifier = maybe defaultCompiler snd $
356 find (\(p, _) -> matches p identifier) choices
357 -- Collect the dependencies of the choice
359 identifier <- castIdentifier . dependencyIdentifier <$> ask
360 compilerDependencies $ lookup' identifier
361 -- Collect the job of the choice
362 job x = CompilerM $ do
363 identifier <- castIdentifier . compilerIdentifier <$> ask
364 unCompilerM $ compilerJob (lookup' identifier) x
366-- | Choose a compiler by extension
370-- > match "css/*" $ do
371-- > route $ setExtension "css"
372-- > compile $ byExtension (error "Not a (S)CSS file")
373-- > [ (".css", compressCssCompiler)
374-- > , (".scss", sass)
377-- This piece of code will select the @compressCssCompiler@ for @.css@ files,
378-- and the @sass@ compiler (defined elsewhere) for @.scss@ files.
380byExtension :: Compiler a b -- ^ Default compiler
381 -> [(String, Compiler a b)] -- ^ Choices
382 -> Compiler a b -- ^ Resulting compiler
383byExtension defaultCompiler = byPattern defaultCompiler . map (first extPattern)
385 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