diff options
| -rw-r--r-- | lib/Hakyll/Web/Html.hs | 12 | ||||
| -rw-r--r-- | tests/Hakyll/Web/Html/Tests.hs | 13 |
2 files changed, 22 insertions, 3 deletions
diff --git a/lib/Hakyll/Web/Html.hs b/lib/Hakyll/Web/Html.hs index 8cbfaa3..7aa3804 100644 --- a/lib/Hakyll/Web/Html.hs +++ b/lib/Hakyll/Web/Html.hs @@ -7,6 +7,7 @@ module Hakyll.Web.Html -- * Headers , demoteHeaders + , demoteHeadersBy -- * Url manipulation , getUrls @@ -50,13 +51,20 @@ withTagList f = renderTags' . f . parseTags' -------------------------------------------------------------------------------- -- | Map every @h1@ to an @h2@, @h2@ to @h3@, etc. demoteHeaders :: String -> String -demoteHeaders = withTags $ \tag -> case tag of +demoteHeaders = demoteHeadersBy 1 + +-------------------------------------------------------------------------------- +-- | Maps any @hN@ to an @hN+amount@ for any @amount > 0 && 1 <= N+amount <= 6@. +demoteHeadersBy :: Int -> String -> String +demoteHeadersBy amount + | amount < 1 = id + | otherwise = withTags $ \tag -> case tag of TS.TagOpen t a -> TS.TagOpen (demote t) a TS.TagClose t -> TS.TagClose (demote t) t -> t where demote t@['h', n] - | isDigit n = ['h', intToDigit (min 6 $ digitToInt n + 1)] + | isDigit n = ['h', intToDigit (min 6 $ digitToInt n + amount)] | otherwise = t demote t = t diff --git a/tests/Hakyll/Web/Html/Tests.hs b/tests/Hakyll/Web/Html/Tests.hs index cd362f4..9ab10bc 100644 --- a/tests/Hakyll/Web/Html/Tests.hs +++ b/tests/Hakyll/Web/Html/Tests.hs @@ -20,7 +20,18 @@ tests :: TestTree tests = testGroup "Hakyll.Web.Html.Tests" $ concat [ fromAssertions "demoteHeaders" [ "<h2>A h1 title</h2>" @=? - demoteHeaders "<h1>A h1 title</h1>" + demoteHeaders "<h1>A h1 title</h1>" -- Assert single-step demotion + , "<h6>A h6 title</h6>" @=? + demoteHeaders "<h6>A h6 title</h6>" -- Assert maximum demotion is h6 + ] + + , fromAssertions "demoteHeadersBy" + [ "<h3>A h1 title</h3>" @=? + demoteHeadersBy 2 "<h1>A h1 title</h1>" + , "<h6>A h5 title</h6>" @=? + demoteHeadersBy 2 "<h5>A h5 title</h5>" -- Assert that h6 is the lowest possible demoted header. + , "<h4>A h4 title</h4>" @=? + demoteHeadersBy 0 "<h4>A h4 title</h4>" -- Assert that a demotion of @N < 1@ is a no-op. ] , fromAssertions "withUrls" |