git.iko.soy/hakyll
on 8bbb8d4 help sign in
hakyll/src/Hakyll/Core/Compiler.hs
176 lines 6.5 kB history raw
1--------------------------------------------------------------------------------
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4module Hakyll.Core.Compiler
5 ( Compiler
6 , getUnderlying
7 , getUnderlyingExtension
8 , makeItem
9 , getRoute
10 , getResourceBody
11 , getResourceString
12 , getResourceLBS
13 , getResourceFilePath
15 , Internal.Snapshot
16 , saveSnapshot
17 , Internal.load
18 , Internal.loadSnapshot
19 , Internal.loadBody
20 , Internal.loadSnapshotBody
21 , Internal.loadAll
22 , Internal.loadAllSnapshots
24 , cached
25 , unsafeCompiler
26 , debugCompiler
27 ) where
30--------------------------------------------------------------------------------
31import Control.Applicative ((<$>))
32import Data.Binary (Binary)
33import Data.ByteString.Lazy (ByteString)
34import Data.Typeable (Typeable)
35import System.Environment (getProgName)
36import System.FilePath (takeExtension)
39--------------------------------------------------------------------------------
40import Hakyll.Core.Compiler.Internal
41import qualified Hakyll.Core.Compiler.Require as Internal
42import Hakyll.Core.Dependencies
43import Hakyll.Core.Identifier
44import Hakyll.Core.Item
45import Hakyll.Core.Logger as Logger
46import Hakyll.Core.Provider
47import Hakyll.Core.Routes
48import qualified Hakyll.Core.Store as Store
51--------------------------------------------------------------------------------
52-- | Get the underlying identifier.
53getUnderlying :: Compiler Identifier
54getUnderlying = compilerUnderlying <$> compilerAsk
57--------------------------------------------------------------------------------
58-- | Get the extension of the underlying identifier. Returns something like
59-- @".html"@
60getUnderlyingExtension :: Compiler String
61getUnderlyingExtension = takeExtension . toFilePath <$> getUnderlying
64--------------------------------------------------------------------------------
65makeItem :: a -> Compiler (Item a)
66makeItem x = do
67 identifier <- getUnderlying
68 return $ Item identifier x
71--------------------------------------------------------------------------------
72-- | Get the route for a specified item
73getRoute :: Identifier -> Compiler (Maybe FilePath)
74getRoute identifier = do
75 provider <- compilerProvider <$> compilerAsk
76 routes <- compilerRoutes <$> compilerAsk
77 -- Note that this makes us dependend on that identifier: when the metadata
78 -- of that item changes, the route may change, hence we have to recompile
79 compilerTellDependencies [IdentifierDependency identifier]
80 compilerUnsafeIO $ runRoutes routes provider identifier
83--------------------------------------------------------------------------------
84-- | Get the body of the underlying resource
85getResourceBody :: Compiler (Item String)
86getResourceBody = getResourceWith resourceBody
89--------------------------------------------------------------------------------
90-- | Get the resource we are compiling as a string
91getResourceString :: Compiler (Item String)
92getResourceString = getResourceWith resourceString
95--------------------------------------------------------------------------------
96-- | Get the resource we are compiling as a lazy bytestring
97getResourceLBS :: Compiler (Item ByteString)
98getResourceLBS = getResourceWith resourceLBS
101--------------------------------------------------------------------------------
102-- | Get the file path of the resource we are compiling
103getResourceFilePath :: Compiler FilePath
104getResourceFilePath = do
105 provider <- compilerProvider <$> compilerAsk
106 id' <- compilerUnderlying <$> compilerAsk
107 return $ resourceFilePath provider id'
110--------------------------------------------------------------------------------
111-- | Overloadable function for 'getResourceString' and 'getResourceLBS'
112getResourceWith :: (Provider -> Identifier -> IO a) -> Compiler (Item a)
113getResourceWith reader = do
114 provider <- compilerProvider <$> compilerAsk
115 id' <- compilerUnderlying <$> compilerAsk
116 let filePath = toFilePath id'
117 if resourceExists provider id'
118 then compilerUnsafeIO $ Item id' <$> reader provider id'
119 else fail $ error' filePath
120 where
121 error' fp = "Hakyll.Core.Compiler.getResourceWith: resource " ++
122 show fp ++ " not found"
125--------------------------------------------------------------------------------
126-- | Save a snapshot of the item. This function returns the same item, which
127-- convenient for building '>>=' chains.
128saveSnapshot :: (Binary a, Typeable a)
129 => Internal.Snapshot -> Item a -> Compiler (Item a)
130saveSnapshot snapshot item = do
131 store <- compilerStore <$> compilerAsk
132 logger <- compilerLogger <$> compilerAsk
133 compilerUnsafeIO $ do
134 Logger.debug logger $ "Storing snapshot: " ++ snapshot
135 Internal.saveSnapshot store snapshot item
136 return item
139--------------------------------------------------------------------------------
140cached :: (Binary a, Typeable a)
141 => String
142 -> Compiler a
143 -> Compiler a
144cached name compiler = do
145 id' <- compilerUnderlying <$> compilerAsk
146 store <- compilerStore <$> compilerAsk
147 provider <- compilerProvider <$> compilerAsk
148 let modified = resourceModified provider id'
149 if modified
150 then do
151 x <- compiler
152 compilerUnsafeIO $ Store.set store [name, show id'] x
153 return x
154 else do
155 compilerTellCacheHits 1
156 x <- compilerUnsafeIO $ Store.get store [name, show id']
157 progName <- compilerUnsafeIO getProgName
158 case x of Store.Found x' -> return x'
159 _ -> fail $ error' progName
160 where
161 error' progName =
162 "Hakyll.Core.Compiler.cached: Cache corrupt! " ++
163 "Try running: " ++ progName ++ " clean"
166--------------------------------------------------------------------------------
167unsafeCompiler :: IO a -> Compiler a
168unsafeCompiler = compilerUnsafeIO
171--------------------------------------------------------------------------------
172-- | Compiler for debugging purposes
173debugCompiler :: String -> Compiler ()
174debugCompiler msg = do
175 logger <- compilerLogger <$> compilerAsk
176 compilerUnsafeIO $ Logger.debug logger msg