6782404 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

merge

6782404iko7 years ago

CHANGELOG.md+13

unifiedsplit

@@ -4,6 +4,19 @@ title: Releases

5# Releases

7+## Hakyll 4.13.0.0 (2019-08-30)

9+- Improved documentation in many places (contribution by Bergi)

10+- Significantly improve error messages when reading and applying templates

11+ (contribution by Bergi)

12+ * `empty` and `fail` for `Compiler` now fail without or with a message,

13+ allowing for much better debug output

14+ * `renderFeed`, `renderRssWithTemplates` and `renderAtomWithTemplates` now

15+ take `Template` rather than `String` arguments

16+- Add option to specify date in directory structure,e.g.

17+ `posts/2019/05/10/tomorrow.md` (contribution by Taeer Bar-Ya)

18+- Bump QuickCheck to 2.13

19+

7## Hakyll 4.12.5.2 (2019-05-09)

20## Hakyll 4.12.5.2 (2019-05-09)

9- Bump pandoc to 2.7

22- Bump pandoc to 2.7

hakyll.cabal+6−4

@@ -1,5 +1,5 @@

1Name: hakyll

2−Version: 4.12.5.2

2+Version: 4.13.0.0

4Synopsis: A static website compiler library

5Description:

@@ -172,10 +172,12 @@ Library

172 data-default >= 0.4 && < 0.8,

173 deepseq >= 1.3 && < 1.5,

174 directory >= 1.0 && < 1.4,

175+ file-embed >= 0.0.10.1 && < 0.0.12,

175 filepath >= 1.0 && < 1.5,

176 filepath >= 1.0 && < 1.5,

176 lrucache >= 1.1.1 && < 1.3,

177 lrucache >= 1.1.1 && < 1.3,

177 mtl >= 1 && < 2.3,

178 mtl >= 1 && < 2.3,

178 network-uri >= 2.6 && < 2.7,

179 network-uri >= 2.6 && < 2.7,

180+ optparse-applicative >= 0.12 && < 0.15,

179 parsec >= 3.0 && < 3.2,

181 parsec >= 3.0 && < 3.2,

180 process >= 1.6 && < 1.7,

182 process >= 1.6 && < 1.7,

181 random >= 1.0 && < 1.2,

183 random >= 1.0 && < 1.2,

@@ -183,14 +185,13 @@ Library

183 resourcet >= 1.1 && < 1.3,

185 resourcet >= 1.1 && < 1.3,

184 scientific >= 0.3.4 && < 0.4,

186 scientific >= 0.3.4 && < 0.4,

185 tagsoup >= 0.13.1 && < 0.15,

187 tagsoup >= 0.13.1 && < 0.15,

188+ template-haskell >= 2.14 && < 2.15,

186 text >= 0.11 && < 1.3,

189 text >= 0.11 && < 1.3,

187 time >= 1.8 && < 1.10,

190 time >= 1.8 && < 1.10,

188 time-locale-compat >= 0.1 && < 0.2,

191 time-locale-compat >= 0.1 && < 0.2,

189 unordered-containers >= 0.2 && < 0.3,

192 unordered-containers >= 0.2 && < 0.3,

190 vector >= 0.11 && < 0.13,

193 vector >= 0.11 && < 0.13,

191− yaml >= 0.8.11 && < 0.12,

194+ yaml >= 0.8.11 && < 0.12

192− optparse-applicative >= 0.12 && < 0.15,

193− file-embed >= 0.0.10.1 && < 0.0.12

194

195

195 If flag(previewServer)

196 If flag(previewServer)

196 Build-depends:

197 Build-depends:

@@ -254,6 +255,7 @@ Test-suite hakyll-tests

254 Hakyll.Web.CompressCss.Tests

255 Hakyll.Web.CompressCss.Tests

255 Hakyll.Web.Html.RelativizeUrls.Tests

256 Hakyll.Web.Html.RelativizeUrls.Tests

256 Hakyll.Web.Html.Tests

257 Hakyll.Web.Html.Tests

258+ Hakyll.Web.Tags.Tests

257 Hakyll.Web.Template.Context.Tests

259 Hakyll.Web.Template.Context.Tests

258 Hakyll.Web.Template.Tests

260 Hakyll.Web.Template.Tests

259 TestSuite.Util

261 TestSuite.Util

lib/Hakyll/Core/Compiler.hs+35−2

@@ -24,13 +24,16 @@ module Hakyll.Core.Compiler

24 , cached

25 , unsafeCompiler

26 , debugCompiler

27+ , noResult

28+ , withErrorMessage

27 ) where

29 ) where

30--------------------------------------------------------------------------------

32--------------------------------------------------------------------------------

31−import Control.Monad (when, unless)

33+import Control.Monad (unless, when, (>=>))

32import Data.Binary (Binary)

34import Data.Binary (Binary)

33import Data.ByteString.Lazy (ByteString)

35import Data.ByteString.Lazy (ByteString)

36+import qualified Data.List.NonEmpty as NonEmpty

34import Data.Typeable (Typeable)

37import Data.Typeable (Typeable)

35import System.Environment (getProgName)

38import System.Environment (getProgName)

36import System.FilePath (takeExtension)

39import System.FilePath (takeExtension)

@@ -62,6 +65,7 @@ getUnderlyingExtension = takeExtension . toFilePath <$> getUnderlying

64--------------------------------------------------------------------------------

67--------------------------------------------------------------------------------

68+-- | Create an item from the underlying identifier and a given value.

65makeItem :: a -> Compiler (Item a)

69makeItem :: a -> Compiler (Item a)

66makeItem x = do

70makeItem x = do

67 identifier <- getUnderlying

71 identifier <- getUnderlying

@@ -141,6 +145,10 @@ saveSnapshot snapshot item = do

141

145

142

146

143--------------------------------------------------------------------------------

147--------------------------------------------------------------------------------

148+-- | Turn on caching for a compilation value to avoid recomputing it

149+-- on subsequent Hakyll runs.

150+-- The storage key consists of the underlying identifier of the compiled

151+-- ressource and the given name.

144cached :: (Binary a, Typeable a)

152cached :: (Binary a, Typeable a)

145 => String

153 => String

146 -> Compiler a

154 -> Compiler a

@@ -177,12 +185,37 @@ cached name compiler = do

177

185

178

186

179--------------------------------------------------------------------------------

187--------------------------------------------------------------------------------

188+-- | Run an IO computation without dependencies in a Compiler

180unsafeCompiler :: IO a -> Compiler a

189unsafeCompiler :: IO a -> Compiler a

181unsafeCompiler = compilerUnsafeIO

190unsafeCompiler = compilerUnsafeIO

182

191

183

192

184--------------------------------------------------------------------------------

193--------------------------------------------------------------------------------

194+-- | Fail so that it is treated as non-defined in an @\$if()\$@ branching

195+-- "Hakyll.Web.Template" macro, and alternative

196+-- 'Hakyll.Web.Template.Context.Context's are tried

197+--

198+-- @since 4.13.0

199+noResult :: String -> Compiler a

200+noResult = compilerNoResult . return

201+

202+

203+--------------------------------------------------------------------------------

204+-- | Prepend an error line to the error, if there is one. This allows you to

205+-- add helpful context to error messages.

206+--

207+-- @since 4.13.0

208+withErrorMessage :: String -> Compiler a -> Compiler a

209+withErrorMessage x = do

210+ compilerTry >=> either (compilerResult . CompilerError . prepend) return

211+ where

212+ prepend (CompilationFailure es) = CompilationFailure (x `NonEmpty.cons` es)

213+ prepend (CompilationNoResult es) = CompilationNoResult (x : es)

214+

215+

216+--------------------------------------------------------------------------------

185−-- | Compiler for debugging purposes

217+-- | Compiler for debugging purposes.

218+-- Passes a message to the debug logger that is printed in verbose mode.

186debugCompiler :: String -> Compiler ()

219debugCompiler :: String -> Compiler ()

187debugCompiler msg = do

220debugCompiler msg = do

188 logger <- compilerLogger <$> compilerAsk

221 logger <- compilerLogger <$> compilerAsk

lib/Hakyll/Core/Compiler/Internal.hs+126−41

@@ -1,6 +1,7 @@

1--------------------------------------------------------------------------------

2-- | Internally used compiler module

3{-# LANGUAGE CPP #-}

4+{-# LANGUAGE DeriveFunctor #-}

4{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE GADTs #-}

6{-# LANGUAGE GADTs #-}

6{-# LANGUAGE GeneralizedNewtypeDeriving #-}

7{-# LANGUAGE GeneralizedNewtypeDeriving #-}

@@ -10,19 +11,26 @@ module Hakyll.Core.Compiler.Internal

10 Snapshot

11 Snapshot

11 , CompilerRead (..)

12 , CompilerRead (..)

12 , CompilerWrite (..)

13 , CompilerWrite (..)

14+ , CompilerErrors (..)

13 , CompilerResult (..)

15 , CompilerResult (..)

14 , Compiler (..)

16 , Compiler (..)

15 , runCompiler

17 , runCompiler

17 -- * Core operations

19 -- * Core operations

20+ , compilerResult

18 , compilerTell

21 , compilerTell

19 , compilerAsk

22 , compilerAsk

23+ , compilerUnsafeIO

24+

25+ -- * Error operations

20 , compilerThrow

26 , compilerThrow

27+ , compilerNoResult

21 , compilerCatch

28 , compilerCatch

22− , compilerResult

29+ , compilerTry

23− , compilerUnsafeIO

30+ , compilerErrorMessages

25 -- * Utilities

32 -- * Utilities

33+ , compilerDebugEntries

26 , compilerTellDependencies

34 , compilerTellDependencies

27 , compilerTellCacheHits

35 , compilerTellCacheHits

28 ) where

36 ) where

@@ -32,7 +40,9 @@ module Hakyll.Core.Compiler.Internal

32import Control.Applicative (Alternative (..))

40import Control.Applicative (Alternative (..))

33import Control.Exception (SomeException, handle)

41import Control.Exception (SomeException, handle)

34import Control.Monad (forM_)

42import Control.Monad (forM_)

35−import Control.Monad.Except (MonadError (..))

43+import Control.Monad.Except (MonadError (..))

44+import Data.List.NonEmpty (NonEmpty (..))

45+import qualified Data.List.NonEmpty as NonEmpty

36#if MIN_VERSION_base(4,9,0)

46#if MIN_VERSION_base(4,9,0)

37import Data.Semigroup (Semigroup (..))

47import Data.Semigroup (Semigroup (..))

38#endif

48#endif

@@ -45,7 +55,6 @@ import Hakyll.Core.Configuration

45import Hakyll.Core.Dependencies

55import Hakyll.Core.Dependencies

46import Hakyll.Core.Identifier

56import Hakyll.Core.Identifier

47import Hakyll.Core.Identifier.Pattern

57import Hakyll.Core.Identifier.Pattern

48−import Hakyll.Core.Logger (Logger)

49import qualified Hakyll.Core.Logger as Logger

58import qualified Hakyll.Core.Logger as Logger

50import Hakyll.Core.Metadata

59import Hakyll.Core.Metadata

51import Hakyll.Core.Provider

60import Hakyll.Core.Provider

@@ -75,7 +84,7 @@ data CompilerRead = CompilerRead

75 , -- | Compiler store

84 , -- | Compiler store

76 compilerStore :: Store

85 compilerStore :: Store

77 , -- | Logger

86 , -- | Logger

78− compilerLogger :: Logger

87+ compilerLogger :: Logger.Logger

79 }

88 }

@@ -104,11 +113,29 @@ instance Monoid CompilerWrite where

104

113

105

114

106--------------------------------------------------------------------------------

115--------------------------------------------------------------------------------

107−data CompilerResult a where

116+-- | Distinguishes reasons in a 'CompilerError'

117+data CompilerErrors a

118+ -- | One or more exceptions occured during compilation

119+ = CompilationFailure (NonEmpty a)

120+ -- | Absence of any result, most notably in template contexts. May still

121+ -- have error messages.

122+ | CompilationNoResult [a]

123+ deriving Functor

124+

125+

126+-- | Unwrap a `CompilerErrors`

127+compilerErrorMessages :: CompilerErrors a -> [a]

128+compilerErrorMessages (CompilationFailure x) = NonEmpty.toList x

129+compilerErrorMessages (CompilationNoResult x) = x

130+

131+

132+--------------------------------------------------------------------------------

133+-- | An intermediate result of a compilation step

134+data CompilerResult a

108− CompilerDone :: a -> CompilerWrite -> CompilerResult a

135+ = CompilerDone a CompilerWrite

109− CompilerSnapshot :: Snapshot -> Compiler a -> CompilerResult a

136+ | CompilerSnapshot Snapshot (Compiler a)

110− CompilerError :: [String] -> CompilerResult a

111− CompilerRequire :: (Identifier, Snapshot) -> Compiler a -> CompilerResult a

137+ | CompilerRequire (Identifier, Snapshot) (Compiler a)

138+ | CompilerError (CompilerErrors String)

112

139

113

140

114--------------------------------------------------------------------------------

141--------------------------------------------------------------------------------

@@ -126,14 +153,14 @@ instance Functor Compiler where

126 return $ case res of

153 return $ case res of

127 CompilerDone x w -> CompilerDone (f x) w

154 CompilerDone x w -> CompilerDone (f x) w

128 CompilerSnapshot s c' -> CompilerSnapshot s (fmap f c')

155 CompilerSnapshot s c' -> CompilerSnapshot s (fmap f c')

129− CompilerError e -> CompilerError e

130 CompilerRequire i c' -> CompilerRequire i (fmap f c')

156 CompilerRequire i c' -> CompilerRequire i (fmap f c')

157+ CompilerError e -> CompilerError e

131 {-# INLINE fmap #-}

158 {-# INLINE fmap #-}

132

159

133

160

134--------------------------------------------------------------------------------

161--------------------------------------------------------------------------------

135instance Monad Compiler where

162instance Monad Compiler where

136− return x = Compiler $ \_ -> return $ CompilerDone x mempty

163+ return x = compilerResult $ CompilerDone x mempty

137 {-# INLINE return #-}

164 {-# INLINE return #-}

138

165

139 Compiler c >>= f = Compiler $ \r -> do

166 Compiler c >>= f = Compiler $ \r -> do

@@ -146,14 +173,14 @@ instance Monad Compiler where

146 CompilerSnapshot s c' -> CompilerSnapshot s $ do

173 CompilerSnapshot s c' -> CompilerSnapshot s $ do

147 compilerTell w -- Save dependencies!

174 compilerTell w -- Save dependencies!

148 c'

175 c'

149− CompilerError e -> CompilerError e

150 CompilerRequire i c' -> CompilerRequire i $ do

176 CompilerRequire i c' -> CompilerRequire i $ do

151 compilerTell w -- Save dependencies!

177 compilerTell w -- Save dependencies!

152 c'

178 c'

179+ CompilerError e -> CompilerError e

153

180

154 CompilerSnapshot s c' -> return $ CompilerSnapshot s (c' >>= f)

181 CompilerSnapshot s c' -> return $ CompilerSnapshot s (c' >>= f)

155− CompilerError e -> return $ CompilerError e

156 CompilerRequire i c' -> return $ CompilerRequire i (c' >>= f)

182 CompilerRequire i c' -> return $ CompilerRequire i (c' >>= f)

183+ CompilerError e -> return $ CompilerError e

157 {-# INLINE (>>=) #-}

184 {-# INLINE (>>=) #-}

158

185

159 fail = compilerThrow . return

186 fail = compilerThrow . return

@@ -170,87 +197,145 @@ instance Applicative Compiler where

170

197

171

198

172--------------------------------------------------------------------------------

199--------------------------------------------------------------------------------

200+-- | Access provided metadata from anywhere

173instance MonadMetadata Compiler where

201instance MonadMetadata Compiler where

174 getMetadata = compilerGetMetadata

202 getMetadata = compilerGetMetadata

175 getMatches = compilerGetMatches

203 getMatches = compilerGetMatches

176

204

177

205

178--------------------------------------------------------------------------------

206--------------------------------------------------------------------------------

207+-- | Compilation may fail with multiple error messages.

208+-- 'catchError' handles errors from 'throwError', 'fail' and 'Hakyll.Core.Compiler.noResult'

179instance MonadError [String] Compiler where

209instance MonadError [String] Compiler where

180− throwError = compilerThrow

210+ throwError = compilerThrow

181− catchError = compilerCatch

211+ catchError c = compilerCatch c . (. compilerErrorMessages)

182

212

183

213

184--------------------------------------------------------------------------------

214--------------------------------------------------------------------------------

215+-- | Like 'unCompiler' but treating IO exceptions as 'CompilerError's

185runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)

216runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)

186runCompiler compiler read' = handle handler $ unCompiler compiler read'

217runCompiler compiler read' = handle handler $ unCompiler compiler read'

187 where

218 where

188 handler :: SomeException -> IO (CompilerResult a)

219 handler :: SomeException -> IO (CompilerResult a)

189− handler e = return $ CompilerError [show e]

220+ handler e = return $ CompilerError $ CompilationFailure $ show e :| []

190

221

191

222

192--------------------------------------------------------------------------------

223--------------------------------------------------------------------------------

224+-- | Trying alternative compilers if the first fails, regardless whether through

225+-- 'fail', 'throwError' or 'Hakyll.Core.Compiler.noResult'.

226+-- Aggregates error messages if all fail.

193instance Alternative Compiler where

227instance Alternative Compiler where

194− empty = compilerThrow []

228+ empty = compilerNoResult []

195− x <|> y = compilerCatch x $ \es -> do

229+ x <|> y = x `compilerCatch` (\rx -> y `compilerCatch` (\ry ->

196− logger <- compilerLogger <$> compilerAsk

230+ case (rx, ry) of

197− forM_ es $ \e -> compilerUnsafeIO $ Logger.debug logger $

231+ (CompilationFailure xs, CompilationFailure ys) ->

232+ compilerThrow $ NonEmpty.toList xs ++ NonEmpty.toList ys

233+ (CompilationFailure xs, CompilationNoResult ys) ->

234+ debug ys >> compilerThrow (NonEmpty.toList xs)

235+ (CompilationNoResult xs, CompilationFailure ys) ->

236+ debug xs >> compilerThrow (NonEmpty.toList ys)

237+ (CompilationNoResult xs, CompilationNoResult ys) -> compilerNoResult $ xs ++ ys

238+ ))

239+ where

198− "Hakyll.Core.Compiler.Internal: Alternative failed: " ++ e

240+ debug = compilerDebugEntries "Hakyll.Core.Compiler.Internal: Alternative fail suppressed"

199− y

200 {-# INLINE (<|>) #-}

241 {-# INLINE (<|>) #-}

201

242

202

243

203--------------------------------------------------------------------------------

244--------------------------------------------------------------------------------

245+-- | Put the result back in a compiler

246+compilerResult :: CompilerResult a -> Compiler a

247+compilerResult x = Compiler $ \_ -> return x

248+{-# INLINE compilerResult #-}

249+

250+

251+--------------------------------------------------------------------------------

252+-- | Get the current environment

204compilerAsk :: Compiler CompilerRead

253compilerAsk :: Compiler CompilerRead

205compilerAsk = Compiler $ \r -> return $ CompilerDone r mempty

254compilerAsk = Compiler $ \r -> return $ CompilerDone r mempty

206{-# INLINE compilerAsk #-}

255{-# INLINE compilerAsk #-}

207

256

208

257

209--------------------------------------------------------------------------------

258--------------------------------------------------------------------------------

259+-- | Put a 'CompilerWrite'

210compilerTell :: CompilerWrite -> Compiler ()

260compilerTell :: CompilerWrite -> Compiler ()

211−compilerTell deps = Compiler $ \_ -> return $ CompilerDone () deps

261+compilerTell = compilerResult . CompilerDone ()

212{-# INLINE compilerTell #-}

262{-# INLINE compilerTell #-}

213

263

214

264

215--------------------------------------------------------------------------------

265--------------------------------------------------------------------------------

266+-- | Run an IO computation without dependencies in a Compiler

267+compilerUnsafeIO :: IO a -> Compiler a

268+compilerUnsafeIO io = Compiler $ \_ -> do

269+ x <- io

270+ return $ CompilerDone x mempty

271+{-# INLINE compilerUnsafeIO #-}

272+

273+

274+--------------------------------------------------------------------------------

275+-- | Throw errors in the 'Compiler'.

276+--

277+-- If no messages are given, this is considered a 'CompilationNoResult' error.

278+-- Otherwise, it is treated as a proper compilation failure.

216compilerThrow :: [String] -> Compiler a

279compilerThrow :: [String] -> Compiler a

217−compilerThrow es = Compiler $ \_ -> return $ CompilerError es

280+compilerThrow = compilerResult . CompilerError .

218−{-# INLINE compilerThrow #-}

281+ maybe (CompilationNoResult []) CompilationFailure .

282+ NonEmpty.nonEmpty

283+

284+-- | Put a 'CompilerError' with multiple messages as 'CompilationNoResult'

285+compilerNoResult :: [String] -> Compiler a

286+compilerNoResult = compilerResult . CompilerError . CompilationNoResult

219

287

220

288

221--------------------------------------------------------------------------------

289--------------------------------------------------------------------------------

222−compilerCatch :: Compiler a -> ([String] -> Compiler a) -> Compiler a

290+-- | Allows to distinguish 'CompilerError's and branch on them with 'Either'

291+--

292+-- prop> compilerTry = (`compilerCatch` return . Left) . fmap Right

293+compilerTry :: Compiler a -> Compiler (Either (CompilerErrors String) a)

294+compilerTry (Compiler x) = Compiler $ \r -> do

295+ res <- x r

296+ case res of

297+ CompilerDone res' w -> return (CompilerDone (Right res') w)

298+ CompilerSnapshot s c -> return (CompilerSnapshot s (compilerTry c))

299+ CompilerRequire i c -> return (CompilerRequire i (compilerTry c))

300+ CompilerError e -> return (CompilerDone (Left e) mempty)

301+{-# INLINE compilerTry #-}

302+

303+

304+--------------------------------------------------------------------------------

305+-- | Allows you to recover from 'CompilerError's.

306+-- Uses the same parameter order as 'catchError' so that it can be used infix.

307+--

308+-- prop> c `compilerCatch` f = compilerTry c >>= either f return

309+compilerCatch :: Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a

223compilerCatch (Compiler x) f = Compiler $ \r -> do

310compilerCatch (Compiler x) f = Compiler $ \r -> do

224 res <- x r

311 res <- x r

225 case res of

312 case res of

226 CompilerDone res' w -> return (CompilerDone res' w)

313 CompilerDone res' w -> return (CompilerDone res' w)

227 CompilerSnapshot s c -> return (CompilerSnapshot s (compilerCatch c f))

314 CompilerSnapshot s c -> return (CompilerSnapshot s (compilerCatch c f))

228− CompilerError e -> unCompiler (f e) r

229 CompilerRequire i c -> return (CompilerRequire i (compilerCatch c f))

315 CompilerRequire i c -> return (CompilerRequire i (compilerCatch c f))

316+ CompilerError e -> unCompiler (f e) r

230{-# INLINE compilerCatch #-}

317{-# INLINE compilerCatch #-}

231

318

232

319

233--------------------------------------------------------------------------------

320--------------------------------------------------------------------------------

234−-- | Put the result back in a compiler

321+compilerDebugLog :: [String] -> Compiler ()

235−compilerResult :: CompilerResult a -> Compiler a

322+compilerDebugLog ms = do

236−compilerResult x = Compiler $ \_ -> return x

323+ logger <- compilerLogger <$> compilerAsk

237−{-# INLINE compilerResult #-}

324+ compilerUnsafeIO $ forM_ ms $ Logger.debug logger

238−

239

325

240--------------------------------------------------------------------------------

326--------------------------------------------------------------------------------

241−compilerUnsafeIO :: IO a -> Compiler a

327+-- | Pass a list of messages with a heading to the debug logger

242−compilerUnsafeIO io = Compiler $ \_ -> do

328+compilerDebugEntries :: String -> [String] -> Compiler ()

243− x <- io

329+compilerDebugEntries msg = compilerDebugLog . (msg:) . map indent

244− return $ CompilerDone x mempty

330+ where

245−{-# INLINE compilerUnsafeIO #-}

331+ indent = unlines . map (" "++) . lines

246

332

247

333

248--------------------------------------------------------------------------------

334--------------------------------------------------------------------------------

249compilerTellDependencies :: [Dependency] -> Compiler ()

335compilerTellDependencies :: [Dependency] -> Compiler ()

250compilerTellDependencies ds = do

336compilerTellDependencies ds = do

251− logger <- compilerLogger <$> compilerAsk

337+ compilerDebugLog $ map (\d ->

252− forM_ ds $ \d -> compilerUnsafeIO $ Logger.debug logger $

253− "Hakyll.Core.Compiler.Internal: Adding dependency: " ++ show d

338+ "Hakyll.Core.Compiler.Internal: Adding dependency: " ++ show d) ds

254 compilerTell mempty {compilerDependencies = ds}

339 compilerTell mempty {compilerDependencies = ds}

255{-# INLINE compilerTellDependencies #-}

340{-# INLINE compilerTellDependencies #-}

256

341

lib/Hakyll/Core/Compiler/Require.hs+2

@@ -91,6 +91,7 @@ loadBody id' = loadSnapshotBody id' final

93--------------------------------------------------------------------------------

94+-- | A shortcut for only requiring the body for a specific snapshot of an item

94loadSnapshotBody :: (Binary a, Typeable a)

95loadSnapshotBody :: (Binary a, Typeable a)

95 => Identifier -> Snapshot -> Compiler a

96 => Identifier -> Snapshot -> Compiler a

96loadSnapshotBody id' snapshot = fmap itemBody $ loadSnapshot id' snapshot

97loadSnapshotBody id' snapshot = fmap itemBody $ loadSnapshot id' snapshot

@@ -103,6 +104,7 @@ loadAll pattern = loadAllSnapshots pattern final

103

104

105

105--------------------------------------------------------------------------------

106--------------------------------------------------------------------------------

107+-- | Load a specific snapshot for each of dynamic list of items

106loadAllSnapshots :: (Binary a, Typeable a)

108loadAllSnapshots :: (Binary a, Typeable a)

107 => Pattern -> Snapshot -> Compiler [Item a]

109 => Pattern -> Snapshot -> Compiler [Item a]

108loadAllSnapshots pattern snapshot = do

110loadAllSnapshots pattern snapshot = do

lib/Hakyll/Core/Logger.hs+9−3

@@ -18,6 +18,7 @@ import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)

18import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)

19import Control.Monad (forever)

20import Control.Monad.Trans (MonadIO, liftIO)

21+import Data.List (intercalate)

21import Prelude hiding (error)

22import Prelude hiding (error)

@@ -79,7 +80,7 @@ string l v m

80--------------------------------------------------------------------------------

81--------------------------------------------------------------------------------

81error :: MonadIO m => Logger -> String -> m ()

82error :: MonadIO m => Logger -> String -> m ()

82−error l m = string l Error $ " [ERROR] " ++ m

83+error l m = string l Error $ " [ERROR] " ++ indent m

85--------------------------------------------------------------------------------

86--------------------------------------------------------------------------------

@@ -89,9 +90,14 @@ header l = string l Message

90--------------------------------------------------------------------------------

91--------------------------------------------------------------------------------

91message :: MonadIO m => Logger -> String -> m ()

92message :: MonadIO m => Logger -> String -> m ()

92−message l m = string l Message $ " " ++ m

93+message l m = string l Message $ " " ++ indent m

95--------------------------------------------------------------------------------

96--------------------------------------------------------------------------------

96debug :: MonadIO m => Logger -> String -> m ()

97debug :: MonadIO m => Logger -> String -> m ()

97−debug l m = string l Debug $ " [DEBUG] " ++ m

98+debug l m = string l Debug $ " [DEBUG] " ++ indent m

99+

100+

101+--------------------------------------------------------------------------------

102+indent :: String -> String

103+indent = intercalate "\n " . lines

lib/Hakyll/Core/Provider/Metadata.hs+3−2

@@ -27,6 +27,7 @@ import Hakyll.Core.Identifier

27import Hakyll.Core.Metadata

28import Hakyll.Core.Provider.Internal

29import System.IO as IO

30+import System.IO.Error (modifyIOError, ioeSetLocation)

32--------------------------------------------------------------------------------

33--------------------------------------------------------------------------------

@@ -51,7 +52,7 @@ loadMetadata p identifier = do

51--------------------------------------------------------------------------------

52--------------------------------------------------------------------------------

52loadMetadataHeader :: FilePath -> IO (Metadata, String)

53loadMetadataHeader :: FilePath -> IO (Metadata, String)

53loadMetadataHeader fp = do

54loadMetadataHeader fp = do

54− fileContent <- readFile fp

55+ fileContent <- modifyIOError (`ioeSetLocation` "loadMetadataHeader") $ readFile fp

55 case parsePage fileContent of

56 case parsePage fileContent of

56 Right x -> return x

57 Right x -> return x

57 Left err -> throwIO $ MetadataException fp err

58 Left err -> throwIO $ MetadataException fp err

@@ -60,7 +61,7 @@ loadMetadataHeader fp = do

60--------------------------------------------------------------------------------

61--------------------------------------------------------------------------------

61loadMetadataFile :: FilePath -> IO Metadata

62loadMetadataFile :: FilePath -> IO Metadata

62loadMetadataFile fp = do

63loadMetadataFile fp = do

63− fileContent <- B.readFile fp

64+ fileContent <- modifyIOError (`ioeSetLocation` "loadMetadataFile") $ B.readFile fp

64 let errOrMeta = Yaml.decodeEither' fileContent

65 let errOrMeta = Yaml.decodeEither' fileContent

65 either (fail . show) return errOrMeta

66 either (fail . show) return errOrMeta

lib/Hakyll/Core/Runtime.hs+3−3

@@ -199,9 +199,9 @@ chase trail id'

199 result <- liftIO $ runCompiler compiler read'

200 case result of

201 -- Rethrow error

202− CompilerError [] -> throwError

202+ CompilerError e -> throwError $ case compilerErrorMessages e of

203− "Compiler failed but no info given, try running with -v?"

203+ [] -> "Compiler failed but no info given, try running with -v?"

204− CompilerError es -> throwError $ intercalate "; " es

204+ es -> intercalate "; " es

205

206 -- Signal that a snapshot was saved ->

207 CompilerSnapshot snapshot c -> do

lib/Hakyll/Core/Store.hs+20−20

@@ -16,7 +16,6 @@ module Hakyll.Core.Store

18--------------------------------------------------------------------------------

19−import Control.Exception (IOException, handle)

20import qualified Crypto.Hash.MD5 as MD5

19import qualified Crypto.Hash.MD5 as MD5

21import Data.Binary (Binary, decode, encodeFile)

20import Data.Binary (Binary, decode, encodeFile)

22import qualified Data.ByteString as B

21import qualified Data.ByteString as B

@@ -32,6 +31,8 @@ import System.Directory (createDirectoryIfMissing)

32import System.Directory (doesFileExist, removeFile)

31import System.Directory (doesFileExist, removeFile)

33import System.FilePath ((</>))

32import System.FilePath ((</>))

34import System.IO (IOMode (..), hClose, openFile)

33import System.IO (IOMode (..), hClose, openFile)

34+import System.IO.Error (catchIOError, ioeSetFileName,

35+ ioeSetLocation, modifyIOError)

37--------------------------------------------------------------------------------

38--------------------------------------------------------------------------------

@@ -84,6 +85,14 @@ new inMemory directory = do

84 where

85 where

85 csize = Just 500

86 csize = Just 500

88+--------------------------------------------------------------------------------

89+withStore :: Store -> String -> (String -> FilePath -> IO a) -> [String] -> IO a

90+withStore store loc run identifier = modifyIOError handle $ run key path

91+ where

92+ key = hash identifier

93+ path = storeDirectory store </> key

94+ handle e = e `ioeSetFileName` (path ++ " for " ++ intercalate "/" identifier)

95+ `ioeSetLocation` ("Store." ++ loc)

88--------------------------------------------------------------------------------

97--------------------------------------------------------------------------------

89-- | Auxiliary: add an item to the in-memory cache

98-- | Auxiliary: add an item to the in-memory cache

@@ -124,17 +133,16 @@ cacheDelete (Store _ (Just lru)) key = do

124--------------------------------------------------------------------------------

133--------------------------------------------------------------------------------

125-- | Store an item

134-- | Store an item

126set :: (Binary a, Typeable a) => Store -> [String] -> a -> IO ()

135set :: (Binary a, Typeable a) => Store -> [String] -> a -> IO ()

127−set store identifier value = do

136+set store identifier value = withStore store "set" (\key path -> do

128− encodeFile (storeDirectory store </> key) value

137+ encodeFile path value

129 cacheInsert store key value

138 cacheInsert store key value

130− where

131− key = hash identifier

139+ ) identifier

132

140

133

141

134--------------------------------------------------------------------------------

142--------------------------------------------------------------------------------

135-- | Load an item

143-- | Load an item

136get :: (Binary a, Typeable a) => Store -> [String] -> IO (Result a)

144get :: (Binary a, Typeable a) => Store -> [String] -> IO (Result a)

137−get store identifier = do

145+get store = withStore store "get" $ \key path -> do

138 -- First check the in-memory map

146 -- First check the in-memory map

139 ref <- cacheLookup store key

147 ref <- cacheLookup store key

140 case ref of

148 case ref of

@@ -146,17 +154,14 @@ get store identifier = do

146 then return NotFound

154 then return NotFound

147 -- Found in the filesystem

155 -- Found in the filesystem

148 else do

156 else do

149− v <- decodeClose

157+ v <- decodeClose path

150 cacheInsert store key v

158 cacheInsert store key v

151 return $ Found v

159 return $ Found v

152 -- Found in the in-memory map (or wrong type), just return

160 -- Found in the in-memory map (or wrong type), just return

153 s -> return s

161 s -> return s

154 where

162 where

155− key = hash identifier

156− path = storeDirectory store </> key

157−

158 -- 'decodeFile' from Data.Binary which closes the file ASAP

163 -- 'decodeFile' from Data.Binary which closes the file ASAP

159− decodeClose = do

164+ decodeClose path = do

160 h <- openFile path ReadMode

165 h <- openFile path ReadMode

161 lbs <- BL.hGetContents h

166 lbs <- BL.hGetContents h

162 BL.length lbs `seq` hClose h

167 BL.length lbs `seq` hClose h

@@ -166,28 +171,23 @@ get store identifier = do

166--------------------------------------------------------------------------------

171--------------------------------------------------------------------------------

167-- | Strict function

172-- | Strict function

168isMember :: Store -> [String] -> IO Bool

173isMember :: Store -> [String] -> IO Bool

169−isMember store identifier = do

174+isMember store = withStore store "isMember" $ \key path -> do

170 inCache <- cacheIsMember store key

175 inCache <- cacheIsMember store key

171 if inCache then return True else doesFileExist path

176 if inCache then return True else doesFileExist path

172− where

173− key = hash identifier

174− path = storeDirectory store </> key

175

177

176

178

177--------------------------------------------------------------------------------

179--------------------------------------------------------------------------------

178-- | Delete an item

180-- | Delete an item

179delete :: Store -> [String] -> IO ()

181delete :: Store -> [String] -> IO ()

180−delete store identifier = do

182+delete store = withStore store "delete" $ \key path -> do

181 cacheDelete store key

183 cacheDelete store key

182− deleteFile $ storeDirectory store </> key

184+ deleteFile path

183− where

184− key = hash identifier

185

186

187--------------------------------------------------------------------------------

188-- | Delete a file unless it doesn't exist...

189deleteFile :: FilePath -> IO ()

190−deleteFile = handle (\(_ :: IOException) -> return ()) . removeFile

190+deleteFile = (`catchIOError` \_ -> return ()) . removeFile

191

192

193--------------------------------------------------------------------------------

lib/Hakyll/Web/Feed.hs+24−31

@@ -1,4 +1,5 @@

1+{-# LANGUAGE OverloadedStrings #-}

1−{-# LANGUAGE TemplateHaskell #-}

2+{-# LANGUAGE TemplateHaskell #-}

3--------------------------------------------------------------------------------

4--------------------------------------------------------------------------------

4-- | A Module that allows easy rendering of RSS feeds.

5-- | A Module that allows easy rendering of RSS feeds.

@@ -37,27 +38,26 @@ import Hakyll.Web.Template.List

39--------------------------------------------------------------------------------

40--------------------------------------------------------------------------------

40−import Data.FileEmbed (makeRelativeToProject, embedFile)

41+import Data.FileEmbed (makeRelativeToProject)

41−import qualified Data.Text as T

42−import qualified Data.Text.Encoding as T

45--------------------------------------------------------------------------------

44--------------------------------------------------------------------------------

46−rssTemplate :: String

45+rssTemplate :: Template

47−rssTemplate = T.unpack $

46+rssTemplate =

48− T.decodeUtf8 $(makeRelativeToProject "data/templates/rss.xml" >>= embedFile)

47+ $(makeRelativeToProject "data/templates/rss.xml" >>= embedTemplate)

50−rssItemTemplate :: String

49+rssItemTemplate :: Template

51−rssItemTemplate = T.unpack $

50+rssItemTemplate =

52− T.decodeUtf8 $(makeRelativeToProject "data/templates/rss-item.xml" >>= embedFile)

51+ $(makeRelativeToProject "data/templates/rss-item.xml" >>= embedTemplate)

54−atomTemplate :: String

53+atomTemplate :: Template

55−atomTemplate = T.unpack $

54+atomTemplate =

55+ $(makeRelativeToProject "data/templates/atom.xml" >>= embedTemplate)

56+

57+atomItemTemplate :: Template

58+atomItemTemplate =

56− T.decodeUtf8 $(makeRelativeToProject "data/templates/atom.xml" >>= embedFile)

59+ $(makeRelativeToProject "data/templates/atom-item.xml" >>= embedTemplate)

58−atomItemTemplate :: String

59−atomItemTemplate = T.unpack $

60− T.decodeUtf8 $(makeRelativeToProject "data/templates/atom-item.xml" >>= embedFile)

62--------------------------------------------------------------------------------

63-- | This is a data structure to keep the configuration of a feed.

@@ -77,16 +77,13 @@ data FeedConfiguration = FeedConfiguration

78--------------------------------------------------------------------------------

79-- | Abstract function to render any feed.

80−renderFeed :: String -- ^ Default feed template

80+renderFeed :: Template -- ^ Default feed template

81− -> String -- ^ Default item template

81+ -> Template -- ^ Default item template

82 -> FeedConfiguration -- ^ Feed configuration

83 -> Context String -- ^ Context for the items

84 -> [Item String] -- ^ Input items

85 -> Compiler (Item String) -- ^ Resulting item

86−renderFeed defFeed defItem config itemContext items = do

86+renderFeed feedTpl itemTpl config itemContext items = do

87− feedTpl <- readTemplateFile defFeed

88− itemTpl <- readTemplateFile defItem

89−

90 protectedItems <- mapM (applyFilter protectCDATA) items

87 protectedItems <- mapM (applyFilter protectCDATA) items

91 body <- makeItem =<< applyTemplateList itemTpl itemContext' protectedItems

88 body <- makeItem =<< applyTemplateList itemTpl itemContext' protectedItems

92 applyTemplate feedTpl feedContext body

89 applyTemplate feedTpl feedContext body

@@ -120,18 +117,14 @@ renderFeed defFeed defItem config itemContext items = do

120 updatedField = field "updated" $ \_ -> case items of

117 updatedField = field "updated" $ \_ -> case items of

121 [] -> return "Unknown"

118 [] -> return "Unknown"

122 (x : _) -> unContext itemContext' "updated" [] x >>= \cf -> case cf of

119 (x : _) -> unContext itemContext' "updated" [] x >>= \cf -> case cf of

123− ListField _ _ -> fail "Hakyll.Web.Feed.renderFeed: Internal error"

124 StringField s -> return s

120 StringField s -> return s

125−

121+ _ -> fail "Hakyll.Web.Feed.renderFeed: Internal error"

126− readTemplateFile :: String -> Compiler Template

127− readTemplateFile value = pure $ template $ readTemplateElems value

128−

129

122

130--------------------------------------------------------------------------------

123--------------------------------------------------------------------------------

131-- | Render an RSS feed using given templates with a number of items.

124-- | Render an RSS feed using given templates with a number of items.

132renderRssWithTemplates ::

125renderRssWithTemplates ::

133− String -- ^ Feed template

126+ Template -- ^ Feed template

134− -> String -- ^ Item template

127+ -> Template -- ^ Item template

135 -> FeedConfiguration -- ^ Feed configuration

128 -> FeedConfiguration -- ^ Feed configuration

136 -> Context String -- ^ Item context

129 -> Context String -- ^ Item context

137 -> [Item String] -- ^ Feed items

130 -> [Item String] -- ^ Feed items

@@ -144,8 +137,8 @@ renderRssWithTemplates feedTemplate itemTemplate config context = renderFeed

144--------------------------------------------------------------------------------

137--------------------------------------------------------------------------------

145-- | Render an Atom feed using given templates with a number of items.

138-- | Render an Atom feed using given templates with a number of items.

146renderAtomWithTemplates ::

139renderAtomWithTemplates ::

147− String -- ^ Feed template

140+ Template -- ^ Feed template

148− -> String -- ^ Item template

141+ -> Template -- ^ Item template

149 -> FeedConfiguration -- ^ Feed configuration

142 -> FeedConfiguration -- ^ Feed configuration

150 -> Context String -- ^ Item context

143 -> Context String -- ^ Item context

151 -> [Item String] -- ^ Feed items

144 -> [Item String] -- ^ Feed items

lib/Hakyll/Web/Tags.hs+1−1

@@ -113,7 +113,7 @@ getTags identifier = do

113

114

115--------------------------------------------------------------------------------

116−-- | Obtain categories from a page.

116+-- | Obtain category from a page.

117getCategory :: MonadMetadata m => Identifier -> m [String]

118getCategory = return . return . takeBaseName . takeDirectory . toFilePath

119

lib/Hakyll/Web/Template.hs+24−2

@@ -138,19 +138,41 @@

138-- > 3...2...1

139-- >

140--

141+{-# LANGUAGE TemplateHaskell #-}

141module Hakyll.Web.Template

142module Hakyll.Web.Template

142 ( Template

143 ( Template

143− , template

144− , readTemplateElems

145 , templateBodyCompiler

144 , templateBodyCompiler

146 , templateCompiler

145 , templateCompiler

147 , applyTemplate

146 , applyTemplate

148 , loadAndApplyTemplate

147 , loadAndApplyTemplate

149 , applyAsTemplate

148 , applyAsTemplate

150 , readTemplate

149 , readTemplate

150+ , compileTemplateItem

151 , unsafeReadTemplateFile

152+ , embedTemplate

152 ) where

153 ) where

153

154

155

155--------------------------------------------------------------------------------

156--------------------------------------------------------------------------------

156import Hakyll.Web.Template.Internal

157import Hakyll.Web.Template.Internal

158+

159+

160+--------------------------------------------------------------------------------

161+import Data.FileEmbed (embedFile)

162+import qualified Data.Text as T

163+import qualified Data.Text.Encoding as T

164+import Language.Haskell.TH (Exp, Q)

165+

166+

167+--------------------------------------------------------------------------------

168+-- | Embed template allows you embed a template within the Haskell binary.

169+-- Example:

170+--

171+-- > myTemplate :: Template

172+-- > myTemplate = $(embedTemplate "test.html")

173+embedTemplate :: FilePath -> Q Exp

174+embedTemplate filePath = [|

175+ let source = T.unpack $ T.decodeUtf8 $(embedFile filePath) in

176+ case parseTemplateElemsFile filePath source of

177+ Left err -> error err

178+ Right tpl -> template filePath tpl |]

lib/Hakyll/Web/Template/Context.hs+99−29

@@ -1,3 +1,23 @@

1+-- | This module provides 'Context's which are used to expand expressions in

2+-- templates and allow for arbitrary customisation.

3+--

4+-- 'Template's define a small expression DSL which consists of strings,

5+-- identifiers and function application. There is no type system, every value is

6+-- a string and on the top level they get substituted verbatim into the page.

7+--

8+-- For example, you can build a context that contains

9+--

10+-- > … <> functionField "concat" (const . concat) <> …

11+--

12+-- which will allow you to use the @concat@ identifier as a function that takes

13+-- arbitrarily many stings and concatenates them to a new string:

14+--

15+-- > $partial(concat("templates/categories/", category))$

16+--

17+-- This will evaluate the @category@ field in the context, then prepend he path,

18+-- and include the referenced file as a template.

19+

20+

1--------------------------------------------------------------------------------

21--------------------------------------------------------------------------------

2{-# LANGUAGE CPP #-}

22{-# LANGUAGE CPP #-}

3{-# LANGUAGE ExistentialQuantification #-}

23{-# LANGUAGE ExistentialQuantification #-}

@@ -52,13 +72,16 @@ import Hakyll.Core.Metadata

52import Hakyll.Core.Provider

72import Hakyll.Core.Provider

53import Hakyll.Core.Util.String (needlePrefix, splitAll)

73import Hakyll.Core.Util.String (needlePrefix, splitAll)

54import Hakyll.Web.Html

74import Hakyll.Web.Html

75+import Prelude hiding (id)

55−import System.FilePath (splitDirectories, takeBaseName, dropExtension)

76+import System.FilePath (dropExtension, splitDirectories,

77+ takeBaseName)

58--------------------------------------------------------------------------------

80--------------------------------------------------------------------------------

59-- | Mostly for internal usage

81-- | Mostly for internal usage

60data ContextField

82data ContextField

83+ = EmptyField

61− = StringField String

84+ | StringField String

62 | forall a. ListField (Context a) [Item a]

85 | forall a. ListField (Context a) [Item a]

@@ -83,6 +106,8 @@ newtype Context a = Context

106

107

85--------------------------------------------------------------------------------

108--------------------------------------------------------------------------------

109+-- | Tries to find a key in the left context,

110+-- or when that fails in the right context.

86#if MIN_VERSION_base(4,9,0)

111#if MIN_VERSION_base(4,9,0)

87instance Semigroup (Context a) where

112instance Semigroup (Context a) where

88 (<>) (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i

113 (<>) (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i

@@ -99,37 +124,55 @@ instance Monoid (Context a) where

124

100--------------------------------------------------------------------------------

125--------------------------------------------------------------------------------

101field' :: String -> (Item a -> Compiler ContextField) -> Context a

126field' :: String -> (Item a -> Compiler ContextField) -> Context a

102−field' key value = Context $ \k _ i -> if k == key then value i else empty

127+field' key value = Context $ \k _ i ->

128+ if k == key

129+ then value i

130+ else noResult $ "Tried field " ++ key

103

131

104

132

105--------------------------------------------------------------------------------

133--------------------------------------------------------------------------------

106−-- | Constructs a new field in the 'Context.'

134+-- | Constructs a new field for a 'Context'.

135+-- If the key matches, the compiler is run and its result is substituted in the

136+-- template.

137+--

138+-- If the compiler fails, the field will be considered non-existent

139+-- in an @$if()$@ macro or ultimately break the template application

140+-- (unless the key is found in another context when using '<>').

141+-- Use 'empty' or 'noResult' for intentional failures of fields used in

142+-- @$if()$@, to distinguish them from exceptions thrown with 'fail'.

107field

143field

108 :: String -- ^ Key

144 :: String -- ^ Key

109 -> (Item a -> Compiler String) -- ^ Function that constructs a value based

145 -> (Item a -> Compiler String) -- ^ Function that constructs a value based

110− -- on the item

146+ -- on the item (e.g. accessing metadata)

111 -> Context a

147 -> Context a

112field key value = field' key (fmap StringField . value)

148field key value = field' key (fmap StringField . value)

113

149

114

150

115--------------------------------------------------------------------------------

151--------------------------------------------------------------------------------

116-- | Creates a 'field' to use with the @$if()$@ template macro.

152-- | Creates a 'field' to use with the @$if()$@ template macro.

153+-- Attempting to substitute the field into the template will cause an error.

117boolField

154boolField

118 :: String

155 :: String

119 -> (Item a -> Bool)

156 -> (Item a -> Bool)

120 -> Context a

157 -> Context a

121−boolField name f = field name (\i -> if f i

158+boolField name f = field' name (\i -> if f i

122− then pure (error $ unwords ["no string value for bool field:",name])

159+ then return EmptyField

123− else empty)

160+ else noResult $ "Field " ++ name ++ " is false")

124

161

125

162

126--------------------------------------------------------------------------------

163--------------------------------------------------------------------------------

127−-- | Creates a 'field' that does not depend on the 'Item'

164+-- | Creates a 'field' that does not depend on the 'Item' but always yields

165+-- the same string

128−constField :: String -> String -> Context a

166+constField :: String -- ^ Key

167+ -> String -- ^ Value

168+ -> Context a

129constField key = field key . const . return

169constField key = field key . const . return

130

170

131

171

132--------------------------------------------------------------------------------

172--------------------------------------------------------------------------------

173+-- | Creates a list field to be consumed by a @$for(…)$@ expression.

174+-- The compiler returns multiple items which are rendered in the loop body

175+-- with the supplied context.

133listField :: String -> Context a -> Compiler [Item a] -> Context b

176listField :: String -> Context a -> Compiler [Item a] -> Context b

134listField key c xs = listFieldWith key c (const xs)

177listField key c xs = listFieldWith key c (const xs)

135

178

@@ -139,28 +182,47 @@ listField key c xs = listFieldWith key c (const xs)

139-- 'c' are also accessible from the produced context.

182-- 'c' are also accessible from the produced context.

140-- Be careful when doing @listFieldWith k ca f <> cb@ as any fields in @ca@

183-- Be careful when doing @listFieldWith k ca f <> cb@ as any fields in @ca@

141-- will override fields in @cb@ with the same name.

184-- will override fields in @cb@ with the same name.

185+-- Creates a list field like 'listField', but supplies the current page

186+-- to the compiler.

142listFieldWith

187listFieldWith

143 :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b

188 :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b

144listFieldWith key c f = field' key $ fmap (ListField c) . f

189listFieldWith key c f = field' key $ fmap (ListField c) . f

145

190

146

191

147--------------------------------------------------------------------------------

192--------------------------------------------------------------------------------

193+-- | Creates a variadic function field.

194+--

195+-- The function will be called with the dynamically evaluated string arguments

196+-- from the template as well as the page that is currently rendered.

197+functionField :: String -- ^ Key

148−functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a

198+ -> ([String] -> Item a -> Compiler String) -- ^ Function

199+ -> Context a

149functionField name value = Context $ \k args i ->

200functionField name value = Context $ \k args i ->

150 if k == name

201 if k == name

151 then StringField <$> value args i

202 then StringField <$> value args i

152− else empty

203+ else noResult $ "Tried function field " ++ name

153

204

154

205

155--------------------------------------------------------------------------------

206--------------------------------------------------------------------------------

207+-- | Transform the respective string results of all fields in a context.

208+-- For example,

209+--

210+-- > mapContext (++"c") (constField "x" "a" <> constField "y" "b")

211+--

212+-- is equivalent to

213+--

214+-- > constField "x" "ac" <> constField "y" "bc"

215+--

156mapContext :: (String -> String) -> Context a -> Context a

216mapContext :: (String -> String) -> Context a -> Context a

157mapContext f (Context c) = Context $ \k a i -> do

217mapContext f (Context c) = Context $ \k a i -> do

158 fld <- c k a i

218 fld <- c k a i

159 case fld of

219 case fld of

220+ EmptyField -> wrongType "boolField"

160 StringField str -> return $ StringField (f str)

221 StringField str -> return $ StringField (f str)

161− ListField _ _ -> fail $

222+ _ -> wrongType "ListField"

223+ where

162− "Hakyll.Web.Template.Context.mapContext: " ++

224+ wrongType typ = fail $ "Hakyll.Web.Template.Context.mapContext: " ++

163− "can't map over a ListField!"

225+ "can't map over a " ++ typ ++ "!"

164

226

165--------------------------------------------------------------------------------

227--------------------------------------------------------------------------------

166-- | A context that allows snippet inclusion. In processed file, use as:

228-- | A context that allows snippet inclusion. In processed file, use as:

@@ -169,15 +231,15 @@ mapContext f (Context c) = Context $ \k a i -> do

169-- > $snippet("path/to/snippet/")$

231-- > $snippet("path/to/snippet/")$

170-- > ...

232-- > ...

171--

233--

172−-- The contents of the included file will not be interpolated.

234+-- The contents of the included file will not be interpolated like @partial@

235+-- does it.

173--

236--

174snippetField :: Context String

237snippetField :: Context String

175snippetField = functionField "snippet" f

238snippetField = functionField "snippet" f

176 where

239 where

177 f [contentsPath] _ = loadBody (fromFilePath contentsPath)

240 f [contentsPath] _ = loadBody (fromFilePath contentsPath)

178− f _ i = error $

241+ f [] _ = fail "No argument to function 'snippet()'"

179− "Too many arguments to function 'snippet()' in item " ++

242+ f _ _ = fail "Too many arguments to function 'snippet()'"

180− show (itemIdentifier i)

181

243

182--------------------------------------------------------------------------------

244--------------------------------------------------------------------------------

183-- | A context that contains (in that order)

245-- | A context that contains (in that order)

@@ -197,8 +259,7 @@ defaultContext =

197 metadataField `mappend`

259 metadataField `mappend`

198 urlField "url" `mappend`

260 urlField "url" `mappend`

199 pathField "path" `mappend`

261 pathField "path" `mappend`

200− titleField "title" `mappend`

262+ titleField "title"

201− missingField

202

263

203

264

204--------------------------------------------------------------------------------

265--------------------------------------------------------------------------------

@@ -216,15 +277,20 @@ bodyField key = field key $ return . itemBody

216-- | Map any field to its metadata value, if present

277-- | Map any field to its metadata value, if present

217metadataField :: Context a

278metadataField :: Context a

218metadataField = Context $ \k _ i -> do

279metadataField = Context $ \k _ i -> do

219− value <- getMetadataField (itemIdentifier i) k

280+ let id = itemIdentifier i

281+ empty' = noResult $ "No '" ++ k ++ "' field in metadata " ++

282+ "of item " ++ show id

283+ value <- getMetadataField id k

220− maybe empty (return . StringField) value

284+ maybe empty' (return . StringField) value

221

285

222

286

223--------------------------------------------------------------------------------

287--------------------------------------------------------------------------------

224-- | Absolute url to the resulting item

288-- | Absolute url to the resulting item

225urlField :: String -> Context a

289urlField :: String -> Context a

226−urlField key = field key $

290+urlField key = field key $ \i -> do

291+ let id = itemIdentifier i

292+ empty' = fail $ "No route url found for item " ++ show id

227− fmap (maybe empty toUrl) . getRoute . itemIdentifier

293+ fmap (maybe empty' toUrl) $ getRoute id

228

294

229

295

230--------------------------------------------------------------------------------

296--------------------------------------------------------------------------------

@@ -291,7 +357,7 @@ dateField = dateFieldWith defaultTimeLocale

291--------------------------------------------------------------------------------

357--------------------------------------------------------------------------------

292-- | This is an extended version of 'dateField' that allows you to

358-- | This is an extended version of 'dateField' that allows you to

293-- specify a time locale that is used for outputting the date. For more

359-- specify a time locale that is used for outputting the date. For more

294−-- details, see 'dateField'.

360+-- details, see 'dateField' and 'formatTime'.

295dateFieldWith :: TimeLocale -- ^ Output time locale

361dateFieldWith :: TimeLocale -- ^ Output time locale

296 -> String -- ^ Destination key

362 -> String -- ^ Destination key

297 -> String -- ^ Format to use on the date

363 -> String -- ^ Format to use on the date

@@ -346,6 +412,7 @@ getItemModificationTime identifier = do

346

412

347

413

348--------------------------------------------------------------------------------

414--------------------------------------------------------------------------------

415+-- | Creates a field with the last modification date of the underlying item.

349modificationTimeField :: String -- ^ Key

416modificationTimeField :: String -- ^ Key

350 -> String -- ^ Format

417 -> String -- ^ Format

351 -> Context a -- ^ Resulting context

418 -> Context a -- ^ Resulting context

@@ -353,6 +420,8 @@ modificationTimeField = modificationTimeFieldWith defaultTimeLocale

353

420

354

421

355--------------------------------------------------------------------------------

422--------------------------------------------------------------------------------

423+-- | Creates a field with the last modification date of the underlying item

424+-- in a custom localisation format (see 'formatTime').

356modificationTimeFieldWith :: TimeLocale -- ^ Time output locale

425modificationTimeFieldWith :: TimeLocale -- ^ Time output locale

357 -> String -- ^ Key

426 -> String -- ^ Key

358 -> String -- ^ Format

427 -> String -- ^ Format

@@ -391,10 +460,11 @@ teaserFieldWithSeparator separator key snapshot = field key $ \item -> do

391

460

392

461

393--------------------------------------------------------------------------------

462--------------------------------------------------------------------------------

463+-- | Constantly reports any field as missing. Mostly for internal usage,

464+-- it is the last choice in every context used in a template application.

394missingField :: Context a

465missingField :: Context a

395−missingField = Context $ \k _ i -> fail $

466+missingField = Context $ \k _ _ -> noResult $

396− "Missing field $" ++ k ++ "$ in context for item " ++

467+ "Missing field '" ++ k ++ "' in context"

397− show (itemIdentifier i)

398

468

399parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime

469parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime

400#if MIN_VERSION_time(1,5,0)

470#if MIN_VERSION_time(1,5,0)

lib/Hakyll/Web/Template/Internal.hs+101−43

@@ -1,15 +1,18 @@

1+{-# LANGUAGE DeriveAnyClass #-}

2+{-# LANGUAGE DeriveGeneric #-}

1{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE ScopedTypeVariables #-}

3module Hakyll.Web.Template.Internal

6module Hakyll.Web.Template.Internal

4 ( Template (..)

7 ( Template (..)

5 , template

8 , template

6 , templateBodyCompiler

9 , templateBodyCompiler

7 , templateCompiler

10 , templateCompiler

8 , applyTemplate

11 , applyTemplate

9− , applyTemplate'

10 , loadAndApplyTemplate

12 , loadAndApplyTemplate

11 , applyAsTemplate

13 , applyAsTemplate

12 , readTemplate

14 , readTemplate

15+ , compileTemplateItem

13 , unsafeReadTemplateFile

16 , unsafeReadTemplateFile

15 , module Hakyll.Web.Template.Internal.Element

18 , module Hakyll.Web.Template.Internal.Element

@@ -19,16 +22,18 @@ module Hakyll.Web.Template.Internal

20--------------------------------------------------------------------------------

23--------------------------------------------------------------------------------

21import Control.Monad (forM)

24import Control.Monad (forM)

22−import Control.Monad.Except (MonadError (..))

25+import Control.Monad.Except (MonadError (..), catchError)

23import Data.Binary (Binary)

26import Data.Binary (Binary)

24import Data.List (intercalate)

27import Data.List (intercalate)

28+import qualified Data.List.NonEmpty as NonEmpty

25import Data.Typeable (Typeable)

29import Data.Typeable (Typeable)

26import GHC.Exts (IsString (..))

30import GHC.Exts (IsString (..))

27−import Prelude hiding (id)

31+import GHC.Generics (Generic)

30--------------------------------------------------------------------------------

34--------------------------------------------------------------------------------

31import Hakyll.Core.Compiler

35import Hakyll.Core.Compiler

36+import Hakyll.Core.Compiler.Internal

32import Hakyll.Core.Identifier

37import Hakyll.Core.Identifier

33import Hakyll.Core.Item

38import Hakyll.Core.Item

34import Hakyll.Core.Writable

39import Hakyll.Core.Writable

@@ -39,9 +44,10 @@ import Hakyll.Web.Template.Internal.Trim

40--------------------------------------------------------------------------------

45--------------------------------------------------------------------------------

41-- | Datatype used for template substitutions.

46-- | Datatype used for template substitutions.

42−newtype Template = Template

47+data Template = Template

43− { unTemplate :: [TemplateElement]

48+ { tplElements :: [TemplateElement]

49+ , tplOrigin :: FilePath -- Only for error messages.

44− } deriving (Show, Eq, Binary, Typeable)

50+ } deriving (Show, Eq, Generic, Binary, Typeable)

47--------------------------------------------------------------------------------

53--------------------------------------------------------------------------------

@@ -57,39 +63,68 @@ instance IsString Template where

58--------------------------------------------------------------------------------

64--------------------------------------------------------------------------------

59-- | Wrap the constructor to ensure trim is called.

65-- | Wrap the constructor to ensure trim is called.

60−template :: [TemplateElement] -> Template

66+template :: FilePath -> [TemplateElement] -> Template

61−template = Template . trim

67+template p = flip Template p . trim

64--------------------------------------------------------------------------------

70--------------------------------------------------------------------------------

71+-- | Parse a string into a template.

72+-- You should prefer 'compileTemplateItem' over this.

65readTemplate :: String -> Template

73readTemplate :: String -> Template

66−readTemplate = Template . trim . readTemplateElems

74+readTemplate = either error (template origin) . parseTemplateElemsFile origin

75+ where

76+ origin = "{literal}"

77+{-# DEPRECATED readTemplate "Use templateCompiler instead" #-}

78+

79+--------------------------------------------------------------------------------

80+-- | Parse an item body into a template.

81+-- Provides useful error messages in the 'Compiler' monad.

82+compileTemplateItem :: Item String -> Compiler Template

83+compileTemplateItem item = let file = itemIdentifier item

84+ in compileTemplateFile file (itemBody item)

85+

86+--------------------------------------------------------------------------------

87+compileTemplateFile :: Identifier -> String -> Compiler Template

88+compileTemplateFile file = either fail (return . template origin)

89+ . parseTemplateElemsFile origin

90+ where

91+ origin = show file

68--------------------------------------------------------------------------------

93--------------------------------------------------------------------------------

69-- | Read a template, without metadata header

94-- | Read a template, without metadata header

70templateBodyCompiler :: Compiler (Item Template)

95templateBodyCompiler :: Compiler (Item Template)

71templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do

96templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do

72 item <- getResourceBody

97 item <- getResourceBody

73− file <- getResourceFilePath

98+ file <- getUnderlying

74− return $ fmap (template . readTemplateElemsFile file) item

99+ withItemBody (compileTemplateFile file) item

100

76--------------------------------------------------------------------------------

101--------------------------------------------------------------------------------

77-- | Read complete file contents as a template

102-- | Read complete file contents as a template

78templateCompiler :: Compiler (Item Template)

103templateCompiler :: Compiler (Item Template)

79templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do

104templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do

80 item <- getResourceString

105 item <- getResourceString

81− file <- getResourceFilePath

106+ file <- getUnderlying

82− return $ fmap (template . readTemplateElemsFile file) item

107+ withItemBody (compileTemplateFile file) item

108

109

85--------------------------------------------------------------------------------

110--------------------------------------------------------------------------------

111+-- | Interpolate template expressions from context values in a page

86applyTemplate :: Template -- ^ Template

112applyTemplate :: Template -- ^ Template

87 -> Context a -- ^ Context

113 -> Context a -- ^ Context

88 -> Item a -- ^ Page

114 -> Item a -- ^ Page

89 -> Compiler (Item String) -- ^ Resulting item

115 -> Compiler (Item String) -- ^ Resulting item

90applyTemplate tpl context item = do

116applyTemplate tpl context item = do

91− body <- applyTemplate' (unTemplate tpl) context item

117+ body <- applyTemplate' (tplElements tpl) context item `catchError` handler

92 return $ itemSetBody body item

118 return $ itemSetBody body item

119+ where

120+ tplName = tplOrigin tpl

121+ itemName = show $ itemIdentifier item

122+ handler es = fail $ "Hakyll.Web.Template.applyTemplate: Failed to " ++

123+ (if tplName == itemName

124+ then "interpolate template in item " ++ itemName

125+ else "apply template " ++ tplName ++ " to item " ++ itemName) ++

126+ ":\n" ++ intercalate ",\n" es

127+

128

129

95--------------------------------------------------------------------------------

130--------------------------------------------------------------------------------

@@ -106,9 +141,6 @@ applyTemplate' tes context x = go tes

106

141

107 go = fmap concat . mapM applyElem

142 go = fmap concat . mapM applyElem

108

143

109− trimError = error $ "Hakyll.Web.Template.applyTemplate: template not " ++

110− "fully trimmed."

111−

112 ---------------------------------------------------------------------------

144 ---------------------------------------------------------------------------

113

145

114 applyElem :: TemplateElement -> Compiler String

146 applyElem :: TemplateElement -> Compiler String

@@ -119,29 +151,43 @@ applyTemplate' tes context x = go tes

119

151

120 applyElem (Chunk c) = return c

152 applyElem (Chunk c) = return c

121

153

122− applyElem (Expr e) = applyExpr e >>= getString e

154+ applyElem (Expr e) = withErrorMessage evalMsg (applyStringExpr typeMsg e)

155+ where

156+ evalMsg = "In expr '$" ++ show e ++ "$'"

157+ typeMsg = "expr '$" ++ show e ++ "$'"

123

158

124 applyElem Escaped = return "$"

159 applyElem Escaped = return "$"

125

160

126− applyElem (If e t mf) = (applyExpr e >> go t) `catchError` handler

161+ applyElem (If e t mf) = compilerTry (applyExpr e) >>= handle

127 where

162 where

128− handler _ = case mf of

163+ f = maybe (return "") go mf

129− Nothing -> return ""

164+ handle (Right _) = go t

130− Just f -> go f

165+ handle (Left (CompilationNoResult _)) = f

131−

166+ handle (Left (CompilationFailure es)) = debug (NonEmpty.toList es) >> f

167+ debug = compilerDebugEntries ("Hakyll.Web.Template.applyTemplate: " ++

168+ "[ERROR] in 'if' condition on expr '" ++ show e ++ "':")

169+

132− applyElem (For e b s) = applyExpr e >>= \cf -> case cf of

170+ applyElem (For e b s) = withErrorMessage headMsg (applyExpr e) >>= \cf -> case cf of

133− StringField _ -> fail $

171+ EmptyField -> expected "list" "boolean" typeMsg

134− "Hakyll.Web.Template.applyTemplateWith: expected ListField but " ++

172+ StringField _ -> expected "list" "string" typeMsg

135− "got StringField for expr " ++ show e

136− ListField c xs -> do

173+ ListField c xs -> withErrorMessage bodyMsg $ do

137 sep <- maybe (return "") go s

174 sep <- maybe (return "") go s

138 bs <- forM xs $ applyTemplate' b $ c <> bindItem context x

175 bs <- forM xs $ applyTemplate' b $ c <> bindItem context x

139 return $ intercalate sep bs

176 return $ intercalate sep bs

140−

177+ where

178+ headMsg = "In expr '$for(" ++ show e ++ ")$'"

179+ typeMsg = "loop expr '" ++ show e ++ "'"

180+ bodyMsg = "In loop context of '$for(" ++ show e ++ ")$'"

181+

141− applyElem (Partial e) = do

182+ applyElem (Partial e) = withErrorMessage headMsg $

142− p <- applyExpr e >>= getString e

183+ applyStringExpr typeMsg e >>= \p ->

184+ withErrorMessage inclMsg $ do

143− Template tpl' <- loadBody (fromFilePath p)

185+ tpl' <- loadBody (fromFilePath p)

144− applyTemplate' tpl' context x

186+ itemBody <$> applyTemplate tpl' context x

187+ where

188+ headMsg = "In expr '$partial(" ++ show e ++ ")$'"

189+ typeMsg = "partial expr '" ++ show e ++ "'"

190+ inclMsg = "In inclusion of '$partial(" ++ show e ++ ")$'"

145

191

146 ---------------------------------------------------------------------------

192 ---------------------------------------------------------------------------

147

193

@@ -150,17 +196,29 @@ applyTemplate' tes context x = go tes

150 applyExpr (Ident (TemplateKey k)) = context' k [] x

196 applyExpr (Ident (TemplateKey k)) = context' k [] x

151

197

152 applyExpr (Call (TemplateKey k) args) = do

198 applyExpr (Call (TemplateKey k) args) = do

153− args' <- mapM (\e -> applyExpr e >>= getString e) args

199+ args' <- mapM (\e -> applyStringExpr (typeMsg e) e) args

154 context' k args' x

200 context' k args' x

201+ where

202+ typeMsg e = "argument '" ++ show e ++ "'"

155

203

156 applyExpr (StringLiteral s) = return (StringField s)

204 applyExpr (StringLiteral s) = return (StringField s)

157

205

158 ----------------------------------------------------------------------------

206 ----------------------------------------------------------------------------

159

207

208+ applyStringExpr :: String -> TemplateExpr -> Compiler String

209+ applyStringExpr msg expr =

210+ applyExpr expr >>= getString

211+ where

212+ getString EmptyField = expected "string" "boolean" msg

160− getString _ (StringField s) = return s

213+ getString (StringField s) = return s

161− getString e (ListField _ _) = fail $

214+ getString (ListField _ _) = expected "string" "list" msg

162− "Hakyll.Web.Template.applyTemplateWith: expected StringField but " ++

215+

163− "got ListField for expr " ++ show e

216+ expected typ act expr = fail $ unwords ["Hakyll.Web.Template.applyTemplate:",

217+ "expected", typ, "but got", act, "for", expr]

218+

219+ -- expected to never happen with all templates constructed by 'template'

220+ trimError = fail $

221+ "Hakyll.Web.Template.applyTemplate: template not fully trimmed."

164

222

165

223

166--------------------------------------------------------------------------------

224--------------------------------------------------------------------------------

@@ -190,14 +248,14 @@ loadAndApplyTemplate identifier context item = do

190applyAsTemplate :: Context String -- ^ Context

248applyAsTemplate :: Context String -- ^ Context

191 -> Item String -- ^ Item and template

249 -> Item String -- ^ Item and template

192 -> Compiler (Item String) -- ^ Resulting item

250 -> Compiler (Item String) -- ^ Resulting item

193−applyAsTemplate context item =

251+applyAsTemplate context item = do

194− let tpl = template $ readTemplateElemsFile file (itemBody item)

252+ tpl <- compileTemplateItem item

195− file = toFilePath $ itemIdentifier item

196− in applyTemplate tpl context item

253+ applyTemplate tpl context item

197

254

198

255

199--------------------------------------------------------------------------------

256--------------------------------------------------------------------------------

200unsafeReadTemplateFile :: FilePath -> Compiler Template

257unsafeReadTemplateFile :: FilePath -> Compiler Template

201unsafeReadTemplateFile file = do

258unsafeReadTemplateFile file = do

202 tpl <- unsafeCompiler $ readFile file

259 tpl <- unsafeCompiler $ readFile file

203− pure $ template $ readTemplateElemsFile file tpl

260+ compileTemplateFile (fromFilePath file) tpl

261+{-# DEPRECATED unsafeReadTemplateFile "Use templateCompiler" #-}

lib/Hakyll/Web/Template/Internal/Element.hs+7−14

@@ -7,14 +7,14 @@ module Hakyll.Web.Template.Internal.Element

7 , TemplateExpr (..)

8 , TemplateElement (..)

9 , templateElems

10− , readTemplateElems

10+ , parseTemplateElemsFile

11− , readTemplateElemsFile

12 ) where

11 ) where

15--------------------------------------------------------------------------------

14--------------------------------------------------------------------------------

16−import Control.Applicative ((<|>))

15+import Control.Applicative ((<|>), (<*))

17import Control.Monad (void)

16import Control.Monad (void)

17+import Control.Arrow (left)

18import Data.Binary (Binary, get, getWord8, put, putWord8)

19import Data.List (intercalate)

20import Data.Maybe (isJust)

@@ -107,17 +107,10 @@ instance Binary TemplateExpr where

107 2 -> StringLiteral <$> get

108 _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"

109

110−

111−--------------------------------------------------------------------------------

112−readTemplateElems :: String -> [TemplateElement]

113−readTemplateElems = readTemplateElemsFile "{literal}"

114−

115−

116--------------------------------------------------------------------------------

110--------------------------------------------------------------------------------

117−readTemplateElemsFile :: FilePath -> String -> [TemplateElement]

111+parseTemplateElemsFile :: FilePath -> String -> Either String [TemplateElement]

118−readTemplateElemsFile file input = case P.parse templateElems file input of

119− Left err -> error $ "Cannot parse template: " ++ show err

112+parseTemplateElemsFile file = left (\e -> "Cannot parse template " ++ show e)

120− Right t -> t

113+ . P.parse (templateElems <* P.eof) file

121

114

122

115

123--------------------------------------------------------------------------------

116--------------------------------------------------------------------------------

@@ -167,7 +160,7 @@ trimOpen = do

167--------------------------------------------------------------------------------

160--------------------------------------------------------------------------------

168trimClose :: P.Parser Bool

161trimClose :: P.Parser Bool

169trimClose = do

162trimClose = do

170− trimIfR <- P.optionMaybe $ P.try (P.char '-')

163+ trimIfR <- P.optionMaybe $ (P.char '-')

171 void $ P.char '$'

164 void $ P.char '$'

172 pure $ isJust trimIfR

165 pure $ isJust trimIfR

173

166

tests/Hakyll/Core/UnixFilter/Tests.hs+6−16

@@ -6,18 +6,16 @@ module Hakyll.Core.UnixFilter.Tests

8--------------------------------------------------------------------------------

9−import Data.List (isInfixOf)

10−import Test.Tasty (TestTree, testGroup)

9+import Test.Tasty (TestTree, testGroup)

11−import Test.Tasty.HUnit (testCase)

10+import Test.Tasty.HUnit (testCase)

12−import qualified Test.Tasty.HUnit as H

11+import qualified Test.Tasty.HUnit as H

15--------------------------------------------------------------------------------

14--------------------------------------------------------------------------------

16import Hakyll.Core.Compiler

15import Hakyll.Core.Compiler

17−import Hakyll.Core.Compiler.Internal

16+import Hakyll.Core.Identifier

18import Hakyll.Core.Item

17import Hakyll.Core.Item

19import Hakyll.Core.UnixFilter

18import Hakyll.Core.UnixFilter

20−import Hakyll.Core.Identifier

21import TestSuite.Util

19import TestSuite.Util

@@ -51,10 +49,7 @@ unixFilterFalse :: H.Assertion

51unixFilterFalse = do

49unixFilterFalse = do

52 store <- newTestStore

50 store <- newTestStore

53 provider <- newTestProvider store

51 provider <- newTestProvider store

54− result <- testCompiler store provider testMarkdown compiler

52+ testCompilerError store provider testMarkdown compiler "exit code"

55− case result of

56− CompilerError es -> True H.@=? any ("exit code" `isInfixOf`) es

57− _ -> H.assertFailure "Expecting CompilerError"

58 cleanTestEnv

53 cleanTestEnv

59 where

54 where

60 compiler = getResourceString >>= withItemBody (unixFilter "false" [])

55 compiler = getResourceString >>= withItemBody (unixFilter "false" [])

@@ -65,12 +60,7 @@ unixFilterError :: H.Assertion

65unixFilterError = do

60unixFilterError = do

66 store <- newTestStore

61 store <- newTestStore

67 provider <- newTestProvider store

62 provider <- newTestProvider store

68− result <- testCompiler store provider testMarkdown compiler

63+ testCompilerError store provider testMarkdown compiler "option"

69− case result of

70− CompilerError es -> True H.@=? any containsIncorrectOptionMessage es

71− _ -> H.assertFailure "Expecting CompilerError"

72 cleanTestEnv

64 cleanTestEnv

73 where

65 where

74 compiler = getResourceString >>= withItemBody (unixFilter "head" ["-#"])

66 compiler = getResourceString >>= withItemBody (unixFilter "head" ["-#"])

75− incorrectOptionMessages = ["invalid option", "illegal option"]

76− containsIncorrectOptionMessage output = any (`isInfixOf` output) incorrectOptionMessages

tests/Hakyll/Web/Template/Context/Tests.hs+2−2

@@ -65,9 +65,9 @@ testContextDone store provider identifier key context =

65 cf <- unContext context key [] item

66 case cf of

67 StringField str -> return str

68− ListField _ _ -> error $

68+ _ -> error $

69 "Hakyll.Web.Template.Context.Tests.testContextDone: " ++

70− "Didn't expect ListField"

70+ "expected StringField"

72--------------------------------------------------------------------------------

tests/Hakyll/Web/Template/Tests.hs+48−16

@@ -1,5 +1,6 @@

1--------------------------------------------------------------------------------

2{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE TemplateHaskell #-}

3module Hakyll.Web.Template.Tests

4module Hakyll.Web.Template.Tests

4 ( tests

5 ( tests

5 ) where

6 ) where

@@ -7,9 +8,10 @@ module Hakyll.Web.Template.Tests

8--------------------------------------------------------------------------------

9--------------------------------------------------------------------------------

9import Test.Tasty (TestTree, testGroup)

10import Test.Tasty (TestTree, testGroup)

10−import Test.Tasty.HUnit (Assertion, testCase, (@=?),

11+import Test.Tasty.HUnit (Assertion, assertBool, testCase,

11− (@?=))

12+ (@=?), (@?=))

14+import Data.Either (isLeft)

14--------------------------------------------------------------------------------

16--------------------------------------------------------------------------------

15import Hakyll.Core.Compiler

17import Hakyll.Core.Compiler

@@ -32,13 +34,13 @@ tests = testGroup "Hakyll.Web.Template.Tests" $ concat

32 , testCase "applyJoinTemplateList" testApplyJoinTemplateList

34 , testCase "applyJoinTemplateList" testApplyJoinTemplateList

33 ]

35 ]

35− , fromAssertions "readTemplate"

37+ , fromAssertions "parseTemplate"

36− [ [Chunk "Hello ", Expr (Call "guest" [])]

38+ [ Right [Chunk "Hello ", Expr (Call "guest" [])]

37− @=? readTemplateElems "Hello $guest()$"

39+ @=? parse "Hello $guest()$"

38− , [If (Call "a" [StringLiteral "bar"]) [Chunk "foo"] Nothing]

40+ , Right [If (Call "a" [StringLiteral "bar"]) [Chunk "foo"] Nothing]

39− @=? readTemplateElems "$if(a(\"bar\"))$foo$endif$"

41+ @=? parse "$if(a(\"bar\"))$foo$endif$"

40 -- 'If' trim check.

42 -- 'If' trim check.

41− , [ TrimL

43+ , Right [ TrimL

42 , If (Ident (TemplateKey "body"))

44 , If (Ident (TemplateKey "body"))

43 [ TrimR

45 [ TrimR

44 , Chunk "\n"

46 , Chunk "\n"

@@ -54,29 +56,39 @@ tests = testGroup "Hakyll.Web.Template.Tests" $ concat

54 ])

56 ])

55 , TrimR

57 , TrimR

56 ]

58 ]

57− @=? readTemplateElems "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"

59+ @=? parse "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"

58 -- 'For' trim check.

60 -- 'For' trim check.

59− , [ TrimL

61+ , Right [ TrimL

60 , For (Ident (TemplateKey "authors"))

62 , For (Ident (TemplateKey "authors"))

61 [TrimR, Chunk "\n body \n", TrimL]

63 [TrimR, Chunk "\n body \n", TrimL]

62 Nothing

64 Nothing

63 , TrimR

65 , TrimR

64 ]

66 ]

65− @=? readTemplateElems "$-for(authors)-$\n body \n$-endfor-$"

67+ @=? parse "$-for(authors)-$\n body \n$-endfor-$"

66 -- 'Partial' trim check.

68 -- 'Partial' trim check.

67− , [ TrimL

69+ , Right [ TrimL

68 , Partial (StringLiteral "path")

70 , Partial (StringLiteral "path")

69 , TrimR

71 , TrimR

70 ]

72 ]

71− @=? readTemplateElems "$-partial(\"path\")-$"

73+ @=? parse "$-partial(\"path\")-$"

72 -- 'Expr' trim check.

74 -- 'Expr' trim check.

73− , [ TrimL

75+ , Right [ TrimL

74 , Expr (Ident (TemplateKey "foo"))

76 , Expr (Ident (TemplateKey "foo"))

75 , TrimR

77 , TrimR

76 ]

78 ]

77− @=? readTemplateElems "$-foo-$"

79+ @=? parse "$-foo-$"

80+ -- fail on incomplete template.

81+ , assertBool "did not yield error" $ isLeft $

82+ parse "a$b"

83+ -- fail on mismatched template syntax.

84+ , assertBool "did not fail to parse" $ isLeft $

85+ parse "$for(xs)$\n foo\n$endif$"

78 ]

86 ]

87+

88+ , [testCase "embeddedTemplate" testEmbeddedTemplate]

79 ]

89 ]

90+ where

91+ parse = parseTemplateElemsFile ""

82--------------------------------------------------------------------------------

94--------------------------------------------------------------------------------

@@ -113,6 +125,8 @@ testApplyJoinTemplateList :: Assertion

113testApplyJoinTemplateList = do

125testApplyJoinTemplateList = do

114 store <- newTestStore

126 store <- newTestStore

115 provider <- newTestProvider store

127 provider <- newTestProvider store

128+ tpl <- testCompilerDone store provider "tpl" $

129+ compileTemplateItem (Item "tpl" "$body$")

116 str <- testCompilerDone store provider "item3" $

130 str <- testCompilerDone store provider "item3" $

117 applyJoinTemplateList ", " tpl defaultContext [i1, i2]

131 applyJoinTemplateList ", " tpl defaultContext [i1, i2]

118

132

@@ -121,4 +135,22 @@ testApplyJoinTemplateList = do

121 where

135 where

122 i1 = Item "item1" "Hello"

136 i1 = Item "item1" "Hello"

123 i2 = Item "item2" "World"

137 i2 = Item "item2" "World"

124− tpl = readTemplate "$body$"

138+

139+

140+--------------------------------------------------------------------------------

141+embeddedTemplate :: Template

142+embeddedTemplate = $(embedTemplate "tests/data/embed.html")

143+

144+--------------------------------------------------------------------------------

145+testEmbeddedTemplate :: Assertion

146+testEmbeddedTemplate = do

147+ store <- newTestStore

148+ provider <- newTestProvider store

149+ str <- testCompilerDone store provider "item3" $

150+ applyTemplate embeddedTemplate defaultContext item

151+

152+ itemBody str @?= "Hello, world\n"

153+ cleanTestEnv

154+ where

155+ item = Item "item1" "Hello, world"

156+

tests/TestSuite.hs+2

@@ -28,6 +28,7 @@ import qualified Hakyll.Web.Pandoc.FileType.Tests

28#endif

29import qualified Hakyll.Web.Template.Context.Tests

30import qualified Hakyll.Web.Template.Tests

31+import qualified Hakyll.Web.Tags.Tests

33--------------------------------------------------------------------------------

34--------------------------------------------------------------------------------

@@ -49,6 +50,7 @@ main = defaultMain $ testGroup "Hakyll"

49#ifdef USE_PANDOC

50#ifdef USE_PANDOC

50 , Hakyll.Web.Pandoc.FileType.Tests.tests

51 , Hakyll.Web.Pandoc.FileType.Tests.tests

51#endif

52#endif

53+ , Hakyll.Web.Tags.Tests.tests

52 , Hakyll.Web.Template.Context.Tests.tests

54 , Hakyll.Web.Template.Context.Tests.tests

53 , Hakyll.Web.Template.Tests.tests

55 , Hakyll.Web.Template.Tests.tests

54 ]

56 ]

tests/TestSuite/Util.hs+11−2

@@ -6,6 +6,7 @@ module TestSuite.Util

6 , newTestProvider

7 , testCompiler

8 , testCompilerDone

9+ , testCompilerError

9 , testConfiguration

10 , testConfiguration

10 , cleanTestEnv

11 , cleanTestEnv

11 , renderParagraphs

12 , renderParagraphs

@@ -13,7 +14,7 @@ module TestSuite.Util

15--------------------------------------------------------------------------------

16--------------------------------------------------------------------------------

16−import Data.List (intercalate)

17+import Data.List (intercalate, isInfixOf)

17import Data.Monoid (mempty)

18import Data.Monoid (mempty)

18import qualified Data.Set as S

19import qualified Data.Set as S

19import Test.Tasty

20import Test.Tasty

@@ -80,13 +81,21 @@ testCompilerDone store provider underlying compiler = do

80 CompilerDone x _ -> return x

81 CompilerDone x _ -> return x

81 CompilerError e -> fail $

82 CompilerError e -> fail $

82 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++

83 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++

83− " threw: " ++ intercalate "; " e

84+ " threw: " ++ intercalate "; " (compilerErrorMessages e)

84 CompilerRequire i _ -> fail $

85 CompilerRequire i _ -> fail $

85 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++

86 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++

86 " requires: " ++ show i

87 " requires: " ++ show i

87 CompilerSnapshot _ _ -> fail

88 CompilerSnapshot _ _ -> fail

88 "TestSuite.Util.testCompilerDone: unexpected CompilerSnapshot"

89 "TestSuite.Util.testCompilerDone: unexpected CompilerSnapshot"

91+testCompilerError :: Store -> Provider -> Identifier -> Compiler a -> String -> IO ()

92+testCompilerError store provider underlying compiler expectedMessage = do

93+ result <- testCompiler store provider underlying compiler

94+ case result of

95+ CompilerError e ->

96+ any (expectedMessage `isInfixOf`) (compilerErrorMessages e) @?

97+ "Expecting '" ++ expectedMessage ++ "' error"

98+ _ -> assertFailure "Expecting CompilerError"

91--------------------------------------------------------------------------------

100--------------------------------------------------------------------------------

92testConfiguration :: Configuration

101testConfiguration :: Configuration

tests/data/embed.htmlnew file+1

@@ -0,0 +1 @@

1+$body$