diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,10 +4,16 @@ # Releases +## Hakyll 4.16.7.0 (2025-08-29) + +- Validate the output of XML-based feed functions such as `renderRss` by default (#1078). +- Bump `containers` upper bound to include 0.8. +- Add support for Typst (#1067). + ## Hakyll 4.16.6.0 (2025-02-18) -- Do not crawl directories for which we do not have permissions - with `Hakyll.Core.Util.File.getRecursiveContents`. This used to +- Do not crawl directories for which we do not have permissions + with `Hakyll.Core.Util.File.getRecursiveContents`. This used to throw an exception. - Do not return broken symbolic links from `Hakyll.Core.Util.File.getRecursiveContents`. This used to cause diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 4.16.6.0 +Version: 4.16.7.0 Synopsis: A static website compiler library Description: @@ -191,7 +191,7 @@ binary >= 0.5 && < 0.10, blaze-html >= 0.5 && < 0.10, bytestring >= 0.9 && < 0.13, - containers >= 0.3 && < 0.8, + containers >= 0.3 && < 0.9, data-default >= 0.4 && < 0.9, deepseq >= 1.3 && < 1.6, directory >= 1.2.7.0 && < 1.4, @@ -201,7 +201,7 @@ lrucache >= 1.1.1 && < 1.3, mtl >= 1 && < 2.4, network-uri >= 2.6 && < 2.7, - optparse-applicative >= 0.12 && < 0.19, + optparse-applicative >= 0.12 && < 0.20, parsec >= 3.0 && < 3.2, process >= 1.6 && < 1.7, random >= 1.0 && < 1.4, @@ -215,7 +215,8 @@ time-locale-compat >= 0.1 && < 0.2, vector >= 0.11 && < 0.14, wai-app-static >= 3.1 && < 3.2, - yaml >= 0.8.11 && < 0.12 + yaml >= 0.8.11 && < 0.12, + xml-conduit >= 1.0 && < 1.11 If flag(previewServer) Build-depends: @@ -252,7 +253,7 @@ Other-Modules: Hakyll.Web.Pandoc.Binary Build-Depends: - pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.7, + pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.8, pandoc-types >= 1.22 && < 1.24 Cpp-options: -DUSE_PANDOC @@ -281,11 +282,12 @@ Hakyll.Web.Tags.Tests Hakyll.Web.Template.Context.Tests Hakyll.Web.Template.Tests + Hakyll.Web.Feed.Tests TestSuite.Util Build-Depends: hakyll, - QuickCheck >= 2.8 && < 2.16, + QuickCheck >= 2.8 && < 2.17, tasty >= 0.11 && < 1.6, tasty-golden >= 2.3 && < 2.4, tasty-hunit >= 0.9 && < 0.11, @@ -294,7 +296,7 @@ aeson >= 1.0 && < 1.6 || >= 2.0 && < 2.3, base >= 4.12 && < 5, bytestring >= 0.9 && < 0.13, - containers >= 0.3 && < 0.8, + containers >= 0.3 && < 0.9, filepath >= 1.0 && < 1.6, tagsoup >= 0.13.1 && < 0.15, yaml >= 0.8.11 && < 0.12 @@ -318,7 +320,7 @@ Cpp-options: -DUSE_PANDOC Build-Depends: - pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.7, + pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.8, pandoc-types >= 1.22 && < 1.24 @@ -353,5 +355,5 @@ base >= 4.12 && < 5, directory >= 1.0 && < 1.4, filepath >= 1.0 && < 1.6, - pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.7, + pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.8, pandoc-types >= 1.22 && < 1.24 diff --git a/lib/Hakyll/Core/Util/String.hs b/lib/Hakyll/Core/Util/String.hs --- a/lib/Hakyll/Core/Util/String.hs +++ b/lib/Hakyll/Core/Util/String.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-} -------------------------------------------------------------------------------- -- | Miscellaneous string manipulation functions. module Hakyll.Core.Util.String @@ -13,7 +13,6 @@ -------------------------------------------------------------------------------- import Data.Char (isSpace) import Data.List (isPrefixOf) -import Data.Maybe (listToMaybe) import Text.Regex.TDFA ((=~~)) @@ -33,12 +32,10 @@ -> String -- ^ Result replaceAll pattern f source = replaceAll' source where - replaceAll' src = case listToMaybe (src =~~ pattern) of - Nothing -> src - Just (o, l) -> - let (before, tmp) = splitAt o src - (capture, after) = splitAt l tmp - in before ++ f capture ++ replaceAll' after + replaceAll' "" = "" + replaceAll' src = case src =~~ pattern of + Nothing -> src + Just (before, capture, after) -> before ++ f capture ++ replaceAll' after -------------------------------------------------------------------------------- @@ -49,11 +46,10 @@ -> [String] -- ^ Result splitAll pattern = filter (not . null) . splitAll' where - splitAll' src = case listToMaybe (src =~~ pattern) of - Nothing -> [src] - Just (o, l) -> - let (before, tmp) = splitAt o src - in before : splitAll' (drop l tmp) + splitAll' "" = [] + splitAll' src = case src =~~ pattern of + Nothing -> [src] + Just (before, _::String, after) -> before : splitAll' after diff --git a/lib/Hakyll/Web/Feed.hs b/lib/Hakyll/Web/Feed.hs --- a/lib/Hakyll/Web/Feed.hs +++ b/lib/Hakyll/Web/Feed.hs @@ -19,30 +19,44 @@ -- -- In addition, the posts should be named according to the rules for -- 'Hakyll.Web.Template.Context.dateField' +-- +-- Note that for XML-based feeds (i.e. Atom and RSS) field values are not escaped! +-- However, the default 'renderRss' and 'renderAtom' functions will validate the +-- produced XML. Use the -NoValidate functions instead if you need to skip this +-- validation. module Hakyll.Web.Feed ( FeedConfiguration (..) , renderRss + , renderRssNoValidate , renderAtom + , renderAtomNoValidate , renderJson , renderRssWithTemplates + , renderRssWithTemplatesNoValidate , renderAtomWithTemplates + , renderAtomWithTemplatesNoValidate , renderJsonWithTemplates + , validateXMLFeed ) where -------------------------------------------------------------------------------- import Hakyll.Core.Compiler +import Hakyll.Core.Compiler.Internal (compilerThrow) import Hakyll.Core.Item -import Hakyll.Core.Util.String (replaceAll) +import Hakyll.Core.Util.String (replaceAll) import Hakyll.Web.Template import Hakyll.Web.Template.Context import Hakyll.Web.Template.List -------------------------------------------------------------------------------- -import Data.FileEmbed (makeRelativeToProject) -import System.FilePath (()) -import Text.Printf (printf) +import Data.FileEmbed (makeRelativeToProject) +import System.FilePath (()) +import Text.Printf (printf) +import Control.Exception (displayException) +import Text.XML (parseText, def) +import qualified Data.Text.Lazy as T -------------------------------------------------------------------------------- @@ -161,35 +175,89 @@ XmlFeed -> id JsonFeed -> mapContextBy (== "description") escapeString + -------------------------------------------------------------------------------- +-- | Validate that a feed contains only correct XML. +validateXMLFeed :: Item String -> Compiler (Item String) +validateXMLFeed rendered = case parseText def $ T.pack (itemBody rendered) of + Right _ -> pure rendered + Left err -> compilerThrow + ["Generated feed contains invalid XML (perhaps you id not escape a metadata field?)", + displayException err] + + +-------------------------------------------------------------------------------- -- | Render an RSS feed using given templates with a number of items. -renderRssWithTemplates :: +-- +-- The resulting feed will not be validated. Prefer to use 'renderRssWithTemplates' +-- when possible. +-- +-- @since 4.16.7.0 +renderRssWithTemplatesNoValidate :: Template -- ^ Feed template -> Template -- ^ Item template -> FeedConfiguration -- ^ Feed configuration -> Context String -- ^ Item context -> [Item String] -- ^ Feed items -> Compiler (Item String) -- ^ Resulting feed -renderRssWithTemplates feedTemplate itemTemplate config context = renderFeed +renderRssWithTemplatesNoValidate feedTemplate itemTemplate config context = renderFeed XmlFeed feedTemplate itemTemplate config (makeItemContext "%a, %d %b %Y %H:%M:%S UT" context) -------------------------------------------------------------------------------- +-- | Render an RSS feed using given templates with a number of items. +-- +-- The resulting RSS feed will be validated automatically. +renderRssWithTemplates :: + Template -- ^ Feed template + -> Template -- ^ Item template + -> FeedConfiguration -- ^ Feed configuration + -> Context String -- ^ Item context + -> [Item String] -- ^ Feed items + -> Compiler (Item String) -- ^ Resulting feed +renderRssWithTemplates feedTemplate itemTemplate config context items = + renderRssWithTemplatesNoValidate feedTemplate itemTemplate config context items + >>= validateXMLFeed + + +-------------------------------------------------------------------------------- -- | Render an Atom feed using given templates with a number of items. -renderAtomWithTemplates :: +-- +-- The resulting feed will not be validated. Prefer to use 'renderAtomWithTemplates' +-- when possible. +-- +-- @since 4.16.7.0 +renderAtomWithTemplatesNoValidate :: Template -- ^ Feed template -> Template -- ^ Item template -> FeedConfiguration -- ^ Feed configuration -> Context String -- ^ Item context -> [Item String] -- ^ Feed items -> Compiler (Item String) -- ^ Resulting feed -renderAtomWithTemplates feedTemplate itemTemplate config context = renderFeed +renderAtomWithTemplatesNoValidate feedTemplate itemTemplate config context items = renderFeed XmlFeed feedTemplate itemTemplate config (makeItemContext "%Y-%m-%dT%H:%M:%SZ" context) + items -------------------------------------------------------------------------------- +-- | Render an Atom feed using given templates with a number of items. +-- +-- The resulting Atom feed will be validated automatically. +renderAtomWithTemplates :: + Template -- ^ Feed template + -> Template -- ^ Item template + -> FeedConfiguration -- ^ Feed configuration + -> Context String -- ^ Item context + -> [Item String] -- ^ Feed items + -> Compiler (Item String) -- ^ Resulting feed +renderAtomWithTemplates feedTemplate itemTemplate config context items = + renderAtomWithTemplatesNoValidate feedTemplate itemTemplate config context items + >>= validateXMLFeed + + +-------------------------------------------------------------------------------- -- | Render a JSON feed using given templates with a number of items. renderJsonWithTemplates :: Template -- ^ Feed template @@ -205,20 +273,54 @@ -------------------------------------------------------------------------------- -- | Render an RSS feed with a number of items. +-- +-- The resulting feed will not be validated. Prefer to use 'renderRss' +-- when possible. +-- +-- @since 4.16.7.0 +renderRssNoValidate :: FeedConfiguration -- ^ Feed configuration + -> Context String -- ^ Item context + -> [Item String] -- ^ Feed items + -> Compiler (Item String) -- ^ Resulting feed +renderRssNoValidate = renderRssWithTemplatesNoValidate rssTemplate rssItemTemplate + + +-------------------------------------------------------------------------------- +-- | Render an RSS feed with a number of items. +-- +-- The resulting RSS feed will be validated automatically. renderRss :: FeedConfiguration -- ^ Feed configuration -> Context String -- ^ Item context -> [Item String] -- ^ Feed items -> Compiler (Item String) -- ^ Resulting feed -renderRss = renderRssWithTemplates rssTemplate rssItemTemplate +renderRss config context items = renderRssNoValidate config context items + >>= validateXMLFeed -------------------------------------------------------------------------------- -- | Render an Atom feed with a number of items. +-- +-- The resulting feed will not be validated. Prefer to use 'renderAtom' +-- when possible. +-- +-- @since 4.16.7.0 +renderAtomNoValidate :: FeedConfiguration -- ^ Feed configuration + -> Context String -- ^ Item context + -> [Item String] -- ^ Feed items + -> Compiler (Item String) -- ^ Resulting feed +renderAtomNoValidate = renderAtomWithTemplatesNoValidate atomTemplate atomItemTemplate + + +-------------------------------------------------------------------------------- +-- | Render an Atom feed with a number of items. +-- +-- The resulting Atom feed will be validated automatically. renderAtom :: FeedConfiguration -- ^ Feed configuration -> Context String -- ^ Item context -> [Item String] -- ^ Feed items -> Compiler (Item String) -- ^ Resulting feed -renderAtom = renderAtomWithTemplates atomTemplate atomItemTemplate +renderAtom config context items = renderAtomNoValidate config context items + >>= validateXMLFeed -------------------------------------------------------------------------------- diff --git a/lib/Hakyll/Web/Pandoc.hs b/lib/Hakyll/Web/Pandoc.hs --- a/lib/Hakyll/Web/Pandoc.hs +++ b/lib/Hakyll/Web/Pandoc.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -------------------------------------------------------------------------------- -- | Module exporting convenient pandoc bindings module Hakyll.Web.Pandoc @@ -67,6 +68,11 @@ MediaWiki -> readMediaWiki ro OrgMode -> readOrg ro Rst -> readRST ro +-- This preprocessing instruction can be dropped +-- once the minimum supported GHC version is 8.10 +#if MIN_VERSION_pandoc(3,1,3) + Typst -> readTypst ro +#endif Textile -> readTextile ro _ -> error $ "Hakyll.Web.readPandocWith: I don't know how to read a file of " ++ diff --git a/lib/Hakyll/Web/Pandoc/FileType.hs b/lib/Hakyll/Web/Pandoc/FileType.hs --- a/lib/Hakyll/Web/Pandoc/FileType.hs +++ b/lib/Hakyll/Web/Pandoc/FileType.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -------------------------------------------------------------------------------- -- | A module dealing with pandoc file extensions and associated file types module Hakyll.Web.Pandoc.FileType @@ -33,6 +34,11 @@ | PlainText | Rst | Textile +-- This preprocessing instruction can be dropped +-- once the minimum supported GHC version is 8.10 +#if MIN_VERSION_pandoc(3,1,3) + | Typst +#endif deriving (Eq, Ord, Show, Read) @@ -66,6 +72,11 @@ fileType' _ ".text" = PlainText fileType' _ ".textile" = Textile fileType' _ ".txt" = PlainText +-- This preprocessing instruction can be dropped +-- once the minimum supported GHC version is 8.10 +#if MIN_VERSION_pandoc(3,1,3) + fileType' _ ".typ" = Typst +#endif fileType' _ ".wiki" = MediaWiki fileType' _ _ = Binary -- Treat unknown files as binary diff --git a/tests/Hakyll/Core/Util/String/Tests.hs b/tests/Hakyll/Core/Util/String/Tests.hs --- a/tests/Hakyll/Core/Util/String/Tests.hs +++ b/tests/Hakyll/Core/Util/String/Tests.hs @@ -22,11 +22,23 @@ ] , fromAssertions "replaceAll" - [ "32 & 131" @=? replaceAll "0x[0-9]+" (show . readInt) "0x20 & 0x83" + [ "foo-end" @=? replaceAll "begin" (const "foo") "begin-end" + , "begin-foo" @=? replaceAll "end" (const "foo") "begin-end" + , "no match" @=? replaceAll "abc" (const "foo") "no match" + , "foo" @=? replaceAll ".*" (const "foo") "full match" + , "empty pattern" @=? replaceAll "" (const "foo") "empty pattern" + , "" @=? replaceAll "empty input" (const "foo") "" + , "32 & 131" @=? replaceAll "0x[0-9]+" (show . readInt) "0x20 & 0x83" ] , fromAssertions "splitAll" - [ ["λ", "∀x.x", "hi"] @=? splitAll ", *" "λ, ∀x.x, hi" + [ ["a", "b", "c"] @=? splitAll "," "a,,b,,,c,," + , ["abc", "def"] @=? splitAll "[0-9]+" "abc123def456" + , ["no match"] @=? splitAll "," "no match" + , [] @=? splitAll ".*" "full match" + , ["empty pattern"] @=? splitAll "" "empty pattern" + , [] @=? splitAll "empty input" "" + , ["λ", "∀x.x", "hi"] @=? splitAll ", *" "λ, ∀x.x, hi" ] , fromAssertions "needlePrefix" diff --git a/tests/Hakyll/Web/Feed/Tests.hs b/tests/Hakyll/Web/Feed/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Hakyll/Web/Feed/Tests.hs @@ -0,0 +1,68 @@ +-------------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings #-} +module Hakyll.Web.Feed.Tests + ( tests + ) where + + +-------------------------------------------------------------------------------- +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (Assertion, testCase) + + +-------------------------------------------------------------------------------- +import Hakyll.Core.Compiler +import Hakyll.Core.Provider +import Hakyll.Web.Feed +import Hakyll.Web.Template.Context +import TestSuite.Util +-------------------------------------------------------------------------------- +tests :: TestTree +tests = testGroup "Hakyll.Web.Feed.Tests" + [ testCase "validateSucceeds" validateSucceeds + , testCase "validateFails" validateFails + ] + +validateFails :: Assertion +validateFails = do + store <- newTestStore + provider <- newTestProvider store + + item <- testCompilerDone store provider "example.md" + $ makeItem (resourceFilePath provider "example.md") + + testCompilerError store provider "feed.xml" + (renderRss feedConfiguration ctx [item]) + "Generated feed contains invalid XML (perhaps you id not escape a metadata field?)" + cleanTestEnv + where + title = "invalid & not xml" + ctx = constField "title" title `mappend` + constField "description" "" `mappend` + defaultContext + +validateSucceeds :: Assertion +validateSucceeds = do + store <- newTestStore + provider <- newTestProvider store + + item <- testCompilerDone store provider "example.md" + $ makeItem (resourceFilePath provider "example.md") + + _ <- testCompilerDone store provider "feed.xml" + $ renderRss feedConfiguration ctx [item] + cleanTestEnv + where + title = "valid xml" + ctx = constField "title" title `mappend` + constField "description" "" `mappend` + defaultContext + +feedConfiguration :: FeedConfiguration +feedConfiguration = FeedConfiguration + { feedTitle = "test" + , feedDescription = "test" + , feedAuthorName = "test" + , feedAuthorEmail = "" + , feedRoot = "example.org" + } diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -30,6 +30,7 @@ import qualified Hakyll.Web.Template.Context.Tests import qualified Hakyll.Web.Template.Tests import qualified Hakyll.Web.Tags.Tests +import qualified Hakyll.Web.Feed.Tests -------------------------------------------------------------------------------- @@ -55,4 +56,5 @@ , Hakyll.Web.Tags.Tests.tests , Hakyll.Web.Template.Context.Tests.tests , Hakyll.Web.Template.Tests.tests + , Hakyll.Web.Feed.Tests.tests ] diff --git a/web/site.hs b/web/site.hs --- a/web/site.hs +++ b/web/site.hs @@ -68,9 +68,8 @@ -------------------------------------------------------------------------------- config :: Configuration config = defaultConfiguration - { deployCommand = "rsync --checksum -ave 'ssh -p 2222' \ - \_site/* \ - \jaspervdj@jaspervdj.be:jaspervdj.be/hakyll/" + { deployCommand = + "rsync --checksum -av _site/* anmitsu:jaspervdj.be/hakyll/" }