From f24c5873ed5bb091f0ce5ebdf4df7ab160e87c75 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Wed, 30 Sep 2020 14:04:33 +0200 Subject: Bump template-haskell and pandoc versions * Bumped bound for pandoc and add Binary-instances for new constructors that were added to pandoc-types * Support most recent template-haskell release * Set lower bound of pandoc to version 2.10 * Update CI configuration * Bump QuickCheck upper bound to 2.15 Co-authored-by: OC4 --- lib/Hakyll/Web/Pandoc/Binary.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'lib/Hakyll/Web') diff --git a/lib/Hakyll/Web/Pandoc/Binary.hs b/lib/Hakyll/Web/Pandoc/Binary.hs index deeaf08..5d3efea 100644 --- a/lib/Hakyll/Web/Pandoc/Binary.hs +++ b/lib/Hakyll/Web/Pandoc/Binary.hs @@ -14,6 +14,10 @@ import Text.Pandoc instance Binary Alignment instance Binary Block +instance Binary Caption +instance Binary Cell +instance Binary ColSpan +instance Binary ColWidth instance Binary CSL.Reference instance Binary Citation instance Binary CitationMode @@ -29,5 +33,11 @@ instance Binary REF.Literal instance Binary REF.RefDate instance Binary REF.RefType instance Binary REF.Season +instance Binary Row +instance Binary RowHeadColumns +instance Binary RowSpan instance Binary STY.Agent instance Binary STY.Formatted +instance Binary TableBody +instance Binary TableFoot +instance Binary TableHead -- cgit v1.2.3 From ab9eea7029e2f666a0accce07ce5f5105f5c2155 Mon Sep 17 00:00:00 2001 From: Liang-Ting Chen Date: Thu, 12 Nov 2020 05:32:10 +0800 Subject: Remove unnecessary conditional compilation for parseTimeM (#781) --- lib/Hakyll/Web/Template/Context.hs | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) (limited to 'lib/Hakyll/Web') diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs index 3f75466..9ce7440 100644 --- a/lib/Hakyll/Web/Template/Context.hs +++ b/lib/Hakyll/Web/Template/Context.hs @@ -60,8 +60,7 @@ import Data.List (intercalate, tails) import Data.Semigroup (Semigroup (..)) #endif import Data.Time.Clock (UTCTime (..)) -import Data.Time.Format (formatTime) -import qualified Data.Time.Format as TF +import Data.Time.Format (formatTime, parseTimeM) import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale) import Hakyll.Core.Compiler import Hakyll.Core.Compiler.Internal @@ -463,10 +462,3 @@ teaserFieldWithSeparator separator key snapshot = field key $ \item -> do missingField :: Context a missingField = Context $ \k _ _ -> noResult $ "Missing field '" ++ k ++ "' in context" - -parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime -#if MIN_VERSION_time(1,5,0) -parseTimeM = TF.parseTimeM -#else -parseTimeM _ = TF.parseTime -#endif -- cgit v1.2.3 From 77afcbc2937a4ee5db9666c1f3e0c090914d3980 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sun, 6 Dec 2020 19:24:06 +0100 Subject: Pandoc 2.11 compatibility (#826) * Pandoc 2.11 compatibility * Bump stack.yaml * Bump stack dependencies --- hakyll.cabal | 5 +- lib/Hakyll/Web/Pandoc/Biblio.hs | 102 ++++++++++++++++++++++------------------ lib/Hakyll/Web/Pandoc/Binary.hs | 12 ----- stack.yaml | 17 +++++-- stack.yaml.lock | 73 ++++++++++++++++++++-------- 5 files changed, 123 insertions(+), 86 deletions(-) (limited to 'lib/Hakyll/Web') diff --git a/hakyll.cabal b/hakyll.cabal index a3c0cc3..94bbab8 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -232,8 +232,7 @@ Library Other-Modules: Hakyll.Web.Pandoc.Binary Build-Depends: - pandoc >= 2.10 && < 2.12, - pandoc-citeproc >= 0.14 && < 0.18 + pandoc >= 2.11 && < 2.12 Cpp-options: -DUSE_PANDOC @@ -327,4 +326,4 @@ Executable hakyll-website base >= 4 && < 5, directory >= 1.0 && < 1.4, filepath >= 1.0 && < 1.5, - pandoc >= 2.10 && < 2.12 + pandoc >= 2.11 && < 2.12 diff --git a/lib/Hakyll/Web/Pandoc/Biblio.hs b/lib/Hakyll/Web/Pandoc/Biblio.hs index 5127d88..567f478 100644 --- a/lib/Hakyll/Web/Pandoc/Biblio.hs +++ b/lib/Hakyll/Web/Pandoc/Biblio.hs @@ -12,6 +12,7 @@ {-# LANGUAGE Arrows #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} module Hakyll.Web.Pandoc.Biblio ( CSL , cslCompiler @@ -23,33 +24,31 @@ module Hakyll.Web.Pandoc.Biblio -------------------------------------------------------------------------------- -import Control.Monad (liftM, replicateM) -import Data.Binary (Binary (..)) -import Data.Typeable (Typeable) +import Control.Monad (liftM) +import Data.Binary (Binary (..)) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.Map as Map +import qualified Data.Time as Time +import Data.Typeable (Typeable) import Hakyll.Core.Compiler import Hakyll.Core.Compiler.Internal import Hakyll.Core.Identifier import Hakyll.Core.Item -import Hakyll.Core.Provider import Hakyll.Core.Writable import Hakyll.Web.Pandoc -import Hakyll.Web.Pandoc.Binary () -import qualified Text.CSL as CSL -import Text.CSL.Pandoc (processCites) -import Text.Pandoc (Pandoc, ReaderOptions (..), - enableExtension, Extension (..)) +import Text.Pandoc (Extension (..), Pandoc, + ReaderOptions (..), + enableExtension) +import qualified Text.Pandoc as Pandoc +import qualified Text.Pandoc.Citeproc as Pandoc (processCitations) -------------------------------------------------------------------------------- -data CSL = CSL - deriving (Show, Typeable) +newtype CSL = CSL {unCSL :: B.ByteString} + deriving (Binary, Show, Typeable) --------------------------------------------------------------------------------- -instance Binary CSL where - put CSL = return () - get = return CSL - -------------------------------------------------------------------------------- instance Writable CSL where @@ -59,21 +58,12 @@ instance Writable CSL where -------------------------------------------------------------------------------- cslCompiler :: Compiler (Item CSL) -cslCompiler = makeItem CSL - - --------------------------------------------------------------------------------- -newtype Biblio = Biblio [CSL.Reference] - deriving (Show, Typeable) +cslCompiler = fmap (CSL . BL.toStrict) <$> getResourceLBS -------------------------------------------------------------------------------- -instance Binary Biblio where - -- Ugly. - get = do - len <- get - Biblio <$> replicateM len get - put (Biblio rs) = put (length rs) >> mapM_ put rs +newtype Biblio = Biblio {unBiblio :: B.ByteString} + deriving (Binary, Show, Typeable) -------------------------------------------------------------------------------- @@ -84,12 +74,7 @@ instance Writable Biblio where -------------------------------------------------------------------------------- biblioCompiler :: Compiler (Item Biblio) -biblioCompiler = do - filePath <- getResourceFilePath - makeItem =<< unsafeCompiler (Biblio <$> CSL.readBiblioFile idpred filePath) - where - -- This is a filter on citations. We include all citations. - idpred = const True +biblioCompiler = fmap (Biblio . BL.toStrict) <$> getResourceLBS -------------------------------------------------------------------------------- @@ -99,19 +84,42 @@ readPandocBiblio :: ReaderOptions -> (Item String) -> Compiler (Item Pandoc) readPandocBiblio ropt csl biblio item = do - -- Parse CSL file, if given - provider <- compilerProvider <$> compilerAsk - style <- unsafeCompiler $ - CSL.readCSLFile Nothing . (resourceFilePath provider) . itemIdentifier $ csl - - -- We need to know the citation keys, add then *before* actually parsing the - -- actual page. If we don't do this, pandoc won't even consider them - -- citations! - let Biblio refs = itemBody biblio - pandoc <- itemBody <$> readPandocWith ropt item - let pandoc' = processCites style refs pandoc - - return $ fmap (const pandoc') item + -- It's not straightforward to use the Pandoc API as of 2.11 to deal with + -- citations, since it doesn't export many things in 'Text.Pandoc.Citeproc'. + -- The 'citeproc' package is also hard to use. + -- + -- So instead, we try treating Pandoc as a black box. Pandoc can read + -- specific csl and bilbio files based on metadata keys. + -- + -- So we load the CSL and Biblio files and pass them to Pandoc using the + -- ersatz filesystem. + Pandoc.Pandoc (Pandoc.Meta meta) blocks <- itemBody <$> + readPandocWith ropt item + + let cslFile = Pandoc.FileInfo zeroTime . unCSL $ itemBody csl + bibFile = Pandoc.FileInfo zeroTime . unBiblio $ itemBody biblio + addBiblioFiles = \st -> st + { Pandoc.stFiles = + Pandoc.insertInFileTree "_hakyll/style.csl" cslFile . + Pandoc.insertInFileTree "_hakyll/refs.bib" bibFile $ + Pandoc.stFiles st + } + biblioMeta = Pandoc.Meta . + Map.insert "csl" (Pandoc.MetaString "_hakyll/style.csl") . + Map.insert "bibliography" (Pandoc.MetaString "_hakyll/refs.bib") $ + meta + errOrPandoc = Pandoc.runPure $ do + Pandoc.modifyPureState addBiblioFiles + Pandoc.processCitations $ Pandoc.Pandoc biblioMeta blocks + + pandoc <- case errOrPandoc of + Left e -> compilerThrow ["Error during processCitations: " ++ show e] + Right x -> return x + + return $ fmap (const pandoc) item + + where + zeroTime = Time.UTCTime (toEnum 0) 0 -------------------------------------------------------------------------------- pandocBiblioCompiler :: String -> String -> Compiler (Item String) diff --git a/lib/Hakyll/Web/Pandoc/Binary.hs b/lib/Hakyll/Web/Pandoc/Binary.hs index 5d3efea..3f7f4fb 100644 --- a/lib/Hakyll/Web/Pandoc/Binary.hs +++ b/lib/Hakyll/Web/Pandoc/Binary.hs @@ -4,9 +4,6 @@ module Hakyll.Web.Pandoc.Binary where import Data.Binary (Binary (..)) -import qualified Text.CSL as CSL -import qualified Text.CSL.Reference as REF -import qualified Text.CSL.Style as STY import Text.Pandoc -------------------------------------------------------------------------------- @@ -18,7 +15,6 @@ instance Binary Caption instance Binary Cell instance Binary ColSpan instance Binary ColWidth -instance Binary CSL.Reference instance Binary Citation instance Binary CitationMode instance Binary Format @@ -27,17 +23,9 @@ instance Binary ListNumberDelim instance Binary ListNumberStyle instance Binary MathType instance Binary QuoteType -instance Binary REF.CLabel -instance Binary REF.CNum -instance Binary REF.Literal -instance Binary REF.RefDate -instance Binary REF.RefType -instance Binary REF.Season instance Binary Row instance Binary RowHeadColumns instance Binary RowSpan -instance Binary STY.Agent -instance Binary STY.Formatted instance Binary TableBody instance Binary TableFoot instance Binary TableHead diff --git a/stack.yaml b/stack.yaml index 63ee6a4..7820738 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,5 +1,7 @@ resolver: lts-16.21 save-hackage-creds: false +system-ghc: true +skip-ghc-check: true flags: hakyll: @@ -23,10 +25,15 @@ build: haddock-deps: false extra-deps: -- 'commonmark-0.1.0.2' -- 'commonmark-extensions-0.2.0.1' +- 'citeproc-0.2' +- 'commonmark-0.1.1.2' +- 'commonmark-extensions-0.2.0.4' - 'commonmark-pandoc-0.2.0.1' -- 'hslua-1.1.2' +- 'hslua-1.3.0' +- 'hslua-module-text-0.3.0.1' - 'jira-wiki-markup-1.3.2' -- 'pandoc-2.10.1' -- 'pandoc-types-1.21' +- 'pandoc-2.11.2' +- 'pandoc-types-1.22' +- 'rfc5051-0.2' +- 'skylighting-0.10.1' +- 'skylighting-core-0.10.1' diff --git a/stack.yaml.lock b/stack.yaml.lock index 8636225..caab7e9 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -5,19 +5,26 @@ packages: - completed: - hackage: commonmark-0.1.0.2@sha256:fbff7a2ade0ce7d699964a87f765e503a3a9e22542c05f0f02ba7aad64e38af4,3278 + hackage: citeproc-0.2@sha256:72a6b976a1d3ff2107043cfeb942e278ce2b93f0e31752da86bc6431b862ae19,5431 + pantry-tree: + size: 78527 + sha256: 1dd0f1ee7bc43367fbb745ba859ad6e2eb3b8d16d515c47deba31a5bd09bc0e2 + original: + hackage: citeproc-0.2 +- completed: + hackage: commonmark-0.1.1.2@sha256:c06ab05f0f224ab7982502a96e17952823a9b6dae8505fb35194b0baa9e2a975,3278 pantry-tree: size: 1346 - sha256: 991da6da60804286b9ea23a1522e18ceeabddfdf416787231db9fd047c163f53 + sha256: 6a187bbbfaf61b4b1bf87ee5027e7edb5b7157ad3380982b07b876e9a60cd63d original: - hackage: commonmark-0.1.0.2 + hackage: commonmark-0.1.1.2 - completed: - hackage: commonmark-extensions-0.2.0.1@sha256:647aa8dba5fd46984ddedc15c3693c9c4d9655503d42006576bd8f0dadf8cd39,3176 + hackage: commonmark-extensions-0.2.0.4@sha256:6a437bcfa3c757af4262b71336513619990eafb5cfdc33e57a499c93ad225608,3184 pantry-tree: - size: 2927 - sha256: 89e1ee05938d558834c397a3a22cdacc755a1941c144f4c1f3daf8a1ede943ce + size: 2928 + sha256: ac8993e356edabc65a40d6c6909696c5f2dfe2a5298089da820c29ca75852360 original: - hackage: commonmark-extensions-0.2.0.1 + hackage: commonmark-extensions-0.2.0.4 - completed: hackage: commonmark-pandoc-0.2.0.1@sha256:529c6e2c6cabf61558b66a28123eafc1d90d3324be29819f59f024e430312c1f,1105 pantry-tree: @@ -26,12 +33,19 @@ packages: original: hackage: commonmark-pandoc-0.2.0.1 - completed: - hackage: hslua-1.1.2@sha256:6c231b2af447430d1ed04f065d40bb6882ece93cc7f32f4051dc99deb69beeae,9694 + hackage: hslua-1.3.0@sha256:d9b758f6234286a7df267cae15332507a1d3be56baf03ff7ae073269bc55c4e8,11023 + pantry-tree: + size: 7716 + sha256: e2cc992f8ea4781718386c3c0def49f04be96b4b0c459b629df555b0c045efc2 + original: + hackage: hslua-1.3.0 +- completed: + hackage: hslua-module-text-0.3.0.1@sha256:e245d7bf9746101664dcde9c33b1c8cd792d404fddb8d9346ae6abb6b971dd93,1741 pantry-tree: - size: 6820 - sha256: 62e61f6d08191159a070dcbaa20284a581835de620105a254dbee1c7ddfabd9d + size: 415 + sha256: 70932f637ef2a81024d43270f3b28ce870d7b43c405fb399d51d07f170da76ea original: - hackage: hslua-1.1.2 + hackage: hslua-module-text-0.3.0.1 - completed: hackage: jira-wiki-markup-1.3.2@sha256:b5f0901208a0ee07aff60f5356aeb851b7aa7950c75a18a15fd34247a35886d8,3819 pantry-tree: @@ -40,19 +54,40 @@ packages: original: hackage: jira-wiki-markup-1.3.2 - completed: - hackage: pandoc-2.10.1@sha256:23d7ec480c7cb86740475a419d6ca4819987b6dd23bbae9b50bc3d42a7ed2f9f,36933 + hackage: pandoc-2.11.2@sha256:e21f0af1750c4d7a3cf9096c46403c55043c9ac06c7c37627ecb312499eb3136,39349 + pantry-tree: + size: 114848 + sha256: ef31f41960bd8ae1a1b02b2c56a692583398f2cb3fc7c0177583b698a6a60fdf + original: + hackage: pandoc-2.11.2 +- completed: + hackage: pandoc-types-1.22@sha256:15512ce011555ee720820f11cac0598317293406da5812337cbb1550d144e3bd,4071 + pantry-tree: + size: 737 + sha256: 28e43150f4bb0d4d880cf92ade20fefcd8705ee95cfe4a1d0bb5efd320982a9d + original: + hackage: pandoc-types-1.22 +- completed: + hackage: rfc5051-0.2@sha256:da5d77731f2ac6fe313a67919419b0833e09cd7f1a81869ed82a54dbf8962bf2,1678 + pantry-tree: + size: 446 + sha256: 191a30a13590a14dc8f606ff945298fee6afbb093a49bc5db71dbaf066f01930 + original: + hackage: rfc5051-0.2 +- completed: + hackage: skylighting-0.10.1@sha256:69f9175c606289164347a2ae1507218bf0c2479a1ed93356d24e83e4097ef493,10031 pantry-tree: - size: 89646 - sha256: 08c8b20356152b9ee8161bacafda2dc1bed13d7db4cbf38ab040c1977b2d28d5 + size: 10837 + sha256: 5b5516a196a75c6dffb33c3c9227d743d3c48e3d659fb7aad2cc01609e1e3a1f original: - hackage: pandoc-2.10.1 + hackage: skylighting-0.10.1 - completed: - hackage: pandoc-types-1.21@sha256:b61ed625da4d1a0d8057fcca4c0c5e174c9f45d94b41504db1532f3fc581e945,4037 + hackage: skylighting-core-0.10.1@sha256:da0b01c22322f1312e9a5e37343f2153a3a8ba65a3d88ef51cf9b1360c466e08,8159 pantry-tree: - size: 713 - sha256: e26eb93747538e29168032985a03b428039a16000fea1a4a8d9b9b032ac98b5f + size: 13517 + sha256: 48673ab1725d2aa6c019bb8a7d1419002d9a86a5dd54e2745b9d78846d793b29 original: - hackage: pandoc-types-1.21 + hackage: skylighting-core-0.10.1 snapshots: - completed: size: 532413 -- cgit v1.2.3 From ef1bad68d6e9d62da7a1115a7d75bad689b62817 Mon Sep 17 00:00:00 2001 From: Chris Jensen Date: Tue, 29 Dec 2020 17:07:28 +0000 Subject: Add documentation for the pandocBiblioCompiler (#828) * Add documentation for pandoc * Fix grammar --- lib/Hakyll/Web/Pandoc/Biblio.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'lib/Hakyll/Web') diff --git a/lib/Hakyll/Web/Pandoc/Biblio.hs b/lib/Hakyll/Web/Pandoc/Biblio.hs index 567f478..566c706 100644 --- a/lib/Hakyll/Web/Pandoc/Biblio.hs +++ b/lib/Hakyll/Web/Pandoc/Biblio.hs @@ -122,6 +122,7 @@ readPandocBiblio ropt csl biblio item = do zeroTime = Time.UTCTime (toEnum 0) 0 -------------------------------------------------------------------------------- +-- | Compiles a markdown file via Pandoc. Requires the .csl and .bib files to be known to the compiler via match statements. pandocBiblioCompiler :: String -> String -> Compiler (Item String) pandocBiblioCompiler cslFileName bibFileName = do csl <- load $ fromFilePath cslFileName -- cgit v1.2.3 From b54212c7e2b8a84f95815e93a13223e1525c4f85 Mon Sep 17 00:00:00 2001 From: Norman Liu <57917002+dreamsmasher@users.noreply.github.com> Date: Thu, 11 Mar 2021 16:38:21 -0500 Subject: Add `renderPandocWithTransform` and `renderPandocWithTransformM` * added function that allows for pre-pandoc transformations * modified haddock docstring * refactoring to avoid importing the kleisli fish * Renamed `applyPandoc` to `renderPandocWithTransformM`, added non-monadic variant. Exported previous new functions that I forgot to export. --- lib/Hakyll/Web/Pandoc.hs | 33 ++++++++++++++++++++++++++++++--- 1 file changed, 30 insertions(+), 3 deletions(-) (limited to 'lib/Hakyll/Web') diff --git a/lib/Hakyll/Web/Pandoc.hs b/lib/Hakyll/Web/Pandoc.hs index 5f04de4..372465b 100644 --- a/lib/Hakyll/Web/Pandoc.hs +++ b/lib/Hakyll/Web/Pandoc.hs @@ -8,6 +8,8 @@ module Hakyll.Web.Pandoc , writePandocWith , renderPandoc , renderPandocWith + , renderPandocWithTransform + , renderPandocWithTransformM -- * Derived compilers , pandocCompiler @@ -103,6 +105,32 @@ renderPandocWith ropt wopt item = writePandocWith wopt <$> readPandocWith ropt item +-------------------------------------------------------------------------------- +-- | An extension of `renderPandocWith`, which allows you to specify a custom +-- Pandoc transformation on the input `Item`. +-- Useful if you want to do your own transformations before running +-- custom Pandoc transformations, e.g. using a `funcField` to transform raw content. +renderPandocWithTransform :: ReaderOptions -> WriterOptions + -> (Pandoc -> Pandoc) + -> Item String + -> Compiler (Item String) +renderPandocWithTransform ropt wopt f = + renderPandocWithTransformM ropt wopt (return . f) + + +-------------------------------------------------------------------------------- +-- | Similar to `renderPandocWithTransform`, but the Pandoc transformation is +-- monadic. This is useful when you want the pandoc +-- transformation to use the `Compiler` information such as routes, +-- metadata, etc. along with your own transformations beforehand. +renderPandocWithTransformM :: ReaderOptions -> WriterOptions + -> (Pandoc -> Compiler Pandoc) + -> Item String + -> Compiler (Item String) +renderPandocWithTransformM ropt wopt f i = + writePandocWith wopt <$> (traverse f =<< readPandocWith ropt i) + + -------------------------------------------------------------------------------- -- | Read a page render using pandoc pandocCompiler :: Compiler (Item String) @@ -137,9 +165,8 @@ pandocCompilerWithTransform ropt wopt f = pandocCompilerWithTransformM :: ReaderOptions -> WriterOptions -> (Pandoc -> Compiler Pandoc) -> Compiler (Item String) -pandocCompilerWithTransformM ropt wopt f = - writePandocWith wopt <$> - (traverse f =<< readPandocWith ropt =<< getResourceBody) +pandocCompilerWithTransformM ropt wopt f = + getResourceBody >>= renderPandocWithTransformM ropt wopt f -------------------------------------------------------------------------------- -- cgit v1.2.3 From 6d9bc845d5233c67e5eba3f54dcc7772ca1d79e2 Mon Sep 17 00:00:00 2001 From: Logan McGrath <81108848+ThisFieldWasGreen@users.noreply.github.com> Date: Sun, 6 Jun 2021 10:50:44 -0700 Subject: Allow demotion of headers by a given amount (#855) --- lib/Hakyll/Web/Html.hs | 12 ++++++++++-- tests/Hakyll/Web/Html/Tests.hs | 13 ++++++++++++- 2 files changed, 22 insertions(+), 3 deletions(-) (limited to 'lib/Hakyll/Web') 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" [ "

A h1 title

" @=? - demoteHeaders "

A h1 title

" + demoteHeaders "

A h1 title

" -- Assert single-step demotion + , "
A h6 title
" @=? + demoteHeaders "
A h6 title
" -- Assert maximum demotion is h6 + ] + + , fromAssertions "demoteHeadersBy" + [ "

A h1 title

" @=? + demoteHeadersBy 2 "

A h1 title

" + , "
A h5 title
" @=? + demoteHeadersBy 2 "
A h5 title
" -- Assert that h6 is the lowest possible demoted header. + , "

A h4 title

" @=? + demoteHeadersBy 0 "

A h4 title

" -- Assert that a demotion of @N < 1@ is a no-op. ] , fromAssertions "withUrls" -- cgit v1.2.3 From d739fd1eea40de9ded3b4f682c849d3c31eba92c Mon Sep 17 00:00:00 2001 From: Jim McStanton Date: Fri, 16 Jul 2021 14:13:43 -0500 Subject: Supporting different field names for tags. (#862) * Supporting different field names for tags. * Removed buildTagsByField Removed to avoid exponential growth of helper functions. Renamed field parameter in getTagsByField to fieldName to avoid shadowing. * Drop obsolete export Co-authored-by: Alexander Batischev --- lib/Hakyll/Web/Tags.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) (limited to 'lib/Hakyll/Web') diff --git a/lib/Hakyll/Web/Tags.hs b/lib/Hakyll/Web/Tags.hs index aab5d34..ccf34a5 100644 --- a/lib/Hakyll/Web/Tags.hs +++ b/lib/Hakyll/Web/Tags.hs @@ -43,6 +43,7 @@ module Hakyll.Web.Tags ( Tags (..) , getTags + , getTagsByField , getCategory , buildTagsWith , buildTags @@ -105,11 +106,16 @@ data Tags = Tags -- | Obtain tags from a page in the default way: parse them from the @tags@ -- metadata field. This can either be a list or a comma-separated string. getTags :: MonadMetadata m => Identifier -> m [String] -getTags identifier = do +getTags = getTagsByField "tags" + +-- | Obtain tags from a page by name of the metadata field. These can be a list +-- or a comma-separated string +getTagsByField :: MonadMetadata m => String -> Identifier -> m [String] +getTagsByField fieldName identifier = do metadata <- getMetadata identifier return $ fromMaybe [] $ - (lookupStringList "tags" metadata) `mplus` - (map trim . splitAll "," <$> lookupString "tags" metadata) + (lookupStringList fieldName metadata) `mplus` + (map trim . splitAll "," <$> lookupString fieldName metadata) -------------------------------------------------------------------------------- -- cgit v1.2.3