git.iko.soy/hakyll
on b91c8be help sign in
hakyll/src/Hakyll/Core/Compiler.hs
162 lines 5.8 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 , getResourceWith
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.Identifier
43import Hakyll.Core.Item
44import Hakyll.Core.Logger as Logger
45import Hakyll.Core.Provider
46import Hakyll.Core.Routes
47import qualified Hakyll.Core.Store as Store
50--------------------------------------------------------------------------------
51-- | Get the underlying identifier.
52getUnderlying :: Compiler Identifier
53getUnderlying = compilerUnderlying <$> compilerAsk
56--------------------------------------------------------------------------------
57-- | Get the extension of the underlying identifier. Returns something like
58-- @".html"@
59getUnderlyingExtension :: Compiler String
60getUnderlyingExtension = takeExtension . toFilePath <$> getUnderlying
63--------------------------------------------------------------------------------
64makeItem :: a -> Compiler (Item a)
65makeItem x = do
66 identifier <- getUnderlying
67 return $ Item identifier x
70--------------------------------------------------------------------------------
71-- | Get the route for a specified item
72getRoute :: Identifier -> Compiler (Maybe FilePath)
73getRoute identifier = do
74 routes <- compilerRoutes <$> compilerAsk
75 return $ runRoutes routes identifier
78--------------------------------------------------------------------------------
79-- | Get the body of the underlying resource
80getResourceBody :: Compiler (Item String)
81getResourceBody = getResourceWith resourceBody
84--------------------------------------------------------------------------------
85-- | Get the resource we are compiling as a string
86getResourceString :: Compiler (Item String)
87getResourceString = getResourceWith resourceString
90--------------------------------------------------------------------------------
91-- | Get the resource we are compiling as a lazy bytestring
92getResourceLBS :: Compiler (Item ByteString)
93getResourceLBS = getResourceWith resourceLBS
96--------------------------------------------------------------------------------
97-- | Overloadable function for 'getResourceString' and 'getResourceLBS'
98getResourceWith :: (Provider -> Identifier -> IO a) -> Compiler (Item a)
99getResourceWith reader = do
100 provider <- compilerProvider <$> compilerAsk
101 id' <- compilerUnderlying <$> compilerAsk
102 let filePath = toFilePath id'
103 if resourceExists provider id'
104 then compilerUnsafeIO $ Item id' <$> reader provider id'
105 else compilerThrow $ error' filePath
106 where
107 error' fp = "Hakyll.Core.Compiler.getResourceWith: resource " ++
108 show fp ++ " not found"
111--------------------------------------------------------------------------------
112-- | Save a snapshot of the item. This function returns the same item, which
113-- convenient for building '>>=' chains.
114saveSnapshot :: (Binary a, Typeable a)
115 => Internal.Snapshot -> Item a -> Compiler (Item a)
116saveSnapshot snapshot item = do
117 store <- compilerStore <$> compilerAsk
118 logger <- compilerLogger <$> compilerAsk
119 compilerUnsafeIO $ do
120 Logger.debug logger $ "Storing snapshot: " ++ snapshot
121 Internal.saveSnapshot store snapshot item
122 return item
125--------------------------------------------------------------------------------
126cached :: (Binary a, Typeable a)
127 => String
128 -> Compiler a
129 -> Compiler a
130cached name compiler = do
131 id' <- compilerUnderlying <$> compilerAsk
132 store <- compilerStore <$> compilerAsk
133 provider <- compilerProvider <$> compilerAsk
134 let modified = resourceModified provider id'
135 if modified
136 then do
137 x <- compiler
138 compilerUnsafeIO $ Store.set store [name, show id'] x
139 return x
140 else do
141 compilerTellCacheHits 1
142 x <- compilerUnsafeIO $ Store.get store [name, show id']
143 progName <- compilerUnsafeIO getProgName
144 case x of Store.Found x' -> return x'
145 _ -> compilerThrow (error' progName)
146 where
147 error' progName =
148 "Hakyll.Core.Compiler.cached: Cache corrupt! " ++
149 "Try running: " ++ progName ++ " clean"
152--------------------------------------------------------------------------------
153unsafeCompiler :: IO a -> Compiler a
154unsafeCompiler = compilerUnsafeIO
157--------------------------------------------------------------------------------
158-- | Compiler for debugging purposes
159debugCompiler :: String -> Compiler ()
160debugCompiler msg = do
161 logger <- compilerLogger <$> compilerAsk
162 compilerUnsafeIO $ Logger.debug logger msg