diff options
author | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2016-07-31 15:39:04 +0200 |
---|---|---|
committer | GitHub <noreply@github.com> | 2016-07-31 15:39:04 +0200 |
commit | 9e41414880718d5f18e4ae771ef21fc9447d1b60 (patch) | |
tree | 63659f9864780c9d50d474cb59c4d18f673c60cb /src/Hakyll/Web/Template/Trim.hs | |
parent | 68e9c7704216f88b73162963c06ef80616ff318a (diff) | |
parent | a31a5654036c8d8b43d24d3d8cef4e342c517a47 (diff) | |
download | hakyll-9e41414880718d5f18e4ae771ef21fc9447d1b60.tar.gz |
Merge pull request #454 from samgd/whitespace-control
Whitespace trimming
Diffstat (limited to 'src/Hakyll/Web/Template/Trim.hs')
-rw-r--r-- | src/Hakyll/Web/Template/Trim.hs | 95 |
1 files changed, 95 insertions, 0 deletions
diff --git a/src/Hakyll/Web/Template/Trim.hs b/src/Hakyll/Web/Template/Trim.hs new file mode 100644 index 0000000..bc7e691 --- /dev/null +++ b/src/Hakyll/Web/Template/Trim.hs @@ -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 + |