master..e8ea8cd · hakyll

git.iko.soy/hakyll

on e8ea8cd help sign in

CHANGELOG.md−13

since splitsnapshots

unifiedsplit

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

5# Releases

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

8−

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−

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

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

22- Bump pandoc to 2.7

9- Bump pandoc to 2.7

hakyll.cabal+4−6

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

1Name: hakyll

2−Version: 4.13.0.0

2+Version: 4.12.5.2

4Synopsis: A static website compiler library

5Description:

@@ -172,12 +172,10 @@ 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,

176 filepath >= 1.0 && < 1.5,

175 filepath >= 1.0 && < 1.5,

177 lrucache >= 1.1.1 && < 1.3,

176 lrucache >= 1.1.1 && < 1.3,

178 mtl >= 1 && < 2.3,

177 mtl >= 1 && < 2.3,

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

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

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

181 parsec >= 3.0 && < 3.2,

179 parsec >= 3.0 && < 3.2,

182 process >= 1.6 && < 1.7,

180 process >= 1.6 && < 1.7,

183 random >= 1.0 && < 1.2,

181 random >= 1.0 && < 1.2,

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

185 resourcet >= 1.1 && < 1.3,

183 resourcet >= 1.1 && < 1.3,

186 scientific >= 0.3.4 && < 0.4,

184 scientific >= 0.3.4 && < 0.4,

187 tagsoup >= 0.13.1 && < 0.15,

185 tagsoup >= 0.13.1 && < 0.15,

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

189 text >= 0.11 && < 1.3,

186 text >= 0.11 && < 1.3,

190 time >= 1.8 && < 1.10,

187 time >= 1.8 && < 1.10,

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

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

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

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

193 vector >= 0.11 && < 0.13,

190 vector >= 0.11 && < 0.13,

194− yaml >= 0.8.11 && < 0.12

191+ yaml >= 0.8.11 && < 0.12,

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

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

195

194

196 If flag(previewServer)

195 If flag(previewServer)

197 Build-depends:

196 Build-depends:

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

255 Hakyll.Web.CompressCss.Tests

254 Hakyll.Web.CompressCss.Tests

256 Hakyll.Web.Html.RelativizeUrls.Tests

255 Hakyll.Web.Html.RelativizeUrls.Tests

257 Hakyll.Web.Html.Tests

256 Hakyll.Web.Html.Tests

258− Hakyll.Web.Tags.Tests

259 Hakyll.Web.Template.Context.Tests

257 Hakyll.Web.Template.Context.Tests

260 Hakyll.Web.Template.Tests

258 Hakyll.Web.Template.Tests

261 TestSuite.Util

259 TestSuite.Util

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

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

24 , cached

25 , unsafeCompiler

26 , debugCompiler

27− , noResult

28− , withErrorMessage

29 ) where

27 ) where

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

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

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

31+import Control.Monad (when, unless)

34import Data.Binary (Binary)

32import Data.Binary (Binary)

35import Data.ByteString.Lazy (ByteString)

33import Data.ByteString.Lazy (ByteString)

36−import qualified Data.List.NonEmpty as NonEmpty

37import Data.Typeable (Typeable)

34import Data.Typeable (Typeable)

38import System.Environment (getProgName)

35import System.Environment (getProgName)

39import System.FilePath (takeExtension)

36import System.FilePath (takeExtension)

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

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

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

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

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

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

70makeItem x = do

66makeItem x = do

71 identifier <- getUnderlying

67 identifier <- getUnderlying

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

145

141

146

142

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

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

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.

152cached :: (Binary a, Typeable a)

144cached :: (Binary a, Typeable a)

153 => String

145 => String

154 -> Compiler a

146 -> Compiler a

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

185

177

186

178

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

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

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

189unsafeCompiler :: IO a -> Compiler a

180unsafeCompiler :: IO a -> Compiler a

190unsafeCompiler = compilerUnsafeIO

181unsafeCompiler = compilerUnsafeIO

191

182

192

183

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

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

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−--------------------------------------------------------------------------------

217−-- | Compiler for debugging purposes.

185+-- | Compiler for debugging purposes

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

219debugCompiler :: String -> Compiler ()

186debugCompiler :: String -> Compiler ()

220debugCompiler msg = do

187debugCompiler msg = do

221 logger <- compilerLogger <$> compilerAsk

188 logger <- compilerLogger <$> compilerAsk

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

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

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

2-- | Internally used compiler module

3{-# LANGUAGE CPP #-}

4−{-# LANGUAGE DeriveFunctor #-}

5{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE FlexibleInstances #-}

6{-# LANGUAGE GADTs #-}

5{-# LANGUAGE GADTs #-}

7{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

11 Snapshot

10 Snapshot

12 , CompilerRead (..)

11 , CompilerRead (..)

13 , CompilerWrite (..)

12 , CompilerWrite (..)

14− , CompilerErrors (..)

15 , CompilerResult (..)

13 , CompilerResult (..)

16 , Compiler (..)

14 , Compiler (..)

17 , runCompiler

15 , runCompiler

19 -- * Core operations

17 -- * Core operations

20− , compilerResult

21 , compilerTell

18 , compilerTell

22 , compilerAsk

19 , compilerAsk

23− , compilerUnsafeIO

24−

25− -- * Error operations

26 , compilerThrow

20 , compilerThrow

27− , compilerNoResult

28 , compilerCatch

21 , compilerCatch

29− , compilerTry

22+ , compilerResult

30− , compilerErrorMessages

23+ , compilerUnsafeIO

32 -- * Utilities

25 -- * Utilities

33− , compilerDebugEntries

34 , compilerTellDependencies

26 , compilerTellDependencies

35 , compilerTellCacheHits

27 , compilerTellCacheHits

36 ) where

28 ) where

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

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

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

41import Control.Exception (SomeException, handle)

33import Control.Exception (SomeException, handle)

42import Control.Monad (forM_)

34import Control.Monad (forM_)

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

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

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

45−import qualified Data.List.NonEmpty as NonEmpty

46#if MIN_VERSION_base(4,9,0)

36#if MIN_VERSION_base(4,9,0)

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

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

48#endif

38#endif

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

55import Hakyll.Core.Dependencies

45import Hakyll.Core.Dependencies

56import Hakyll.Core.Identifier

46import Hakyll.Core.Identifier

57import Hakyll.Core.Identifier.Pattern

47import Hakyll.Core.Identifier.Pattern

48+import Hakyll.Core.Logger (Logger)

58import qualified Hakyll.Core.Logger as Logger

49import qualified Hakyll.Core.Logger as Logger

59import Hakyll.Core.Metadata

50import Hakyll.Core.Metadata

60import Hakyll.Core.Provider

51import Hakyll.Core.Provider

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

84 , -- | Compiler store

75 , -- | Compiler store

85 compilerStore :: Store

76 compilerStore :: Store

86 , -- | Logger

77 , -- | Logger

87− compilerLogger :: Logger.Logger

78+ compilerLogger :: Logger

88 }

79 }

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

113

104

114

105

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

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

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

107+data CompilerResult a where

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

135− = CompilerDone a CompilerWrite

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

136− | CompilerSnapshot Snapshot (Compiler a)

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

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

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

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

138− | CompilerError (CompilerErrors String)

139

112

140

113

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

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

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

153 return $ case res of

126 return $ case res of

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

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

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

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

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

157 CompilerError e -> CompilerError e

129 CompilerError e -> CompilerError e

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

158 {-# INLINE fmap #-}

131 {-# INLINE fmap #-}

159

132

160

133

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

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

162instance Monad Compiler where

135instance Monad Compiler where

163− return x = compilerResult $ CompilerDone x mempty

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

164 {-# INLINE return #-}

137 {-# INLINE return #-}

165

138

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

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

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

173 CompilerSnapshot s c' -> CompilerSnapshot s $ do

146 CompilerSnapshot s c' -> CompilerSnapshot s $ do

174 compilerTell w -- Save dependencies!

147 compilerTell w -- Save dependencies!

175 c'

148 c'

149+ CompilerError e -> CompilerError e

176 CompilerRequire i c' -> CompilerRequire i $ do

150 CompilerRequire i c' -> CompilerRequire i $ do

177 compilerTell w -- Save dependencies!

151 compilerTell w -- Save dependencies!

178 c'

152 c'

179− CompilerError e -> CompilerError e

180

153

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

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

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

183 CompilerError e -> return $ CompilerError e

155 CompilerError e -> return $ CompilerError e

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

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

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

185

158

186 fail = compilerThrow . return

159 fail = compilerThrow . return

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

197

170

198

171

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

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

200−-- | Access provided metadata from anywhere

201instance MonadMetadata Compiler where

173instance MonadMetadata Compiler where

202 getMetadata = compilerGetMetadata

174 getMetadata = compilerGetMetadata

203 getMatches = compilerGetMatches

175 getMatches = compilerGetMatches

204

176

205

177

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

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

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

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

209instance MonadError [String] Compiler where

179instance MonadError [String] Compiler where

210− throwError = compilerThrow

180+ throwError = compilerThrow

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

181+ catchError = compilerCatch

212

182

213

183

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

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

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

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

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

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

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

218 where

187 where

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

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

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

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

221

190

222

191

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

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

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.

227instance Alternative Compiler where

193instance Alternative Compiler where

228− empty = compilerNoResult []

194+ empty = compilerThrow []

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

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

230− case (rx, ry) of

196+ logger <- compilerLogger <$> compilerAsk

231− (CompilationFailure xs, CompilationFailure ys) ->

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

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

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

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

199+ y

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

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

242

201

243

202

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

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

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

253compilerAsk :: Compiler CompilerRead

204compilerAsk :: Compiler CompilerRead

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

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

255{-# INLINE compilerAsk #-}

206{-# INLINE compilerAsk #-}

256

207

257

208

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

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

259−-- | Put a 'CompilerWrite'

260compilerTell :: CompilerWrite -> Compiler ()

210compilerTell :: CompilerWrite -> Compiler ()

261−compilerTell = compilerResult . CompilerDone ()

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

262{-# INLINE compilerTell #-}

212{-# INLINE compilerTell #-}

263

213

264

214

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

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

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.

279compilerThrow :: [String] -> Compiler a

216compilerThrow :: [String] -> Compiler a

280−compilerThrow = compilerResult . CompilerError .

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

281− maybe (CompilationNoResult []) CompilationFailure .

218+{-# INLINE compilerThrow #-}

282− NonEmpty.nonEmpty

283−

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

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

286−compilerNoResult = compilerResult . CompilerError . CompilationNoResult

287

219

288

220

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

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

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

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

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

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

311 res <- x r

224 res <- x r

312 case res of

225 case res of

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

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

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

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

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

316 CompilerError e -> unCompiler (f e) r

228 CompilerError e -> unCompiler (f e) r

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

317{-# INLINE compilerCatch #-}

230{-# INLINE compilerCatch #-}

318

231

319

232

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

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

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

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

322−compilerDebugLog ms = do

235+compilerResult :: CompilerResult a -> Compiler a

323− logger <- compilerLogger <$> compilerAsk

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

324− compilerUnsafeIO $ forM_ ms $ Logger.debug logger

237+{-# INLINE compilerResult #-}

238+

325

239

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

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

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

241+compilerUnsafeIO :: IO a -> Compiler a

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

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

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

243+ x <- io

330− where

244+ return $ CompilerDone x mempty

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

245+{-# INLINE compilerUnsafeIO #-}

332

246

333

247

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

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

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

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

336compilerTellDependencies ds = do

250compilerTellDependencies ds = do

337− compilerDebugLog $ map (\d ->

251+ logger <- compilerLogger <$> compilerAsk

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

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

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

339 compilerTell mempty {compilerDependencies = ds}

254 compilerTell mempty {compilerDependencies = ds}

340{-# INLINE compilerTellDependencies #-}

255{-# INLINE compilerTellDependencies #-}

341

256

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

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

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

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

95loadSnapshotBody :: (Binary a, Typeable a)

94loadSnapshotBody :: (Binary a, Typeable a)

96 => Identifier -> Snapshot -> Compiler a

95 => Identifier -> Snapshot -> Compiler a

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

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

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

104

103

105

104

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

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

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

108loadAllSnapshots :: (Binary a, Typeable a)

106loadAllSnapshots :: (Binary a, Typeable a)

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

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

110loadAllSnapshots pattern snapshot = do

108loadAllSnapshots pattern snapshot = do

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

@@ -18,7 +18,6 @@ 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)

22import Prelude hiding (error)

21import Prelude hiding (error)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

99−

100−

101−--------------------------------------------------------------------------------

102−indent :: String -> String

103−indent = intercalate "\n " . lines

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

@@ -27,7 +27,6 @@ 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)

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

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

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

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

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

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

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

54loadMetadataHeader fp = do

53loadMetadataHeader fp = do

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

54+ fileContent <- readFile fp

56 case parsePage fileContent of

55 case parsePage fileContent of

57 Right x -> return x

56 Right x -> return x

58 Left err -> throwIO $ MetadataException fp err

57 Left err -> throwIO $ MetadataException fp err

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

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

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

62loadMetadataFile :: FilePath -> IO Metadata

61loadMetadataFile :: FilePath -> IO Metadata

63loadMetadataFile fp = do

62loadMetadataFile fp = do

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

63+ fileContent <- B.readFile fp

65 let errOrMeta = Yaml.decodeEither' fileContent

64 let errOrMeta = Yaml.decodeEither' fileContent

66 either (fail . show) return errOrMeta

65 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 e -> throwError $ case compilerErrorMessages e of

202+ CompilerError [] -> throwError

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

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

204− es -> intercalate "; " es

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

205

206 -- Signal that a snapshot was saved ->

207 CompilerSnapshot snapshot c -> do

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

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

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

19+import Control.Exception (IOException, handle)

19import qualified Crypto.Hash.MD5 as MD5

20import qualified Crypto.Hash.MD5 as MD5

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

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

21import qualified Data.ByteString as B

22import qualified Data.ByteString as B

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

31import System.Directory (doesFileExist, removeFile)

32import System.Directory (doesFileExist, removeFile)

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

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

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

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

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

35− ioeSetLocation, modifyIOError)

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

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

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

85 where

84 where

86 csize = Just 500

85 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)

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

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

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

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

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

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

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

134-- | Store an item

125-- | Store an item

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

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

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

127+set store identifier value = do

137− encodeFile path value

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

138 cacheInsert store key value

129 cacheInsert store key value

130+ where

139− ) identifier

131+ key = hash identifier

140

132

141

133

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

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

143-- | Load an item

135-- | Load an item

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

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

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

137+get store identifier = do

146 -- First check the in-memory map

138 -- First check the in-memory map

147 ref <- cacheLookup store key

139 ref <- cacheLookup store key

148 case ref of

140 case ref of

@@ -154,14 +146,17 @@ get store = withStore store "get" $ \key path -> do

154 then return NotFound

146 then return NotFound

155 -- Found in the filesystem

147 -- Found in the filesystem

156 else do

148 else do

157− v <- decodeClose path

149+ v <- decodeClose

158 cacheInsert store key v

150 cacheInsert store key v

159 return $ Found v

151 return $ Found v

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

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

161 s -> return s

153 s -> return s

162 where

154 where

155+ key = hash identifier

156+ path = storeDirectory store </> key

157+

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

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

164− decodeClose path = do

159+ decodeClose = do

165 h <- openFile path ReadMode

160 h <- openFile path ReadMode

166 lbs <- BL.hGetContents h

161 lbs <- BL.hGetContents h

167 BL.length lbs `seq` hClose h

162 BL.length lbs `seq` hClose h

@@ -171,23 +166,28 @@ get store = withStore store "get" $ \key path -> do

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

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

172-- | Strict function

167-- | Strict function

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

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

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

169+isMember store identifier = do

175 inCache <- cacheIsMember store key

170 inCache <- cacheIsMember store key

176 if inCache then return True else doesFileExist path

171 if inCache then return True else doesFileExist path

172+ where

173+ key = hash identifier

174+ path = storeDirectory store </> key

177

175

178

176

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

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

180-- | Delete an item

178-- | Delete an item

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

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

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

180+delete store identifier = do

183 cacheDelete store key

181 cacheDelete store key

184− deleteFile path

182+ deleteFile $ storeDirectory store </> key

183+ where

184+ key = hash identifier

185

186

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

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

189deleteFile :: FilePath -> IO ()

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

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

191

192

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

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

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

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE TemplateHaskell #-}

1+{-# LANGUAGE TemplateHaskell #-}

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

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

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

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

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

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

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

41−import Data.FileEmbed (makeRelativeToProject)

40+import Data.FileEmbed (makeRelativeToProject, embedFile)

41+import qualified Data.Text as T

42+import qualified Data.Text.Encoding as T

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

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

45−rssTemplate :: Template

46+rssTemplate :: String

46−rssTemplate =

47+rssTemplate = T.unpack $

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

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

49−rssItemTemplate :: Template

50+rssItemTemplate :: String

50−rssItemTemplate =

51+rssItemTemplate = T.unpack $

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

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

53−atomTemplate :: Template

54+atomTemplate :: String

54−atomTemplate =

55+atomTemplate = T.unpack $

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

56−

57−atomItemTemplate :: Template

58−atomItemTemplate =

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

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

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,13 +77,16 @@ data FeedConfiguration = FeedConfiguration

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

79-- | Abstract function to render any feed.

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

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

81− -> Template -- ^ Default item template

81+ -> String -- ^ 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 feedTpl itemTpl config itemContext items = do

86+renderFeed defFeed defItem config itemContext items = do

87+ feedTpl <- readTemplateFile defFeed

88+ itemTpl <- readTemplateFile defItem

89+

87 protectedItems <- mapM (applyFilter protectCDATA) items

90 protectedItems <- mapM (applyFilter protectCDATA) items

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

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

89 applyTemplate feedTpl feedContext body

92 applyTemplate feedTpl feedContext body

@@ -117,14 +120,18 @@ renderFeed feedTpl itemTpl config itemContext items = do

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

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

118 [] -> return "Unknown"

121 [] -> return "Unknown"

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

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

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

120 StringField s -> return s

124 StringField s -> return s

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

125+

126+ readTemplateFile :: String -> Compiler Template

127+ readTemplateFile value = pure $ template $ readTemplateElems value

128+

122

129

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

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

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

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

125renderRssWithTemplates ::

132renderRssWithTemplates ::

126− Template -- ^ Feed template

133+ String -- ^ Feed template

127− -> Template -- ^ Item template

134+ -> String -- ^ Item template

128 -> FeedConfiguration -- ^ Feed configuration

135 -> FeedConfiguration -- ^ Feed configuration

129 -> Context String -- ^ Item context

136 -> Context String -- ^ Item context

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

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

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

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

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

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

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

139renderAtomWithTemplates ::

146renderAtomWithTemplates ::

140− Template -- ^ Feed template

147+ String -- ^ Feed template

141− -> Template -- ^ Item template

148+ -> String -- ^ Item template

142 -> FeedConfiguration -- ^ Feed configuration

149 -> FeedConfiguration -- ^ Feed configuration

143 -> Context String -- ^ Item context

150 -> Context String -- ^ Item context

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

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

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

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

113

114

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

116−-- | Obtain category from a page.

116+-- | Obtain categories from a page.

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

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

119

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

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

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

139-- >

140--

141−{-# LANGUAGE TemplateHaskell #-}

142module Hakyll.Web.Template

141module Hakyll.Web.Template

143 ( Template

142 ( Template

143+ , template

144+ , readTemplateElems

144 , templateBodyCompiler

145 , templateBodyCompiler

145 , templateCompiler

146 , templateCompiler

146 , applyTemplate

147 , applyTemplate

147 , loadAndApplyTemplate

148 , loadAndApplyTemplate

148 , applyAsTemplate

149 , applyAsTemplate

149 , readTemplate

150 , readTemplate

150− , compileTemplateItem

151 , unsafeReadTemplateFile

152− , embedTemplate

153 ) where

152 ) where

154

153

155

154

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

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

157import Hakyll.Web.Template.Internal

156import 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+31−114

@@ -1,27 +1,6 @@

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−

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

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

22{-# LANGUAGE CPP #-}

2{-# LANGUAGE CPP #-}

23{-# LANGUAGE ExistentialQuantification #-}

3{-# LANGUAGE ExistentialQuantification #-}

24−{-# LANGUAGE RankNTypes #-}

25module Hakyll.Web.Template.Context

4module Hakyll.Web.Template.Context

26 ( ContextField (..)

5 ( ContextField (..)

27 , Context (..)

6 , Context (..)

@@ -49,7 +28,6 @@ module Hakyll.Web.Template.Context

49 , teaserField

28 , teaserField

50 , teaserFieldWithSeparator

29 , teaserFieldWithSeparator

51 , missingField

30 , missingField

52− , bindItem

53 ) where

31 ) where

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

72import Hakyll.Core.Provider

50import Hakyll.Core.Provider

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

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

74import Hakyll.Web.Html

52import Hakyll.Web.Html

75−import Prelude hiding (id)

76−import System.FilePath (dropExtension, splitDirectories,

53+import System.FilePath (splitDirectories, takeBaseName, dropExtension)

77− takeBaseName)

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

56--------------------------------------------------------------------------------

81-- | Mostly for internal usage

57-- | Mostly for internal usage

82data ContextField

58data ContextField

83− = EmptyField

84− | StringField String

59+ = StringField String

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

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

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

106

107

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

83--------------------------------------------------------------------------------

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

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

111#if MIN_VERSION_base(4,9,0)

84#if MIN_VERSION_base(4,9,0)

112instance Semigroup (Context a) where

85instance Semigroup (Context a) where

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

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

@@ -124,105 +97,64 @@ instance Monoid (Context a) where

124

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

98--------------------------------------------------------------------------------

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

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

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

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

128− if k == key

129− then value i

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

131

101

132

102

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

103--------------------------------------------------------------------------------

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

104+-- | Constructs a new field in the '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'.

143field

105field

144 :: String -- ^ Key

106 :: String -- ^ Key

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

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

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

108+ -- on the item

147 -> Context a

109 -> Context a

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

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

149

111

150

112

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

113--------------------------------------------------------------------------------

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

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

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

154boolField

115boolField

155 :: String

116 :: String

156 -> (Item a -> Bool)

117 -> (Item a -> Bool)

157 -> Context a

118 -> Context a

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

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

159− then return EmptyField

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

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

121+ else empty)

161

122

162

123

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

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

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

125+-- | Creates a 'field' that does not depend on the 'Item'

165−-- the same string

166−constField :: String -- ^ Key

126+constField :: String -> String -> Context a

167− -> String -- ^ Value

168− -> Context a

169constField key = field key . const . return

127constField key = field key . const . return

170

128

171

129

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

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

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.

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

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

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

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

178

133

179

134

180--------------------------------------------------------------------------------

135--------------------------------------------------------------------------------

181−-- | Produces a new 'Context' which has list field 'key'. All fields from

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

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

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.

187listFieldWith

136listFieldWith

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

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

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

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

190

139

191

140

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

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

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

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

142+functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a

199− -> Context a

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

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

201 if k == name

144 if k == name

202 then StringField <$> value args i

145 then StringField <$> value args i

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

146+ else empty

204

147

205

148

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

149--------------------------------------------------------------------------------

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−--

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

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

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

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

218 fld <- c k a i

152 fld <- c k a i

219 case fld of

153 case fld of

220− EmptyField -> wrongType "boolField"

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

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

222− _ -> wrongType "ListField"

155+ ListField _ _ -> fail $

223− where

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

156+ "Hakyll.Web.Template.Context.mapContext: " ++

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

157+ "can't map over a ListField!"

226

158

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

159--------------------------------------------------------------------------------

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

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

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

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

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

232-- > ...

164-- > ...

233--

165--

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

166+-- The contents of the included file will not be interpolated.

235−-- does it.

236--

167--

237snippetField :: Context String

168snippetField :: Context String

238snippetField = functionField "snippet" f

169snippetField = functionField "snippet" f

239 where

170 where

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

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

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

172+ f _ i = error $

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

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

174+ show (itemIdentifier i)

243

175

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

176--------------------------------------------------------------------------------

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

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

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

259 metadataField `mappend`

191 metadataField `mappend`

260 urlField "url" `mappend`

192 urlField "url" `mappend`

261 pathField "path" `mappend`

193 pathField "path" `mappend`

262− titleField "title"

194+ titleField "title" `mappend`

195+ missingField

263

196

264

197

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

198--------------------------------------------------------------------------------

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

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

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

278metadataField :: Context a

211metadataField :: Context a

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

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

280− let id = itemIdentifier i

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

282− "of item " ++ show id

283− value <- getMetadataField id k

213+ value <- getMetadataField (itemIdentifier i) k

284− maybe empty' (return . StringField) value

214+ maybe empty (return . StringField) value

285

215

286

216

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

217--------------------------------------------------------------------------------

288-- | Absolute url to the resulting item

218-- | Absolute url to the resulting item

289urlField :: String -> Context a

219urlField :: String -> Context a

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

220+urlField key = field key $

291− let id = itemIdentifier i

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

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

221+ fmap (maybe empty toUrl) . getRoute . itemIdentifier

294

222

295

223

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

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

@@ -344,8 +272,8 @@ titleField = mapContext takeBaseName . pathField

344--

272--

345-- As another alternative, if none of the above matches, and the file has a

273-- As another alternative, if none of the above matches, and the file has a

346-- path which contains nested directories specifying a date, then that date

274-- path which contains nested directories specifying a date, then that date

347−-- will be used. In other words, if the path is of the form

275+-- will be used. In other words, if the path is of the form

348−-- @**//yyyy//mm//dd//**//main.extension@ .

276+-- @**//yyyy//mm//dd//**//main.extension@ .

349-- As above, in case of multiple matches, the rightmost one is used.

277-- As above, in case of multiple matches, the rightmost one is used.

350

278

351dateField :: String -- ^ Key in which the rendered date should be placed

279dateField :: String -- ^ Key in which the rendered date should be placed

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

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

285--------------------------------------------------------------------------------

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

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

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

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

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

288+-- details, see 'dateField'.

361dateFieldWith :: TimeLocale -- ^ Output time locale

289dateFieldWith :: TimeLocale -- ^ Output time locale

362 -> String -- ^ Destination key

290 -> String -- ^ Destination key

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

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

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

412

340

413

341

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

342--------------------------------------------------------------------------------

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

416modificationTimeField :: String -- ^ Key

343modificationTimeField :: String -- ^ Key

417 -> String -- ^ Format

344 -> String -- ^ Format

418 -> Context a -- ^ Resulting context

345 -> Context a -- ^ Resulting context

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

420

347

421

348

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

349--------------------------------------------------------------------------------

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

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

425modificationTimeFieldWith :: TimeLocale -- ^ Time output locale

350modificationTimeFieldWith :: TimeLocale -- ^ Time output locale

426 -> String -- ^ Key

351 -> String -- ^ Key

427 -> String -- ^ Format

352 -> String -- ^ Format

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

460

385

461

386

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

387--------------------------------------------------------------------------------

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.

465missingField :: Context a

388missingField :: Context a

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

389+missingField = Context $ \k _ i -> fail $

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

390+ "Missing field $" ++ k ++ "$ in context for item " ++

391+ show (itemIdentifier i)

468

392

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

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

470#if MIN_VERSION_time(1,5,0)

394#if MIN_VERSION_time(1,5,0)

@@ -472,10 +396,3 @@ parseTimeM = TF.parseTimeM

472#else

396#else

473parseTimeM _ = TF.parseTime

397parseTimeM _ = TF.parseTime

474#endif

398#endif

475−

476−--------------------------------------------------------------------------------

477−

478−-- | Binds an 'Item' to a given 'Context', allowing it to be combined with any

479−-- other 'Context' of any type.

480−bindItem :: Context a -> Item a -> forall b. Context b

481−bindItem (Context ctx) ia = Context $ \k args _ -> ctx k args ia

lib/Hakyll/Web/Template/Internal.hs+44−103

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

1−{-# LANGUAGE DeriveAnyClass #-}

2−{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

1{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4{-# LANGUAGE ScopedTypeVariables #-}

2{-# LANGUAGE ScopedTypeVariables #-}

5−

6module Hakyll.Web.Template.Internal

3module Hakyll.Web.Template.Internal

7 ( Template (..)

4 ( Template (..)

8 , template

5 , template

9 , templateBodyCompiler

6 , templateBodyCompiler

10 , templateCompiler

7 , templateCompiler

11 , applyTemplate

8 , applyTemplate

9+ , applyTemplate'

12 , loadAndApplyTemplate

10 , loadAndApplyTemplate

13 , applyAsTemplate

11 , applyAsTemplate

14 , readTemplate

12 , readTemplate

15− , compileTemplateItem

16 , unsafeReadTemplateFile

13 , unsafeReadTemplateFile

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

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

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

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

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

24−import Control.Monad (forM)

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

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

26import Data.Binary (Binary)

22import Data.Binary (Binary)

27import Data.List (intercalate)

23import Data.List (intercalate)

28−import qualified Data.List.NonEmpty as NonEmpty

29import Data.Typeable (Typeable)

24import Data.Typeable (Typeable)

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

25import GHC.Exts (IsString (..))

31−import GHC.Generics (Generic)

26+import Prelude hiding (id)

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

29--------------------------------------------------------------------------------

35import Hakyll.Core.Compiler

30import Hakyll.Core.Compiler

36−import Hakyll.Core.Compiler.Internal

37import Hakyll.Core.Identifier

31import Hakyll.Core.Identifier

38import Hakyll.Core.Item

32import Hakyll.Core.Item

39import Hakyll.Core.Writable

33import Hakyll.Core.Writable

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

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

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

46-- | Datatype used for template substitutions.

40-- | Datatype used for template substitutions.

47−data Template = Template

41+newtype Template = Template

48− { tplElements :: [TemplateElement]

42+ { unTemplate :: [TemplateElement]

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

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

43+ } deriving (Show, Eq, Binary, Typeable)

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

46--------------------------------------------------------------------------------

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

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

57--------------------------------------------------------------------------------

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

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

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

59+template :: [TemplateElement] -> Template

67−template p = flip Template p . trim

60+template = Template . trim

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

63--------------------------------------------------------------------------------

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

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

73readTemplate :: String -> Template

64readTemplate :: String -> Template

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

65+readTemplate = Template . trim . readTemplateElems

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

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

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

94-- | Read a template, without metadata header

68-- | Read a template, without metadata header

95templateBodyCompiler :: Compiler (Item Template)

69templateBodyCompiler :: Compiler (Item Template)

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

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

97 item <- getResourceBody

71 item <- getResourceBody

98− file <- getUnderlying

72+ file <- getResourceFilePath

99− withItemBody (compileTemplateFile file) item

73+ return $ fmap (template . readTemplateElemsFile file) item

100

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

75--------------------------------------------------------------------------------

102-- | Read complete file contents as a template

76-- | Read complete file contents as a template

103templateCompiler :: Compiler (Item Template)

77templateCompiler :: Compiler (Item Template)

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

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

105 item <- getResourceString

79 item <- getResourceString

106− file <- getUnderlying

80+ file <- getResourceFilePath

107− withItemBody (compileTemplateFile file) item

81+ return $ fmap (template . readTemplateElemsFile file) item

108

109

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

84--------------------------------------------------------------------------------

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

112applyTemplate :: Template -- ^ Template

85applyTemplate :: Template -- ^ Template

113 -> Context a -- ^ Context

86 -> Context a -- ^ Context

114 -> Item a -- ^ Page

87 -> Item a -- ^ Page

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

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

116applyTemplate tpl context item = do

89applyTemplate tpl context item = do

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

90+ body <- applyTemplate' (unTemplate tpl) context item

118 return $ itemSetBody body item

91 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

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

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

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

141

105

142 go = fmap concat . mapM applyElem

106 go = fmap concat . mapM applyElem

143

107

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

109+ "fully trimmed."

110+

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

111 ---------------------------------------------------------------------------

145

112

146 applyElem :: TemplateElement -> Compiler String

113 applyElem :: TemplateElement -> Compiler String

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

151

118

152 applyElem (Chunk c) = return c

119 applyElem (Chunk c) = return c

153

120

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

121+ applyElem (Expr e) = applyExpr e >>= getString e

155− where

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

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

158

122

159 applyElem Escaped = return "$"

123 applyElem Escaped = return "$"

160

124

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

125+ applyElem (If e t mf) = (applyExpr e >> go t) `catchError` handler

162 where

126 where

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

127+ handler _ = case mf of

164− handle (Right _) = go t

128+ Nothing -> return ""

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

129+ Just f -> go f

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

130+

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

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

169−

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

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

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

132+ StringField _ -> fail $

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

133+ "Hakyll.Web.Template.applyTemplateWith: expected ListField but " ++

134+ "got StringField for expr " ++ show e

173− ListField c xs -> withErrorMessage bodyMsg $ do

135+ ListField c xs -> do

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

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

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

137+ bs <- mapM (applyTemplate' b c) xs

176 return $ intercalate sep bs

138 return $ intercalate sep bs

177− where

139+

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

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

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

181−

182− applyElem (Partial e) = withErrorMessage headMsg $

140+ applyElem (Partial e) = do

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

141+ p <- applyExpr e >>= getString e

184− withErrorMessage inclMsg $ do

185− tpl' <- loadBody (fromFilePath p)

142+ Template tpl' <- loadBody (fromFilePath p)

186− itemBody <$> applyTemplate tpl' context x

143+ 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 ++ ")$'"

191

144

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

145 ---------------------------------------------------------------------------

193

146

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

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

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

197

150

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

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

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

152+ args' <- mapM (\e -> applyExpr e >>= getString e) args

200 context' k args' x

153 context' k args' x

201− where

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

203

154

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

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

205

156

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

157 ----------------------------------------------------------------------------

207

158

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

209− applyStringExpr msg expr =

210− applyExpr expr >>= getString

211− where

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

213− getString (StringField s) = return s

159+ getString _ (StringField s) = return s

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

160+ getString e (ListField _ _) = fail $

215−

161+ "Hakyll.Web.Template.applyTemplateWith: expected StringField but " ++

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

162+ "got ListField for expr " ++ show e

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."

222

163

223

164

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

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

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

248applyAsTemplate :: Context String -- ^ Context

189applyAsTemplate :: Context String -- ^ Context

249 -> Item String -- ^ Item and template

190 -> Item String -- ^ Item and template

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

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

251−applyAsTemplate context item = do

192+applyAsTemplate context item =

252− tpl <- compileTemplateItem item

193+ let tpl = template $ readTemplateElemsFile file (itemBody item)

194+ file = toFilePath $ itemIdentifier item

253− applyTemplate tpl context item

195+ in applyTemplate tpl context item

254

196

255

197

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

198--------------------------------------------------------------------------------

257unsafeReadTemplateFile :: FilePath -> Compiler Template

199unsafeReadTemplateFile :: FilePath -> Compiler Template

258unsafeReadTemplateFile file = do

200unsafeReadTemplateFile file = do

259 tpl <- unsafeCompiler $ readFile file

201 tpl <- unsafeCompiler $ readFile file

260− compileTemplateFile (fromFilePath file) tpl

202+ pure $ template $ readTemplateElemsFile file tpl

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

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

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

7 , TemplateExpr (..)

8 , TemplateElement (..)

9 , templateElems

10− , parseTemplateElemsFile

10+ , readTemplateElems

11+ , readTemplateElemsFile

11 ) where

12 ) where

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

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

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

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

16import Control.Monad (void)

17import 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,10 +107,17 @@ 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+

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

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

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

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

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

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

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

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

120+ Right t -> t

114

121

115

122

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

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

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

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

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

161trimClose :: P.Parser Bool

168trimClose :: P.Parser Bool

162trimClose = do

169trimClose = do

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

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

164 void $ P.char '$'

171 void $ P.char '$'

165 pure $ isJust trimIfR

172 pure $ isJust trimIfR

166

173

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

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

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

9+import Data.List (isInfixOf)

9−import Test.Tasty (TestTree, testGroup)

10+import Test.Tasty (TestTree, testGroup)

10−import Test.Tasty.HUnit (testCase)

11+import Test.Tasty.HUnit (testCase)

11−import qualified Test.Tasty.HUnit as H

12+import qualified Test.Tasty.HUnit as H

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

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

15import Hakyll.Core.Compiler

16import Hakyll.Core.Compiler

16−import Hakyll.Core.Identifier

17+import Hakyll.Core.Compiler.Internal

17import Hakyll.Core.Item

18import Hakyll.Core.Item

18import Hakyll.Core.UnixFilter

19import Hakyll.Core.UnixFilter

20+import Hakyll.Core.Identifier

19import TestSuite.Util

21import TestSuite.Util

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

49unixFilterFalse = do

51unixFilterFalse = do

50 store <- newTestStore

52 store <- newTestStore

51 provider <- newTestProvider store

53 provider <- newTestProvider store

52− testCompilerError store provider testMarkdown compiler "exit code"

54+ result <- testCompiler store provider testMarkdown compiler

55+ case result of

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

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

53 cleanTestEnv

58 cleanTestEnv

54 where

59 where

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

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

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

60unixFilterError = do

65unixFilterError = do

61 store <- newTestStore

66 store <- newTestStore

62 provider <- newTestProvider store

67 provider <- newTestProvider store

63− testCompilerError store provider testMarkdown compiler "option"

68+ result <- testCompiler store provider testMarkdown compiler

69+ case result of

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

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

64 cleanTestEnv

72 cleanTestEnv

65 where

73 where

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

74 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−30

@@ -13,11 +13,9 @@ import Test.Tasty.HUnit (Assertion, testCase, (@=?))

13--------------------------------------------------------------------------------

14import Hakyll.Core.Compiler

15import Hakyll.Core.Identifier

16−import Hakyll.Core.Item

17import Hakyll.Core.Provider

16import Hakyll.Core.Provider

18import Hakyll.Core.Store (Store)

17import Hakyll.Core.Store (Store)

19import Hakyll.Web.Template.Context

18import Hakyll.Web.Template.Context

20−import Hakyll.Web.Template.Internal

21import TestSuite.Util

19import TestSuite.Util

@@ -25,7 +23,6 @@ import TestSuite.Util

25tests :: TestTree

23tests :: TestTree

26tests = testGroup "Hakyll.Web.Template.Context.Tests"

24tests = testGroup "Hakyll.Web.Template.Context.Tests"

27 [ testCase "testDateField" testDateField

25 [ testCase "testDateField" testDateField

28− , testCase "testOuerLoopContextAccess" testOuerLoopContextAccess

29 ]

26 ]

@@ -65,31 +62,6 @@ testContextDone store provider identifier key context =

65 cf <- unContext context key [] item

62 cf <- unContext context key [] item

66 case cf of

63 case cf of

67 StringField str -> return str

64 StringField str -> return str

68− _ -> error $

65+ ListField _ _ -> error $

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

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

70− "expected StringField"

67+ "Didn't expect ListField"

71−

72−--------------------------------------------------------------------------------

73−

74−testOuerLoopContextAccess :: Assertion

75−testOuerLoopContextAccess = do

76− store <- newTestStore

77− provider <- newTestProvider store

78− test store provider ctx "baz"

79− test store provider (ctx' <> ctx) "not baz"

80− test store provider (ctx <> ctx') "baz"

81−

82− cleanTestEnv

83− where

84− tpl = readTemplate "$for(foo)$$for(bar)$$qux$$endfor$$endfor$"

85− ctx = mconcat [

86− field "qux" $ const $ return "baz"

87− , listField "foo" (listField "bar" mempty $ return [mockItem])

88− $ return [mockItem]

89− ]

90− ctx' = field "qux" $ const $ return "not baz"

91− mockItem = Item "" ()

92− test store provider context str = do

93− str' <- testCompilerDone store provider ""

94− $ applyTemplate tpl context mockItem

95− str @=? itemBody str'

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

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

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

2{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE TemplateHaskell #-}

4module Hakyll.Web.Template.Tests

3module Hakyll.Web.Template.Tests

5 ( tests

4 ( tests

6 ) where

5 ) where

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

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

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

10import Test.Tasty (TestTree, testGroup)

9import Test.Tasty (TestTree, testGroup)

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

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

12− (@=?), (@?=))

11+ (@?=))

14−import Data.Either (isLeft)

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

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

17import Hakyll.Core.Compiler

15import Hakyll.Core.Compiler

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

34 , testCase "applyJoinTemplateList" testApplyJoinTemplateList

32 , testCase "applyJoinTemplateList" testApplyJoinTemplateList

35 ]

33 ]

37− , fromAssertions "parseTemplate"

35+ , fromAssertions "readTemplate"

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

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

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

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

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

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

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

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

42 -- 'If' trim check.

40 -- 'If' trim check.

43− , Right [ TrimL

41+ , [ TrimL

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

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

45 [ TrimR

43 [ TrimR

46 , Chunk "\n"

44 , Chunk "\n"

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

56 ])

54 ])

57 , TrimR

55 , TrimR

58 ]

56 ]

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

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

60 -- 'For' trim check.

58 -- 'For' trim check.

61− , Right [ TrimL

59+ , [ TrimL

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

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

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

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

64 Nothing

62 Nothing

65 , TrimR

63 , TrimR

66 ]

64 ]

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

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

68 -- 'Partial' trim check.

66 -- 'Partial' trim check.

69− , Right [ TrimL

67+ , [ TrimL

70 , Partial (StringLiteral "path")

68 , Partial (StringLiteral "path")

71 , TrimR

69 , TrimR

72 ]

70 ]

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

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

74 -- 'Expr' trim check.

72 -- 'Expr' trim check.

75− , Right [ TrimL

73+ , [ TrimL

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

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

77 , TrimR

75 , TrimR

78 ]

76 ]

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

77+ @=? readTemplateElems "$-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$"

86 ]

78 ]

87−

88− , [testCase "embeddedTemplate" testEmbeddedTemplate]

89 ]

79 ]

90− where

91− parse = parseTemplateElemsFile ""

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

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

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

125testApplyJoinTemplateList = do

113testApplyJoinTemplateList = do

126 store <- newTestStore

114 store <- newTestStore

127 provider <- newTestProvider store

115 provider <- newTestProvider store

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

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

130 str <- testCompilerDone store provider "item3" $

116 str <- testCompilerDone store provider "item3" $

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

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

132

118

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

135 where

121 where

136 i1 = Item "item1" "Hello"

122 i1 = Item "item1" "Hello"

137 i2 = Item "item2" "World"

123 i2 = Item "item2" "World"

138−

124+ tpl = readTemplate "$body$"

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,7 +28,6 @@ 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

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

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

@@ -50,7 +49,6 @@ main = defaultMain $ testGroup "Hakyll"

50#ifdef USE_PANDOC

49#ifdef USE_PANDOC

51 , Hakyll.Web.Pandoc.FileType.Tests.tests

50 , Hakyll.Web.Pandoc.FileType.Tests.tests

52#endif

51#endif

53− , Hakyll.Web.Tags.Tests.tests

54 , Hakyll.Web.Template.Context.Tests.tests

52 , Hakyll.Web.Template.Context.Tests.tests

55 , Hakyll.Web.Template.Tests.tests

53 , Hakyll.Web.Template.Tests.tests

56 ]

54 ]

tests/TestSuite/Util.hs+2−11

@@ -6,7 +6,6 @@ module TestSuite.Util

6 , newTestProvider

7 , testCompiler

8 , testCompilerDone

9− , testCompilerError

10 , testConfiguration

9 , testConfiguration

11 , cleanTestEnv

10 , cleanTestEnv

12 , renderParagraphs

11 , renderParagraphs

@@ -14,7 +13,7 @@ module TestSuite.Util

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

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

17−import Data.List (intercalate, isInfixOf)

16+import Data.List (intercalate)

18import Data.Monoid (mempty)

17import Data.Monoid (mempty)

19import qualified Data.Set as S

18import qualified Data.Set as S

20import Test.Tasty

19import Test.Tasty

@@ -81,21 +80,13 @@ testCompilerDone store provider underlying compiler = do

81 CompilerDone x _ -> return x

80 CompilerDone x _ -> return x

82 CompilerError e -> fail $

81 CompilerError e -> fail $

83 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++

82 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++

84− " threw: " ++ intercalate "; " (compilerErrorMessages e)

83+ " threw: " ++ intercalate "; " e

85 CompilerRequire i _ -> fail $

84 CompilerRequire i _ -> fail $

86 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++

85 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++

87 " requires: " ++ show i

86 " requires: " ++ show i

88 CompilerSnapshot _ _ -> fail

87 CompilerSnapshot _ _ -> fail

89 "TestSuite.Util.testCompilerDone: unexpected CompilerSnapshot"

88 "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"

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

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

101testConfiguration :: Configuration

92testConfiguration :: Configuration

tests/data/embed.htmldeleted−1

@@ -1 +0,0 @@

1−$body$