git.iko.soy/hakyll
on fbc23ee help sign in
hakyll/src/Hakyll/Core/Compiler.hs
178 lines 6.6 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 Control.Monad (when)
33import Data.Binary (Binary)
34import Data.ByteString.Lazy (ByteString)
35import Data.Typeable (Typeable)
36import System.Environment (getProgName)
37import System.FilePath (takeExtension)
40--------------------------------------------------------------------------------
41import Hakyll.Core.Compiler.Internal
42import qualified Hakyll.Core.Compiler.Require as Internal
43import Hakyll.Core.Dependencies
44import Hakyll.Core.Identifier
45import Hakyll.Core.Item
46import Hakyll.Core.Logger as Logger
47import Hakyll.Core.Provider
48import Hakyll.Core.Routes
49import qualified Hakyll.Core.Store as Store
52--------------------------------------------------------------------------------
53-- | Get the underlying identifier.
54getUnderlying :: Compiler Identifier
55getUnderlying = compilerUnderlying <$> compilerAsk
58--------------------------------------------------------------------------------
59-- | Get the extension of the underlying identifier. Returns something like
60-- @".html"@
61getUnderlyingExtension :: Compiler String
62getUnderlyingExtension = takeExtension . toFilePath <$> getUnderlying
65--------------------------------------------------------------------------------
66makeItem :: a -> Compiler (Item a)
67makeItem x = do
68 identifier <- getUnderlying
69 return $ Item identifier x
72--------------------------------------------------------------------------------
73-- | Get the route for a specified item
74getRoute :: Identifier -> Compiler (Maybe FilePath)
75getRoute identifier = do
76 provider <- compilerProvider <$> compilerAsk
77 routes <- compilerRoutes <$> compilerAsk
78 -- Note that this makes us dependend on that identifier: when the metadata
79 -- of that item changes, the route may change, hence we have to recompile
80 (mfp, um) <- compilerUnsafeIO $ runRoutes routes provider identifier
81 when um $ compilerTellDependencies [IdentifierDependency identifier]
82 return mfp
85--------------------------------------------------------------------------------
86-- | Get the body of the underlying resource
87getResourceBody :: Compiler (Item String)
88getResourceBody = getResourceWith resourceBody
91--------------------------------------------------------------------------------
92-- | Get the resource we are compiling as a string
93getResourceString :: Compiler (Item String)
94getResourceString = getResourceWith resourceString
97--------------------------------------------------------------------------------
98-- | Get the resource we are compiling as a lazy bytestring
99getResourceLBS :: Compiler (Item ByteString)
100getResourceLBS = getResourceWith resourceLBS
103--------------------------------------------------------------------------------
104-- | Get the file path of the resource we are compiling
105getResourceFilePath :: Compiler FilePath
106getResourceFilePath = do
107 provider <- compilerProvider <$> compilerAsk
108 id' <- compilerUnderlying <$> compilerAsk
109 return $ resourceFilePath provider id'
112--------------------------------------------------------------------------------
113-- | Overloadable function for 'getResourceString' and 'getResourceLBS'
114getResourceWith :: (Provider -> Identifier -> IO a) -> Compiler (Item a)
115getResourceWith reader = do
116 provider <- compilerProvider <$> compilerAsk
117 id' <- compilerUnderlying <$> compilerAsk
118 let filePath = toFilePath id'
119 if resourceExists provider id'
120 then compilerUnsafeIO $ Item id' <$> reader provider id'
121 else fail $ error' filePath
122 where
123 error' fp = "Hakyll.Core.Compiler.getResourceWith: resource " ++
124 show fp ++ " not found"
127--------------------------------------------------------------------------------
128-- | Save a snapshot of the item. This function returns the same item, which
129-- convenient for building '>>=' chains.
130saveSnapshot :: (Binary a, Typeable a)
131 => Internal.Snapshot -> Item a -> Compiler (Item a)
132saveSnapshot snapshot item = do
133 store <- compilerStore <$> compilerAsk
134 logger <- compilerLogger <$> compilerAsk
135 compilerUnsafeIO $ do
136 Logger.debug logger $ "Storing snapshot: " ++ snapshot
137 Internal.saveSnapshot store snapshot item
138 return item
141--------------------------------------------------------------------------------
142cached :: (Binary a, Typeable a)
143 => String
144 -> Compiler a
145 -> Compiler a
146cached name compiler = do
147 id' <- compilerUnderlying <$> compilerAsk
148 store <- compilerStore <$> compilerAsk
149 provider <- compilerProvider <$> compilerAsk
150 let modified = resourceModified provider id'
151 if modified
152 then do
153 x <- compiler
154 compilerUnsafeIO $ Store.set store [name, show id'] x
155 return x
156 else do
157 compilerTellCacheHits 1
158 x <- compilerUnsafeIO $ Store.get store [name, show id']
159 progName <- compilerUnsafeIO getProgName
160 case x of Store.Found x' -> return x'
161 _ -> fail $ error' progName
162 where
163 error' progName =
164 "Hakyll.Core.Compiler.cached: Cache corrupt! " ++
165 "Try running: " ++ progName ++ " clean"
168--------------------------------------------------------------------------------
169unsafeCompiler :: IO a -> Compiler a
170unsafeCompiler = compilerUnsafeIO
173--------------------------------------------------------------------------------
174-- | Compiler for debugging purposes
175debugCompiler :: String -> Compiler ()
176debugCompiler msg = do
177 logger <- compilerLogger <$> compilerAsk
178 compilerUnsafeIO $ Logger.debug logger msg