Merge pull request #454 from samgd/whitespace-control
Whitespace trimming
This commit is contained in:
Jasper Van der Jeugt
GitHub
commit
9e41414880
9 changed files with 431 additions and 114 deletions
|
|
@ -117,6 +117,7 @@ Library
|
|||
Hakyll.Web.Paginate
|
||||
Hakyll.Web.Template
|
||||
Hakyll.Web.Template.Internal
|
||||
Hakyll.Web.Template.Trim
|
||||
Hakyll.Web.Template.Context
|
||||
Hakyll.Web.Template.List
|
||||
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ module Hakyll.Core.Util.Parser
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Monad (mzero)
|
||||
import Control.Monad (guard, mzero, void)
|
||||
import qualified Text.Parsec as P
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
|
|
@ -16,7 +16,14 @@ import Text.Parsec.String (Parser)
|
|||
--------------------------------------------------------------------------------
|
||||
metadataKey :: Parser String
|
||||
metadataKey = do
|
||||
i <- (:) <$> P.letter <*> (P.many $ P.alphaNum <|> P.oneOf "_-.")
|
||||
-- Ensure trailing '-' binds to '$' if present.
|
||||
let hyphon = P.try $ do
|
||||
void $ P.char '-'
|
||||
x <- P.lookAhead P.anyChar
|
||||
guard $ x /= '$'
|
||||
pure '-'
|
||||
|
||||
i <- (:) <$> P.letter <*> P.many (P.alphaNum <|> P.oneOf "_." <|> hyphon)
|
||||
if i `elem` reservedKeys then mzero else return i
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -23,17 +23,12 @@ module Hakyll.Web.Feed
|
|||
) where
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Monad ((<=<))
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Hakyll.Core.Compiler
|
||||
import Hakyll.Core.Compiler.Internal
|
||||
import Hakyll.Core.Item
|
||||
import Hakyll.Web.Template
|
||||
import Hakyll.Web.Template.Context
|
||||
import Hakyll.Web.Template.Internal
|
||||
import Hakyll.Web.Template.List
|
||||
|
||||
|
||||
|
|
@ -66,17 +61,16 @@ renderFeed :: FilePath -- ^ Feed template
|
|||
-> [Item String] -- ^ Input items
|
||||
-> Compiler (Item String) -- ^ Resulting item
|
||||
renderFeed feedPath itemPath config itemContext items = do
|
||||
feedTpl <- compilerUnsafeIO $ loadTemplate feedPath
|
||||
itemTpl <- compilerUnsafeIO $ loadTemplate itemPath
|
||||
feedTpl <- loadTemplate feedPath
|
||||
itemTpl <- loadTemplate itemPath
|
||||
|
||||
body <- makeItem =<< applyTemplateList itemTpl itemContext' items
|
||||
applyTemplate feedTpl feedContext body
|
||||
where
|
||||
-- Auxiliary: load a template from a datafile
|
||||
loadTemplate path = do
|
||||
file <- getDataFileName path
|
||||
templ <- readFile file
|
||||
return $ readTemplateFile file templ
|
||||
file <- compilerUnsafeIO $ getDataFileName path
|
||||
unsafeReadTemplateFile file
|
||||
|
||||
itemContext' = mconcat
|
||||
[ itemContext
|
||||
|
|
|
|||
|
|
@ -115,6 +115,30 @@
|
|||
-- That is, calling @$partial$@ is equivalent to just copying and pasting
|
||||
-- template code.
|
||||
--
|
||||
-- In the examples above you can see that the outputs contain a lot of leftover
|
||||
-- whitespace that you may wish to remove. Using @'$-'@ or @'-$'@ instead of
|
||||
-- @'$'@ in a macro strips all whitespace to the left or right of that clause
|
||||
-- respectively. Given the context
|
||||
--
|
||||
-- > listField "counts" (field "count" (return . itemBody))
|
||||
-- > (sequence [makeItem "3", makeItem "2", makeItem "1"])
|
||||
--
|
||||
-- and a template
|
||||
--
|
||||
-- > <p>
|
||||
-- > $for(counts)-$
|
||||
-- > $count$
|
||||
-- > $-sep$...
|
||||
-- > $-endfor$
|
||||
-- > </p>
|
||||
--
|
||||
-- the resulting page would look like
|
||||
--
|
||||
-- > <p>
|
||||
-- > 3...2...1
|
||||
-- > </p>
|
||||
--
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Hakyll.Web.Template
|
||||
( Template
|
||||
|
|
@ -124,13 +148,16 @@ module Hakyll.Web.Template
|
|||
, loadAndApplyTemplate
|
||||
, applyAsTemplate
|
||||
, readTemplate
|
||||
, unsafeReadTemplateFile
|
||||
) where
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Monad (liftM)
|
||||
import Control.Monad.Except (MonadError (..))
|
||||
import Data.Binary (Binary)
|
||||
import Data.List (intercalate)
|
||||
import Data.Typeable (Typeable)
|
||||
import GHC.Exts (IsString (..))
|
||||
import Prelude hiding (id)
|
||||
|
||||
|
||||
|
|
@ -138,17 +165,47 @@ import Prelude hiding (id)
|
|||
import Hakyll.Core.Compiler
|
||||
import Hakyll.Core.Identifier
|
||||
import Hakyll.Core.Item
|
||||
import Hakyll.Core.Writable
|
||||
import Hakyll.Web.Template.Context
|
||||
import Hakyll.Web.Template.Internal
|
||||
import Hakyll.Web.Template.Trim
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Datatype used for template substitutions.
|
||||
newtype Template = Template
|
||||
{ unTemplate :: [TemplateElement]
|
||||
} deriving (Show, Eq, Binary, Typeable)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
instance Writable Template where
|
||||
-- Writing a template is impossible
|
||||
write _ _ = return ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
instance IsString Template where
|
||||
fromString = readTemplate
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Wrap the constructor to ensure trim is called.
|
||||
template :: [TemplateElement] -> Template
|
||||
template = Template . trim
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
readTemplate :: String -> Template
|
||||
readTemplate = Template . trim . readTemplateElems
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Read a template, without metadata header
|
||||
templateBodyCompiler :: Compiler (Item Template)
|
||||
templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do
|
||||
item <- getResourceBody
|
||||
file <- getResourceFilePath
|
||||
return $ fmap (readTemplateFile file) item
|
||||
return $ fmap (template . readTemplateElemsFile file) item
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Read complete file contents as a template
|
||||
|
|
@ -156,7 +213,7 @@ templateCompiler :: Compiler (Item Template)
|
|||
templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do
|
||||
item <- getResourceString
|
||||
file <- getResourceFilePath
|
||||
return $ fmap (readTemplateFile file) item
|
||||
return $ fmap (template . readTemplateElemsFile file) item
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -165,28 +222,35 @@ applyTemplate :: Template -- ^ Template
|
|||
-> Item a -- ^ Page
|
||||
-> Compiler (Item String) -- ^ Resulting item
|
||||
applyTemplate tpl context item = do
|
||||
body <- applyTemplate' tpl context item
|
||||
body <- applyTemplate' (unTemplate tpl) context item
|
||||
return $ itemSetBody body item
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
applyTemplate'
|
||||
:: forall a.
|
||||
Template -- ^ Template
|
||||
[TemplateElement] -- ^ Unwrapped Template
|
||||
-> Context a -- ^ Context
|
||||
-> Item a -- ^ Page
|
||||
-> Compiler String -- ^ Resulting item
|
||||
applyTemplate' tpl context x = go tpl
|
||||
applyTemplate' tes context x = go tes
|
||||
where
|
||||
context' :: String -> [String] -> Item a -> Compiler ContextField
|
||||
context' = unContext (context `mappend` missingField)
|
||||
|
||||
go = liftM concat . mapM applyElem . unTemplate
|
||||
go = fmap concat . mapM applyElem
|
||||
|
||||
trimError = error $ "Hakyll.Web.Template.applyTemplate: template not " ++
|
||||
"fully trimmed."
|
||||
|
||||
---------------------------------------------------------------------------
|
||||
|
||||
applyElem :: TemplateElement -> Compiler String
|
||||
|
||||
applyElem TrimL = trimError
|
||||
|
||||
applyElem TrimR = trimError
|
||||
|
||||
applyElem (Chunk c) = return c
|
||||
|
||||
applyElem (Expr e) = applyExpr e >>= getString e
|
||||
|
|
@ -261,6 +325,14 @@ applyAsTemplate :: Context String -- ^ Context
|
|||
-> Item String -- ^ Item and template
|
||||
-> Compiler (Item String) -- ^ Resulting item
|
||||
applyAsTemplate context item =
|
||||
let tpl = readTemplateFile file (itemBody item)
|
||||
let tpl = template $ readTemplateElemsFile file (itemBody item)
|
||||
file = toFilePath $ itemIdentifier item
|
||||
in applyTemplate tpl context item
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
unsafeReadTemplateFile :: FilePath -> Compiler Template
|
||||
unsafeReadTemplateFile file = do
|
||||
tpl <- unsafeCompiler $ readFile file
|
||||
pure $ template $ readTemplateElemsFile file tpl
|
||||
|
||||
|
|
|
|||
|
|
@ -1,14 +1,13 @@
|
|||
--------------------------------------------------------------------------------
|
||||
-- | Module containing the template data structure
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
module Hakyll.Web.Template.Internal
|
||||
( Template (..)
|
||||
, TemplateKey (..)
|
||||
( TemplateKey (..)
|
||||
, TemplateExpr (..)
|
||||
, TemplateElement (..)
|
||||
, readTemplate
|
||||
, readTemplateFile
|
||||
, templateElems
|
||||
, readTemplateElems
|
||||
, readTemplateElemsFile
|
||||
) where
|
||||
|
||||
|
||||
|
|
@ -16,8 +15,9 @@ module Hakyll.Web.Template.Internal
|
|||
import Control.Applicative ((<|>))
|
||||
import Control.Monad (void)
|
||||
import Data.Binary (Binary, get, getWord8, put, putWord8)
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Typeable (Typeable)
|
||||
import GHC.Exts (IsString (..))
|
||||
import qualified Text.Parsec as P
|
||||
import qualified Text.Parsec.String as P
|
||||
|
|
@ -25,25 +25,6 @@ import qualified Text.Parsec.String as P
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
import Hakyll.Core.Util.Parser
|
||||
import Hakyll.Core.Writable
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Datatype used for template substitutions.
|
||||
newtype Template = Template
|
||||
{ unTemplate :: [TemplateElement]
|
||||
} deriving (Show, Eq, Binary, Typeable)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
instance Writable Template where
|
||||
-- Writing a template is impossible
|
||||
write _ _ = return ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
instance IsString Template where
|
||||
fromString = readTemplate
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -62,9 +43,14 @@ data TemplateElement
|
|||
= Chunk String
|
||||
| Expr TemplateExpr
|
||||
| Escaped
|
||||
| If TemplateExpr Template (Maybe Template) -- expr, then, else
|
||||
| For TemplateExpr Template (Maybe Template) -- expr, body, separator
|
||||
| Partial TemplateExpr -- filename
|
||||
-- expr, then, else
|
||||
| If TemplateExpr [TemplateElement] (Maybe [TemplateElement])
|
||||
-- expr, body, separator
|
||||
| For TemplateExpr [TemplateElement] (Maybe [TemplateElement])
|
||||
-- filename
|
||||
| Partial TemplateExpr
|
||||
| TrimL
|
||||
| TrimR
|
||||
deriving (Show, Eq, Typeable)
|
||||
|
||||
|
||||
|
|
@ -72,10 +58,12 @@ data TemplateElement
|
|||
instance Binary TemplateElement where
|
||||
put (Chunk string) = putWord8 0 >> put string
|
||||
put (Expr e) = putWord8 1 >> put e
|
||||
put (Escaped) = putWord8 2
|
||||
put Escaped = putWord8 2
|
||||
put (If e t f) = putWord8 3 >> put e >> put t >> put f
|
||||
put (For e b s) = putWord8 4 >> put e >> put b >> put s
|
||||
put (Partial e) = putWord8 5 >> put e
|
||||
put TrimL = putWord8 6
|
||||
put TrimR = putWord8 7
|
||||
|
||||
get = getWord8 >>= \tag -> case tag of
|
||||
0 -> Chunk <$> get
|
||||
|
|
@ -84,8 +72,9 @@ instance Binary TemplateElement where
|
|||
3 -> If <$> get <*> get <*> get
|
||||
4 -> For <$> get <*> get <*> get
|
||||
5 -> Partial <$> get
|
||||
_ -> error $
|
||||
"Hakyll.Web.Template.Internal: Error reading cached template"
|
||||
6 -> pure TrimL
|
||||
7 -> pure TrimR
|
||||
_ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -115,48 +104,45 @@ instance Binary TemplateExpr where
|
|||
0 -> Ident <$> get
|
||||
1 -> Call <$> get <*> get
|
||||
2 -> StringLiteral <$> get
|
||||
_ -> error $
|
||||
"Hakyll.Web.Tamplte.Internal: Error reading cached template"
|
||||
_ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
readTemplate :: String -> Template
|
||||
readTemplate = readTemplateFile "{literal}"
|
||||
readTemplateElems :: String -> [TemplateElement]
|
||||
readTemplateElems = readTemplateElemsFile "{literal}"
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
readTemplateFile :: FilePath -> String -> Template
|
||||
readTemplateFile file input = case P.parse topLevelTemplate file input of
|
||||
readTemplateElemsFile :: FilePath -> String -> [TemplateElement]
|
||||
readTemplateElemsFile file input = case P.parse templateElems file input of
|
||||
Left err -> error $ "Cannot parse template: " ++ show err
|
||||
Right t -> t
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
topLevelTemplate :: P.Parser Template
|
||||
topLevelTemplate = Template <$>
|
||||
P.manyTill templateElement P.eof
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
template :: P.Parser Template
|
||||
template = Template <$> P.many templateElement
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
templateElement :: P.Parser TemplateElement
|
||||
templateElement = chunk <|> escaped <|> conditional <|> for <|> partial <|> expr
|
||||
templateElems :: P.Parser [TemplateElement]
|
||||
templateElems = mconcat <$> P.many (P.choice [ lift chunk
|
||||
, lift escaped
|
||||
, conditional
|
||||
, for
|
||||
, partial
|
||||
, expr
|
||||
])
|
||||
where lift = fmap (:[])
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
chunk :: P.Parser TemplateElement
|
||||
chunk = Chunk <$> (P.many1 $ P.noneOf "$")
|
||||
chunk = Chunk <$> P.many1 (P.noneOf "$")
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
expr :: P.Parser TemplateElement
|
||||
expr :: P.Parser [TemplateElement]
|
||||
expr = P.try $ do
|
||||
void $ P.char '$'
|
||||
trimLExpr <- trimOpen
|
||||
e <- expr'
|
||||
void $ P.char '$'
|
||||
return $ Expr e
|
||||
trimRExpr <- trimClose
|
||||
return $ [TrimL | trimLExpr] ++ [Expr e] ++ [TrimR | trimRExpr]
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -166,40 +152,105 @@ expr' = stringLiteral <|> call <|> ident
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
escaped :: P.Parser TemplateElement
|
||||
escaped = Escaped <$ (P.try $ P.string "$$")
|
||||
escaped = Escaped <$ P.try (P.string "$$")
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
conditional :: P.Parser TemplateElement
|
||||
trimOpen :: P.Parser Bool
|
||||
trimOpen = do
|
||||
void $ P.char '$'
|
||||
trimLIf <- P.optionMaybe $ P.try (P.char '-')
|
||||
pure $ isJust trimLIf
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
trimClose :: P.Parser Bool
|
||||
trimClose = do
|
||||
trimIfR <- P.optionMaybe $ P.try (P.char '-')
|
||||
void $ P.char '$'
|
||||
pure $ isJust trimIfR
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
conditional :: P.Parser [TemplateElement]
|
||||
conditional = P.try $ do
|
||||
void $ P.string "$if("
|
||||
-- if
|
||||
trimLIf <- trimOpen
|
||||
void $ P.string "if("
|
||||
e <- expr'
|
||||
void $ P.string ")$"
|
||||
thenBranch <- template
|
||||
elseBranch <- P.optionMaybe $ P.try (P.string "$else$") >> template
|
||||
void $ P.string "$endif$"
|
||||
return $ If e thenBranch elseBranch
|
||||
void $ P.char ')'
|
||||
trimRIf <- trimClose
|
||||
-- then
|
||||
thenBranch <- templateElems
|
||||
-- else
|
||||
elseParse <- opt "else"
|
||||
-- endif
|
||||
trimLEnd <- trimOpen
|
||||
void $ P.string "endif"
|
||||
trimREnd <- trimClose
|
||||
|
||||
-- As else is optional we need to sort out where any Trim_s need to go.
|
||||
let (thenBody, elseBody) = maybe (thenNoElse, Nothing) thenElse elseParse
|
||||
where thenNoElse =
|
||||
[TrimR | trimRIf] ++ thenBranch ++ [TrimL | trimLEnd]
|
||||
|
||||
thenElse (trimLElse, elseBranch, trimRElse) = (thenB, elseB)
|
||||
where thenB = [TrimR | trimRIf]
|
||||
++ thenBranch
|
||||
++ [TrimL | trimLElse]
|
||||
|
||||
elseB = Just $ [TrimR | trimRElse]
|
||||
++ elseBranch
|
||||
++ [TrimL | trimLEnd]
|
||||
|
||||
pure $ [TrimL | trimLIf] ++ [If e thenBody elseBody] ++ [TrimR | trimREnd]
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
for :: P.Parser TemplateElement
|
||||
for :: P.Parser [TemplateElement]
|
||||
for = P.try $ do
|
||||
void $ P.string "$for("
|
||||
-- for
|
||||
trimLFor <- trimOpen
|
||||
void $ P.string "for("
|
||||
e <- expr'
|
||||
void $ P.string ")$"
|
||||
body <- template
|
||||
sep <- P.optionMaybe $ P.try (P.string "$sep$") >> template
|
||||
void $ P.string "$endfor$"
|
||||
return $ For e body sep
|
||||
void $ P.char ')'
|
||||
trimRFor <- trimClose
|
||||
-- body
|
||||
bodyBranch <- templateElems
|
||||
-- sep
|
||||
sepParse <- opt "sep"
|
||||
-- endfor
|
||||
trimLEnd <- trimOpen
|
||||
void $ P.string "endfor"
|
||||
trimREnd <- trimClose
|
||||
|
||||
-- As sep is optional we need to sort out where any Trim_s need to go.
|
||||
let (forBody, sepBody) = maybe (forNoSep, Nothing) forSep sepParse
|
||||
where forNoSep =
|
||||
[TrimR | trimRFor] ++ bodyBranch ++ [TrimL | trimLEnd]
|
||||
|
||||
forSep (trimLSep, sepBranch, trimRSep) = (forB, sepB)
|
||||
where forB = [TrimR | trimRFor]
|
||||
++ bodyBranch
|
||||
++ [TrimL | trimLSep]
|
||||
|
||||
sepB = Just $ [TrimR | trimRSep]
|
||||
++ sepBranch
|
||||
++ [TrimL | trimLEnd]
|
||||
|
||||
pure $ [TrimL | trimLFor] ++ [For e forBody sepBody] ++ [TrimR | trimREnd]
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
partial :: P.Parser TemplateElement
|
||||
partial :: P.Parser [TemplateElement]
|
||||
partial = P.try $ do
|
||||
void $ P.string "$partial("
|
||||
trimLPart <- trimOpen
|
||||
void $ P.string "partial("
|
||||
e <- expr'
|
||||
void $ P.string ")$"
|
||||
return $ Partial e
|
||||
void $ P.char ')'
|
||||
trimRPart <- trimClose
|
||||
|
||||
pure $ [TrimL | trimLPart] ++ [Partial e] ++ [TrimR | trimRPart]
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -233,3 +284,14 @@ stringLiteral = do
|
|||
--------------------------------------------------------------------------------
|
||||
key :: P.Parser TemplateKey
|
||||
key = TemplateKey <$> metadataKey
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
opt :: String -> P.Parser (Maybe (Bool, [TemplateElement], Bool))
|
||||
opt clause = P.optionMaybe $ P.try $ do
|
||||
trimL <- trimOpen
|
||||
void $ P.string clause
|
||||
trimR <- trimClose
|
||||
branch <- templateElems
|
||||
pure (trimL, branch, trimR)
|
||||
|
||||
|
|
|
|||
95
src/Hakyll/Web/Template/Trim.hs
Normal file
95
src/Hakyll/Web/Template/Trim.hs
Normal file
|
|
@ -0,0 +1,95 @@
|
|||
--------------------------------------------------------------------------------
|
||||
-- | Module for trimming whitespace
|
||||
module Hakyll.Web.Template.Trim
|
||||
( trim
|
||||
) where
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Char (isSpace)
|
||||
import Data.List (dropWhileEnd)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Hakyll.Web.Template.Internal
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
trim :: [TemplateElement] -> [TemplateElement]
|
||||
trim = cleanse . canonicalize
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Apply the Trim nodes to the Chunks.
|
||||
cleanse :: [TemplateElement] -> [TemplateElement]
|
||||
cleanse = recurse cleanse . process
|
||||
where process [] = []
|
||||
process (TrimR:Chunk str:ts) = let str' = dropWhile isSpace str
|
||||
in if null str'
|
||||
then process ts
|
||||
-- Might need to TrimL.
|
||||
else process $ Chunk str':ts
|
||||
|
||||
process (Chunk str:TrimL:ts) = let str' = dropWhileEnd isSpace str
|
||||
in if null str'
|
||||
then process ts
|
||||
else Chunk str':process ts
|
||||
|
||||
process (t:ts) = t:process ts
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Enforce the invariant that:
|
||||
--
|
||||
-- * Every 'TrimL' has a 'Chunk' to its left.
|
||||
-- * Every 'TrimR' has a 'Chunk' to its right.
|
||||
--
|
||||
canonicalize :: [TemplateElement] -> [TemplateElement]
|
||||
canonicalize = go
|
||||
where go t = let t' = redundant . swap $ dedupe t
|
||||
in if t == t' then t else go t'
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Remove the 'TrimR' and 'TrimL's that are no-ops.
|
||||
redundant :: [TemplateElement] -> [TemplateElement]
|
||||
redundant = recurse redundant . process
|
||||
where -- Remove the leading 'TrimL's.
|
||||
process (TrimL:ts) = process ts
|
||||
-- Remove trailing 'TrimR's.
|
||||
process ts = foldr trailing [] ts
|
||||
where trailing TrimR [] = []
|
||||
trailing x xs = x:xs
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- >>> swap $ [TrimR, TrimL]
|
||||
-- [TrimL, TrimR]
|
||||
swap :: [TemplateElement] -> [TemplateElement]
|
||||
swap = recurse swap . process
|
||||
where process [] = []
|
||||
process (TrimR:TrimL:ts) = TrimL:process (TrimR:ts)
|
||||
process (t:ts) = t:process ts
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Remove 'TrimR' and 'TrimL' duplication.
|
||||
dedupe :: [TemplateElement] -> [TemplateElement]
|
||||
dedupe = recurse dedupe . process
|
||||
where process [] = []
|
||||
process (TrimR:TrimR:ts) = process (TrimR:ts)
|
||||
process (TrimL:TrimL:ts) = process (TrimL:ts)
|
||||
process (t:ts) = t:process ts
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | @'recurse' f t@ applies f to every '[TemplateElement]' in t.
|
||||
recurse :: ([TemplateElement] -> [TemplateElement])
|
||||
-> [TemplateElement]
|
||||
-> [TemplateElement]
|
||||
recurse _ [] = []
|
||||
recurse f (x:xs) = process x:recurse f xs
|
||||
where process y = case y of
|
||||
If e tb eb -> If e (f tb) (f <$> eb)
|
||||
For e t s -> For e (f t) (f <$> s)
|
||||
_ -> y
|
||||
|
||||
|
|
@ -6,7 +6,6 @@ module Hakyll.Web.Template.Tests
|
|||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Monoid (mconcat)
|
||||
import Test.Framework (Test, testGroup)
|
||||
import Test.Framework.Providers.HUnit (testCase)
|
||||
import Test.HUnit (Assertion, (@=?), (@?=))
|
||||
|
|
@ -14,6 +13,7 @@ import Test.HUnit (Assertion, (@=?), (@?=))
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
import Hakyll.Core.Compiler
|
||||
import Hakyll.Core.Identifier
|
||||
import Hakyll.Core.Item
|
||||
import Hakyll.Core.Provider
|
||||
import Hakyll.Web.Pandoc
|
||||
|
|
@ -27,32 +27,67 @@ import TestSuite.Util
|
|||
--------------------------------------------------------------------------------
|
||||
tests :: Test
|
||||
tests = testGroup "Hakyll.Core.Template.Tests" $ concat
|
||||
[ [ testCase "case01" case01
|
||||
[ [ testCase "case01" $ test ("template.html.out", "template.html", "example.md")
|
||||
, testCase "case02" $ test ("strip.html.out", "strip.html", "example.md")
|
||||
, testCase "applyJoinTemplateList" testApplyJoinTemplateList
|
||||
]
|
||||
|
||||
, fromAssertions "readTemplate"
|
||||
[ Template [Chunk "Hello ", Expr (Call "guest" [])]
|
||||
@=? readTemplate "Hello $guest()$"
|
||||
, Template
|
||||
[If (Call "a" [StringLiteral "bar"])
|
||||
(Template [Chunk "foo"])
|
||||
Nothing]
|
||||
@=? readTemplate "$if(a(\"bar\"))$foo$endif$"
|
||||
[ [Chunk "Hello ", Expr (Call "guest" [])]
|
||||
@=? readTemplateElems "Hello $guest()$"
|
||||
, [If (Call "a" [StringLiteral "bar"]) [Chunk "foo"] Nothing]
|
||||
@=? readTemplateElems "$if(a(\"bar\"))$foo$endif$"
|
||||
-- 'If' trim check.
|
||||
, [ TrimL
|
||||
, If (Ident (TemplateKey "body"))
|
||||
[ TrimR
|
||||
, Chunk "\n"
|
||||
, Expr (Ident (TemplateKey "body"))
|
||||
, Chunk "\n"
|
||||
, TrimL
|
||||
]
|
||||
(Just [ TrimR
|
||||
, Chunk "\n"
|
||||
, Expr (Ident (TemplateKey "body"))
|
||||
, Chunk "\n"
|
||||
, TrimL
|
||||
])
|
||||
, TrimR
|
||||
]
|
||||
@=? readTemplateElems "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"
|
||||
-- 'For' trim check.
|
||||
, [ TrimL
|
||||
, For (Ident (TemplateKey "authors"))
|
||||
[TrimR, Chunk "\n body \n", TrimL]
|
||||
Nothing
|
||||
, TrimR
|
||||
]
|
||||
@=? readTemplateElems "$-for(authors)-$\n body \n$-endfor-$"
|
||||
-- 'Partial' trim check.
|
||||
, [ TrimL
|
||||
, Partial (StringLiteral "path")
|
||||
, TrimR
|
||||
]
|
||||
@=? readTemplateElems "$-partial(\"path\")-$"
|
||||
-- 'Expr' trim check.
|
||||
, [ TrimL
|
||||
, Expr (Ident (TemplateKey "foo"))
|
||||
, TrimR
|
||||
]
|
||||
@=? readTemplateElems "$-foo-$"
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
case01 :: Assertion
|
||||
case01 = do
|
||||
test :: (Identifier, Identifier, Identifier) -> Assertion
|
||||
test (outf, tplf, itemf) = do
|
||||
store <- newTestStore
|
||||
provider <- newTestProvider store
|
||||
|
||||
out <- resourceString provider "template.html.out"
|
||||
tpl <- testCompilerDone store provider "template.html" $
|
||||
templateBodyCompiler
|
||||
item <- testCompilerDone store provider "example.md" $
|
||||
out <- resourceString provider outf
|
||||
tpl <- testCompilerDone store provider tplf templateBodyCompiler
|
||||
item <- testCompilerDone store provider itemf $
|
||||
pandocCompiler >>= applyTemplate (itemBody tpl) testContext
|
||||
|
||||
out @=? itemBody item
|
||||
|
|
@ -69,7 +104,6 @@ testContext = mconcat
|
|||
return [n1, n2]
|
||||
, functionField "rev" $ \args _ -> return $ unwords $ map reverse args
|
||||
]
|
||||
where
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -85,4 +119,4 @@ testApplyJoinTemplateList = do
|
|||
where
|
||||
i1 = Item "item1" "Hello"
|
||||
i2 = Item "item2" "World"
|
||||
tpl = Template [Chunk "<b>", Expr (Ident "body"), Chunk "</b>"]
|
||||
tpl = readTemplate "<b>$body$</b>"
|
||||
|
|
|
|||
34
tests/data/strip.html
Normal file
34
tests/data/strip.html
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
<div>
|
||||
I'm so rich I have $$3.
|
||||
|
||||
$rev("foo")$
|
||||
$-rev(rev("foo"))$
|
||||
|
||||
$if(body)-$
|
||||
I have body
|
||||
$else-$
|
||||
or no
|
||||
$-endif-$
|
||||
|
||||
$if(unbound)$
|
||||
should not be printed
|
||||
$endif$
|
||||
|
||||
$-if(body)-$
|
||||
should be printed
|
||||
$-endif$
|
||||
|
||||
<ul>
|
||||
$for(authors)-$
|
||||
<li>$name$</li>
|
||||
$endfor-$
|
||||
</ul>
|
||||
|
||||
$for(authors)-$
|
||||
$name-$
|
||||
$sep$,
|
||||
$-endfor$
|
||||
|
||||
$body$
|
||||
</div>
|
||||
|
||||
18
tests/data/strip.html.out
Normal file
18
tests/data/strip.html.out
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
<div>
|
||||
I'm so rich I have $3.
|
||||
|
||||
ooffoo
|
||||
|
||||
I have body
|
||||
should be printed
|
||||
|
||||
<ul>
|
||||
<li>Jan</li>
|
||||
<li>Piet</li>
|
||||
</ul>
|
||||
|
||||
Jan,Piet
|
||||
|
||||
<p>This is an example.</p>
|
||||
</div>
|
||||
|
||||
Loading…
Reference in a new issue