9e41414 · hakyll · git.iko.soy

git.iko.soy/hakyll

Merge pull request #454 from samgd/whitespace-control

Whitespace trimming

commit9e41414880718d5f18e4ae771ef21fc9447d1b60 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateSun 31 Jul 2016, 15:39 (10 years ago) parent68e9c77 a31a565

9 files changed+431−114

compare with master

unifiedsplit

hakyll.cabal+1 src/Hakyll/Core/Util/Parser.hs+9−2 src/Hakyll/Web/Feed.hs+4−10 src/Hakyll/Web/Template.hs+84−12 src/Hakyll/Web/Template/Internal.hs+135−73 src/Hakyll/Web/Template/Trim.hs+95 tests/Hakyll/Web/Template/Tests.hs+51−17 tests/data/strip.html+34 tests/data/strip.html.out+18

hakyll.cabal+1

@@ -117,6 +117,7 @@ Library

117117 Hakyll.Web.Paginate

118118 Hakyll.Web.Template

119119 Hakyll.Web.Template.Internal

120+ Hakyll.Web.Template.Trim

120121 Hakyll.Web.Template.Context

121122 Hakyll.Web.Template.List

122123

src/Hakyll/Core/Util/Parser.hs+9−2

@@ -8,7 +8,7 @@ module Hakyll.Core.Util.Parser

99--------------------------------------------------------------------------------

1010import Control.Applicative ((<|>))

11−import Control.Monad (mzero)

11+import Control.Monad (guard, mzero, void)

1212import qualified Text.Parsec as P

1313import Text.Parsec.String (Parser)

1414

@@ -16,7 +16,14 @@ import Text.Parsec.String (Parser)

1616--------------------------------------------------------------------------------

1717metadataKey :: Parser String

1818metadataKey = do

19− i <- (:) <$> P.letter <*> (P.many $ P.alphaNum <|> P.oneOf "_-.")

19+ -- Ensure trailing '-' binds to '$' if present.

20+ let hyphon = P.try $ do

21+ void $ P.char '-'

22+ x <- P.lookAhead P.anyChar

23+ guard $ x /= '$'

24+ pure '-'

25+

26+ i <- (:) <$> P.letter <*> P.many (P.alphaNum <|> P.oneOf "_." <|> hyphon)

2027 if i `elem` reservedKeys then mzero else return i

2128

2229

src/Hakyll/Web/Feed.hs+4−10

@@ -23,17 +23,12 @@ module Hakyll.Web.Feed

2323 ) where

2424

2525

26−--------------------------------------------------------------------------------

27−import Control.Monad ((<=<))

28−

29−

3026--------------------------------------------------------------------------------

3127import Hakyll.Core.Compiler

3228import Hakyll.Core.Compiler.Internal

3329import Hakyll.Core.Item

3430import Hakyll.Web.Template

3531import Hakyll.Web.Template.Context

36−import Hakyll.Web.Template.Internal

3732import Hakyll.Web.Template.List

3833

3934

@@ -66,17 +61,16 @@ renderFeed :: FilePath -- ^ Feed template

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

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

6863renderFeed feedPath itemPath config itemContext items = do

69− feedTpl <- compilerUnsafeIO $ loadTemplate feedPath

70− itemTpl <- compilerUnsafeIO $ loadTemplate itemPath

64+ feedTpl <- loadTemplate feedPath

65+ itemTpl <- loadTemplate itemPath

7166

7267 body <- makeItem =<< applyTemplateList itemTpl itemContext' items

7368 applyTemplate feedTpl feedContext body

7469 where

7570 -- Auxiliary: load a template from a datafile

7671 loadTemplate path = do

77− file <- getDataFileName path

78− templ <- readFile file

79− return $ readTemplateFile file templ

72+ file <- compilerUnsafeIO $ getDataFileName path

73+ unsafeReadTemplateFile file

8074

8175 itemContext' = mconcat

8276 [ itemContext

src/Hakyll/Web/Template.hs+84−12

@@ -115,7 +115,31 @@

115115-- That is, calling @$partial$@ is equivalent to just copying and pasting

116116-- template code.

117117--

118−{-# LANGUAGE ScopedTypeVariables #-}

118+-- In the examples above you can see that the outputs contain a lot of leftover

119+-- whitespace that you may wish to remove. Using @'$-'@ or @'-$'@ instead of

120+-- @'$'@ in a macro strips all whitespace to the left or right of that clause

121+-- respectively. Given the context

122+--

123+-- > listField "counts" (field "count" (return . itemBody))

124+-- > (sequence [makeItem "3", makeItem "2", makeItem "1"])

125+--

126+-- and a template

127+--

128+-- > <p>

129+-- > $for(counts)-$

130+-- > $count$

131+-- > $-sep$...

132+-- > $-endfor$

133+-- > </p>

134+--

135+-- the resulting page would look like

136+--

137+-- > <p>

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

139+-- > </p>

140+--

141+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

142+{-# LANGUAGE ScopedTypeVariables #-}

119143module Hakyll.Web.Template

120144 ( Template

121145 , templateBodyCompiler

@@ -124,13 +148,16 @@ module Hakyll.Web.Template

124148 , loadAndApplyTemplate

125149 , applyAsTemplate

126150 , readTemplate

151+ , unsafeReadTemplateFile

127152 ) where

128153

129154

130155--------------------------------------------------------------------------------

131−import Control.Monad (liftM)

132156import Control.Monad.Except (MonadError (..))

157+import Data.Binary (Binary)

133158import Data.List (intercalate)

159+import Data.Typeable (Typeable)

160+import GHC.Exts (IsString (..))

134161import Prelude hiding (id)

135162

136163

@@ -138,17 +165,47 @@ import Prelude hiding (id)

138165import Hakyll.Core.Compiler

139166import Hakyll.Core.Identifier

140167import Hakyll.Core.Item

168+import Hakyll.Core.Writable

141169import Hakyll.Web.Template.Context

142170import Hakyll.Web.Template.Internal

171+import Hakyll.Web.Template.Trim

172+

173+

174+--------------------------------------------------------------------------------

175+-- | Datatype used for template substitutions.

176+newtype Template = Template

177+ { unTemplate :: [TemplateElement]

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

143179

144180

181+--------------------------------------------------------------------------------

182+instance Writable Template where

183+ -- Writing a template is impossible

184+ write _ _ = return ()

185+

186+

187+--------------------------------------------------------------------------------

188+instance IsString Template where

189+ fromString = readTemplate

190+

191+

192+--------------------------------------------------------------------------------

193+-- | Wrap the constructor to ensure trim is called.

194+template :: [TemplateElement] -> Template

195+template = Template . trim

196+

197+

198+--------------------------------------------------------------------------------

199+readTemplate :: String -> Template

200+readTemplate = Template . trim . readTemplateElems

201+

145202--------------------------------------------------------------------------------

146203-- | Read a template, without metadata header

147204templateBodyCompiler :: Compiler (Item Template)

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

149206 item <- getResourceBody

150207 file <- getResourceFilePath

151− return $ fmap (readTemplateFile file) item

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

152209

153210--------------------------------------------------------------------------------

154211-- | Read complete file contents as a template

@@ -156,7 +213,7 @@ templateCompiler :: Compiler (Item Template)

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

157214 item <- getResourceString

158215 file <- getResourceFilePath

159− return $ fmap (readTemplateFile file) item

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

160217

161218

162219--------------------------------------------------------------------------------

@@ -165,28 +222,35 @@ applyTemplate :: Template -- ^ Template

165222 -> Item a -- ^ Page

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

167224applyTemplate tpl context item = do

168− body <- applyTemplate' tpl context item

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

169226 return $ itemSetBody body item

170227

171228

172229--------------------------------------------------------------------------------

173230applyTemplate'

174231 :: forall a.

175− Template -- ^ Template

176− -> Context a -- ^ Context

177− -> Item a -- ^ Page

178− -> Compiler String -- ^ Resulting item

179−applyTemplate' tpl context x = go tpl

232+ [TemplateElement] -- ^ Unwrapped Template

233+ -> Context a -- ^ Context

234+ -> Item a -- ^ Page

235+ -> Compiler String -- ^ Resulting item

236+applyTemplate' tes context x = go tes

180237 where

181238 context' :: String -> [String] -> Item a -> Compiler ContextField

182239 context' = unContext (context `mappend` missingField)

183240

184− go = liftM concat . mapM applyElem . unTemplate

241+ go = fmap concat . mapM applyElem

242+

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

244+ "fully trimmed."

185245

186246 ---------------------------------------------------------------------------

187247

188248 applyElem :: TemplateElement -> Compiler String

189249

250+ applyElem TrimL = trimError

251+

252+ applyElem TrimR = trimError

253+

190254 applyElem (Chunk c) = return c

191255

192256 applyElem (Expr e) = applyExpr e >>= getString e

@@ -261,6 +325,14 @@ applyAsTemplate :: Context String -- ^ Context

261325 -> Item String -- ^ Item and template

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

263327applyAsTemplate context item =

264− let tpl = readTemplateFile file (itemBody item)

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

265329 file = toFilePath $ itemIdentifier item

266330 in applyTemplate tpl context item

331+

332+

333+--------------------------------------------------------------------------------

334+unsafeReadTemplateFile :: FilePath -> Compiler Template

335+unsafeReadTemplateFile file = do

336+ tpl <- unsafeCompiler $ readFile file

337+ pure $ template $ readTemplateElemsFile file tpl

338+

src/Hakyll/Web/Template/Internal.hs+135−73

@@ -1,14 +1,13 @@

11--------------------------------------------------------------------------------

22-- | Module containing the template data structure

3−{-# LANGUAGE DeriveDataTypeable #-}

43{-# LANGUAGE GeneralizedNewtypeDeriving #-}

54module Hakyll.Web.Template.Internal

6− ( Template (..)

7− , TemplateKey (..)

5+ ( TemplateKey (..)

86 , TemplateExpr (..)

97 , TemplateElement (..)

10− , readTemplate

11− , readTemplateFile

8+ , templateElems

9+ , readTemplateElems

10+ , readTemplateElemsFile

1211 ) where

1312

1413

@@ -16,8 +15,9 @@ module Hakyll.Web.Template.Internal

1615import Control.Applicative ((<|>))

1716import Control.Monad (void)

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

18+import Data.List (intercalate)

19+import Data.Maybe (isJust)

1920import Data.Typeable (Typeable)

20−import Data.List (intercalate)

2121import GHC.Exts (IsString (..))

2222import qualified Text.Parsec as P

2323import qualified Text.Parsec.String as P

@@ -25,25 +25,6 @@ import qualified Text.Parsec.String as P

2525

2626--------------------------------------------------------------------------------

2727import Hakyll.Core.Util.Parser

28−import Hakyll.Core.Writable

29−

30−

31−--------------------------------------------------------------------------------

32−-- | Datatype used for template substitutions.

33−newtype Template = Template

34− { unTemplate :: [TemplateElement]

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

36−

37−

38−--------------------------------------------------------------------------------

39−instance Writable Template where

40− -- Writing a template is impossible

41− write _ _ = return ()

42−

43−

44−--------------------------------------------------------------------------------

45−instance IsString Template where

46− fromString = readTemplate

4728

4829

4930--------------------------------------------------------------------------------

@@ -62,9 +43,14 @@ data TemplateElement

6243 = Chunk String

6344 | Expr TemplateExpr

6445 | Escaped

65− | If TemplateExpr Template (Maybe Template) -- expr, then, else

66− | For TemplateExpr Template (Maybe Template) -- expr, body, separator

67− | Partial TemplateExpr -- filename

46+ -- expr, then, else

47+ | If TemplateExpr [TemplateElement] (Maybe [TemplateElement])

48+ -- expr, body, separator

49+ | For TemplateExpr [TemplateElement] (Maybe [TemplateElement])

50+ -- filename

51+ | Partial TemplateExpr

52+ | TrimL

53+ | TrimR

6854 deriving (Show, Eq, Typeable)

6955

7056

@@ -72,10 +58,12 @@ data TemplateElement

7258instance Binary TemplateElement where

7359 put (Chunk string) = putWord8 0 >> put string

7460 put (Expr e) = putWord8 1 >> put e

75− put (Escaped) = putWord8 2

76− put (If e t f ) = putWord8 3 >> put e >> put t >> put f

61+ put Escaped = putWord8 2

62+ put (If e t f) = putWord8 3 >> put e >> put t >> put f

7763 put (For e b s) = putWord8 4 >> put e >> put b >> put s

7864 put (Partial e) = putWord8 5 >> put e

65+ put TrimL = putWord8 6

66+ put TrimR = putWord8 7

7967

8068 get = getWord8 >>= \tag -> case tag of

8169 0 -> Chunk <$> get

@@ -84,8 +72,9 @@ instance Binary TemplateElement where

8472 3 -> If <$> get <*> get <*> get

8573 4 -> For <$> get <*> get <*> get

8674 5 -> Partial <$> get

87− _ -> error $

88− "Hakyll.Web.Template.Internal: Error reading cached template"

75+ 6 -> pure TrimL

76+ 7 -> pure TrimR

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

8978

9079

9180--------------------------------------------------------------------------------

@@ -115,48 +104,45 @@ instance Binary TemplateExpr where

115104 0 -> Ident <$> get

116105 1 -> Call <$> get <*> get

117106 2 -> StringLiteral <$> get

118− _ -> error $

119− "Hakyll.Web.Tamplte.Internal: Error reading cached template"

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

120108

121109

122110--------------------------------------------------------------------------------

123−readTemplate :: String -> Template

124−readTemplate = readTemplateFile "{literal}"

111+readTemplateElems :: String -> [TemplateElement]

112+readTemplateElems = readTemplateElemsFile "{literal}"

125113

126114

127115--------------------------------------------------------------------------------

128−readTemplateFile :: FilePath -> String -> Template

129−readTemplateFile file input = case P.parse topLevelTemplate file input of

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

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

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

131119 Right t -> t

132120

133121

134122--------------------------------------------------------------------------------

135−topLevelTemplate :: P.Parser Template

136−topLevelTemplate = Template <$>

137− P.manyTill templateElement P.eof

138−

139−--------------------------------------------------------------------------------

140−template :: P.Parser Template

141−template = Template <$> P.many templateElement

142−

143−--------------------------------------------------------------------------------

144−templateElement :: P.Parser TemplateElement

123+templateElems :: P.Parser [TemplateElement]

124+templateElems = mconcat <$> P.many (P.choice [ lift chunk

125+ , lift escaped

126+ , conditional

127+ , for

128+ , partial

129+ , expr

130+ ])

131+ where lift = fmap (:[])

146132

147133

148134--------------------------------------------------------------------------------

149135chunk :: P.Parser TemplateElement

150−chunk = Chunk <$> (P.many1 $ P.noneOf "$")

136+chunk = Chunk <$> P.many1 (P.noneOf "$")

151137

152138

153139--------------------------------------------------------------------------------

154−expr :: P.Parser TemplateElement

140+expr :: P.Parser [TemplateElement]

155141expr = P.try $ do

156− void $ P.char '$'

142+ trimLExpr <- trimOpen

157143 e <- expr'

158− void $ P.char '$'

159− return $ Expr e

144+ trimRExpr <- trimClose

145+ return $ [TrimL | trimLExpr] ++ [Expr e] ++ [TrimR | trimRExpr]

160146

161147

162148--------------------------------------------------------------------------------

@@ -166,40 +152,105 @@ expr' = stringLiteral <|> call <|> ident

166152

167153--------------------------------------------------------------------------------

168154escaped :: P.Parser TemplateElement

169−escaped = Escaped <$ (P.try $ P.string "$$")

155+escaped = Escaped <$ P.try (P.string "$$")

170156

171157

172158--------------------------------------------------------------------------------

173−conditional :: P.Parser TemplateElement

159+trimOpen :: P.Parser Bool

160+trimOpen = do

161+ void $ P.char '$'

162+ trimLIf <- P.optionMaybe $ P.try (P.char '-')

163+ pure $ isJust trimLIf

164+

165+

166+--------------------------------------------------------------------------------

167+trimClose :: P.Parser Bool

168+trimClose = do

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

170+ void $ P.char '$'

171+ pure $ isJust trimIfR

172+

173+

174+--------------------------------------------------------------------------------

175+conditional :: P.Parser [TemplateElement]

174176conditional = P.try $ do

175− void $ P.string "$if("

177+ -- if

178+ trimLIf <- trimOpen

179+ void $ P.string "if("

176180 e <- expr'

177− void $ P.string ")$"

178− thenBranch <- template

179− elseBranch <- P.optionMaybe $ P.try (P.string "$else$") >> template

180− void $ P.string "$endif$"

181− return $ If e thenBranch elseBranch

181+ void $ P.char ')'

182+ trimRIf <- trimClose

183+ -- then

184+ thenBranch <- templateElems

185+ -- else

186+ elseParse <- opt "else"

187+ -- endif

188+ trimLEnd <- trimOpen

189+ void $ P.string "endif"

190+ trimREnd <- trimClose

191+

192+ -- As else is optional we need to sort out where any Trim_s need to go.

193+ let (thenBody, elseBody) = maybe (thenNoElse, Nothing) thenElse elseParse

194+ where thenNoElse =

195+ [TrimR | trimRIf] ++ thenBranch ++ [TrimL | trimLEnd]

196+

197+ thenElse (trimLElse, elseBranch, trimRElse) = (thenB, elseB)

198+ where thenB = [TrimR | trimRIf]

199+ ++ thenBranch

200+ ++ [TrimL | trimLElse]

201+

202+ elseB = Just $ [TrimR | trimRElse]

203+ ++ elseBranch

204+ ++ [TrimL | trimLEnd]

205+

206+ pure $ [TrimL | trimLIf] ++ [If e thenBody elseBody] ++ [TrimR | trimREnd]

182207

183208

184209--------------------------------------------------------------------------------

185−for :: P.Parser TemplateElement

210+for :: P.Parser [TemplateElement]

186211for = P.try $ do

187− void $ P.string "$for("

212+ -- for

213+ trimLFor <- trimOpen

214+ void $ P.string "for("

188215 e <- expr'

189− void $ P.string ")$"

190− body <- template

191− sep <- P.optionMaybe $ P.try (P.string "$sep$") >> template

192− void $ P.string "$endfor$"

193− return $ For e body sep

216+ void $ P.char ')'

217+ trimRFor <- trimClose

218+ -- body

219+ bodyBranch <- templateElems

220+ -- sep

221+ sepParse <- opt "sep"

222+ -- endfor

223+ trimLEnd <- trimOpen

224+ void $ P.string "endfor"

225+ trimREnd <- trimClose

226+

227+ -- As sep is optional we need to sort out where any Trim_s need to go.

228+ let (forBody, sepBody) = maybe (forNoSep, Nothing) forSep sepParse

229+ where forNoSep =

230+ [TrimR | trimRFor] ++ bodyBranch ++ [TrimL | trimLEnd]

231+

232+ forSep (trimLSep, sepBranch, trimRSep) = (forB, sepB)

233+ where forB = [TrimR | trimRFor]

234+ ++ bodyBranch

235+ ++ [TrimL | trimLSep]

236+

237+ sepB = Just $ [TrimR | trimRSep]

238+ ++ sepBranch

239+ ++ [TrimL | trimLEnd]

240+

241+ pure $ [TrimL | trimLFor] ++ [For e forBody sepBody] ++ [TrimR | trimREnd]

194242

195243

196244--------------------------------------------------------------------------------

197−partial :: P.Parser TemplateElement

245+partial :: P.Parser [TemplateElement]

198246partial = P.try $ do

199− void $ P.string "$partial("

247+ trimLPart <- trimOpen

248+ void $ P.string "partial("

200249 e <- expr'

201− void $ P.string ")$"

202− return $ Partial e

250+ void $ P.char ')'

251+ trimRPart <- trimClose

252+

253+ pure $ [TrimL | trimLPart] ++ [Partial e] ++ [TrimR | trimRPart]

203254

204255

205256--------------------------------------------------------------------------------

@@ -233,3 +284,14 @@ stringLiteral = do

233284--------------------------------------------------------------------------------

234285key :: P.Parser TemplateKey

235286key = TemplateKey <$> metadataKey

287+

288+

289+--------------------------------------------------------------------------------

290+opt :: String -> P.Parser (Maybe (Bool, [TemplateElement], Bool))

291+opt clause = P.optionMaybe $ P.try $ do

292+ trimL <- trimOpen

293+ void $ P.string clause

294+ trimR <- trimClose

295+ branch <- templateElems

296+ pure (trimL, branch, trimR)

297+

src/Hakyll/Web/Template/Trim.hsnew file+95

@@ -0,0 +1,95 @@

1+--------------------------------------------------------------------------------

2+-- | Module for trimming whitespace

3+module Hakyll.Web.Template.Trim

4+ ( trim

5+ ) where

8+--------------------------------------------------------------------------------

9+import Data.Char (isSpace)

10+import Data.List (dropWhileEnd)

11+

12+

13+--------------------------------------------------------------------------------

14+import Hakyll.Web.Template.Internal

15+

16+

17+--------------------------------------------------------------------------------

18+trim :: [TemplateElement] -> [TemplateElement]

19+trim = cleanse . canonicalize

20+

21+

22+--------------------------------------------------------------------------------

23+-- | Apply the Trim nodes to the Chunks.

24+cleanse :: [TemplateElement] -> [TemplateElement]

25+cleanse = recurse cleanse . process

26+ where process [] = []

27+ process (TrimR:Chunk str:ts) = let str' = dropWhile isSpace str

28+ in if null str'

29+ then process ts

30+ -- Might need to TrimL.

31+ else process $ Chunk str':ts

32+

33+ process (Chunk str:TrimL:ts) = let str' = dropWhileEnd isSpace str

34+ in if null str'

35+ then process ts

36+ else Chunk str':process ts

37+

38+ process (t:ts) = t:process ts

39+

40+--------------------------------------------------------------------------------

41+-- | Enforce the invariant that:

42+--

43+-- * Every 'TrimL' has a 'Chunk' to its left.

44+-- * Every 'TrimR' has a 'Chunk' to its right.

45+--

46+canonicalize :: [TemplateElement] -> [TemplateElement]

47+canonicalize = go

48+ where go t = let t' = redundant . swap $ dedupe t

49+ in if t == t' then t else go t'

50+

51+

52+--------------------------------------------------------------------------------

53+-- | Remove the 'TrimR' and 'TrimL's that are no-ops.

54+redundant :: [TemplateElement] -> [TemplateElement]

55+redundant = recurse redundant . process

56+ where -- Remove the leading 'TrimL's.

57+ process (TrimL:ts) = process ts

58+ -- Remove trailing 'TrimR's.

59+ process ts = foldr trailing [] ts

60+ where trailing TrimR [] = []

61+ trailing x xs = x:xs

62+

63+

64+--------------------------------------------------------------------------------

65+-- >>> swap $ [TrimR, TrimL]

66+-- [TrimL, TrimR]

67+swap :: [TemplateElement] -> [TemplateElement]

68+swap = recurse swap . process

69+ where process [] = []

70+ process (TrimR:TrimL:ts) = TrimL:process (TrimR:ts)

71+ process (t:ts) = t:process ts

72+

73+

74+--------------------------------------------------------------------------------

75+-- | Remove 'TrimR' and 'TrimL' duplication.

76+dedupe :: [TemplateElement] -> [TemplateElement]

77+dedupe = recurse dedupe . process

78+ where process [] = []

79+ process (TrimR:TrimR:ts) = process (TrimR:ts)

80+ process (TrimL:TrimL:ts) = process (TrimL:ts)

81+ process (t:ts) = t:process ts

82+

83+

84+--------------------------------------------------------------------------------

85+-- | @'recurse' f t@ applies f to every '[TemplateElement]' in t.

86+recurse :: ([TemplateElement] -> [TemplateElement])

87+ -> [TemplateElement]

88+ -> [TemplateElement]

89+recurse _ [] = []

90+recurse f (x:xs) = process x:recurse f xs

91+ where process y = case y of

92+ If e tb eb -> If e (f tb) (f <$> eb)

93+ For e t s -> For e (f t) (f <$> s)

94+ _ -> y

95+

tests/Hakyll/Web/Template/Tests.hs+51−17

@@ -6,7 +6,6 @@ module Hakyll.Web.Template.Tests

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

9−import Data.Monoid (mconcat)

109import Test.Framework (Test, testGroup)

1110import Test.Framework.Providers.HUnit (testCase)

1211import Test.HUnit (Assertion, (@=?), (@?=))

@@ -14,6 +13,7 @@ import Test.HUnit (Assertion, (@=?), (@?=))

1413

1514--------------------------------------------------------------------------------

1615import Hakyll.Core.Compiler

16+import Hakyll.Core.Identifier

1717import Hakyll.Core.Item

1818import Hakyll.Core.Provider

1919import Hakyll.Web.Pandoc

@@ -27,32 +27,67 @@ import TestSuite.Util

2727--------------------------------------------------------------------------------

2828tests :: Test

2929tests = testGroup "Hakyll.Core.Template.Tests" $ concat

30− [ [ testCase "case01" case01

30+ [ [ testCase "case01" $ test ("template.html.out", "template.html", "example.md")

31+ , testCase "case02" $ test ("strip.html.out", "strip.html", "example.md")

3132 , testCase "applyJoinTemplateList" testApplyJoinTemplateList

3233 ]

3334

3435 , fromAssertions "readTemplate"

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

36− @=? readTemplate "Hello $guest()$"

37− , Template

38− [If (Call "a" [StringLiteral "bar"])

39− (Template [Chunk "foo"])

40− Nothing]

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

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

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

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

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

40+ -- 'If' trim check.

41+ , [ TrimL

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

43+ [ TrimR

44+ , Chunk "\n"

45+ , Expr (Ident (TemplateKey "body"))

46+ , Chunk "\n"

47+ , TrimL

48+ ]

49+ (Just [ TrimR

50+ , Chunk "\n"

51+ , Expr (Ident (TemplateKey "body"))

52+ , Chunk "\n"

53+ , TrimL

54+ ])

55+ , TrimR

56+ ]

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

58+ -- 'For' trim check.

59+ , [ TrimL

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

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

62+ Nothing

63+ , TrimR

64+ ]

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

66+ -- 'Partial' trim check.

67+ , [ TrimL

68+ , Partial (StringLiteral "path")

69+ , TrimR

70+ ]

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

72+ -- 'Expr' trim check.

73+ , [ TrimL

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

75+ , TrimR

76+ ]

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

4278 ]

4379 ]

4480

4581

4682--------------------------------------------------------------------------------

47−case01 :: Assertion

48−case01 = do

83+test :: (Identifier, Identifier, Identifier) -> Assertion

84+test (outf, tplf, itemf) = do

4985 store <- newTestStore

5086 provider <- newTestProvider store

5187

52− out <- resourceString provider "template.html.out"

53− tpl <- testCompilerDone store provider "template.html" $

54− templateBodyCompiler

55− item <- testCompilerDone store provider "example.md" $

88+ out <- resourceString provider outf

89+ tpl <- testCompilerDone store provider tplf templateBodyCompiler

90+ item <- testCompilerDone store provider itemf $

5691 pandocCompiler >>= applyTemplate (itemBody tpl) testContext

5792

5893 out @=? itemBody item

@@ -69,7 +104,6 @@ testContext = mconcat

69104 return [n1, n2]

70105 , functionField "rev" $ \args _ -> return $ unwords $ map reverse args

71106 ]

72− where

73107

74108

75109--------------------------------------------------------------------------------

@@ -85,4 +119,4 @@ testApplyJoinTemplateList = do

85119 where

86120 i1 = Item "item1" "Hello"

87121 i2 = Item "item2" "World"

88− tpl = Template [Chunk "<b>", Expr (Ident "body"), Chunk "</b>"]

122+ tpl = readTemplate "<b>$body$</b>"

tests/data/strip.htmlnew file+34

@@ -0,0 +1,34 @@

1+<div>

2+ I'm so rich I have $$3.

4+ $rev("foo")$

5+ $-rev(rev("foo"))$

7+ $if(body)-$

8+ I have body

9+ $else-$

10+ or no

11+ $-endif-$

12+

13+ $if(unbound)$

14+ should not be printed

15+ $endif$

16+

17+ $-if(body)-$

18+ should be printed

19+ $-endif$

20+

21+ <ul>

22+ $for(authors)-$

23+ <li>$name$</li>

24+ $endfor-$

25+ </ul>

26+

27+ $for(authors)-$

28+ $name-$

29+ $sep$,

30+ $-endfor$

31+

32+ $body$

33+</div>

34+

tests/data/strip.html.outnew file+18

@@ -0,0 +1,18 @@

1+<div>

2+ I'm so rich I have $3.

4+ ooffoo

6+ I have body

7+ should be printed

9+ <ul>

10+ <li>Jan</li>

11+ <li>Piet</li>

12+ </ul>

13+

14+ Jan,Piet

15+

16+ <p>This is an example.</p>

17+</div>

18+