From 06ce4ab89998aa145eced57c8b42af77ca95b6aa Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 11 Feb 2022 14:19:21 +0100 Subject: [PATCH 1/2] Drive-by shooting down an unused import This import is not needed since we require GHC >= 8.8. --- exes/Main.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/exes/Main.hs b/exes/Main.hs index 24ca6f208..30322ce3f 100644 --- a/exes/Main.hs +++ b/exes/Main.hs @@ -50,8 +50,6 @@ import Data.Version ( showVersion ) import Control.Monad ( void, unless, when, filterM ) -import Control.Applicative - ( (<$>) ) import Control.Arrow ( second ) import qualified Data.ByteString.Lazy as BS From 2ce66dfbccefd72a9abdc364626d85dd3f9321fb Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 11 Feb 2022 14:21:08 +0100 Subject: [PATCH 2/2] Commonmark: gfmExtensions needs to precede the defaultSyntaxSpec (#1000,#1001) - Move `gfmExtensions` before `defaultSyntaxSpec`. - Require commonmark-extensions-0.2.2 so `footnoteSpec` is subsumed under `gfmExtensions`. (Note: this version bump does not exclude any GHC versions.) - Generalize `renderMarkdown` and `renderMarkdownRel` to `renderMarkdown'`. We use a constraint synonym to gather all the constraints on type `a`, using `LANGUAGE ConstraintKinds`. - Haddockumentation for all functions. - Explicit export list. Hopefully this will fix #1000 and #1001, but `renderMarkdown` has no tests, so I cannot see the effect of my change locally. --- Distribution/Server/Util/Markdown.hs | 66 ++++++++++++++++++++-------- hackage-server.cabal | 6 ++- 2 files changed, 52 insertions(+), 20 deletions(-) diff --git a/Distribution/Server/Util/Markdown.hs b/Distribution/Server/Util/Markdown.hs index b1c80a0fb..3ef8e196b 100644 --- a/Distribution/Server/Util/Markdown.hs +++ b/Distribution/Server/Util/Markdown.hs @@ -1,10 +1,16 @@ +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} -module Distribution.Server.Util.Markdown where + +module Distribution.Server.Util.Markdown + ( renderMarkdown + , renderMarkdownRel + , supposedToBeMarkdown + ) where import Commonmark import Commonmark.Extensions @@ -14,6 +20,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T (lenientDecode) import qualified Data.Text.Lazy as TL +import Data.Typeable (Typeable) import Network.URI (isRelativeReference) import Control.Monad.Identity import Text.HTML.SanitizeXSS as XSS @@ -83,12 +90,12 @@ instance HasMath (HHtml a) where inlineMath t = HHtml $ inlineMath t displayMath t = HHtml $ displayMath t - instance Rangeable (Html a) => HasFootnote (HHtml a) (HHtml a) where footnote x y (HHtml t) = HHtml (footnote x y t) footnoteList xs = HHtml $ footnoteList (map unHHtml xs) footnoteRef x y (HHtml t) = HHtml (footnoteRef x y t) +-- | Prefix relative links with @src/@. adjustRelativeLink :: T.Text -> T.Text adjustRelativeLink url | isRelativeReference (T.unpack url) && @@ -96,25 +103,48 @@ adjustRelativeLink url = "src/" <> url | otherwise = url - -renderHHtml :: HHtml () -> TL.Text -renderHHtml (HHtml x) = renderHtml x - -renderMarkdown :: String -> BS.ByteString -> XHtml.Html -renderMarkdown name md = - either (const $ XHtml.pre XHtml.<< T.unpack txt) (XHtml.primHtml . T.unpack . sanitizeBalance . TL.toStrict . (renderHtml :: Html () -> TL.Text)) $ - runIdentity (commonmarkWith (mathSpec <> footnoteSpec <> defaultSyntaxSpec <> gfmExtensions) - name - txt) - where txt = T.decodeUtf8With T.lenientDecode . BS.toStrict $ md - -renderMarkdownRel :: String -> BS.ByteString -> XHtml.Html -renderMarkdownRel name md = - either (const $ XHtml.pre XHtml.<< T.unpack txt) (XHtml.primHtml . T.unpack . sanitizeBalance . TL.toStrict . renderHHtml) $ - runIdentity (commonmarkWith (mathSpec <> footnoteSpec <> defaultSyntaxSpec <> gfmExtensions) +-- | Render markdown to HTML. +renderMarkdown + :: String -- ^ Name or path of input. + -> BS.ByteString -- ^ Commonmark text input. + -> XHtml.Html -- ^ Rendered HTML. +renderMarkdown = renderMarkdown' (renderHtml :: Html () -> TL.Text) + +-- | Render markdown to HTML, prefixing relative links with @src/@. +renderMarkdownRel + :: String -- ^ Name or path of input. + -> BS.ByteString -- ^ Commonmark text input. + -> XHtml.Html -- ^ Rendered HTML. +renderMarkdownRel = renderMarkdown' (renderHtml . unHHtml :: HHtml () -> TL.Text) + +-- | Prerequisites for 'commonmarkWith' with 'gfmExtensions' and 'mathSpec'. +type MarkdownRenderable a = + ( Typeable a + , HasEmoji a + , HasFootnote a a + , HasMath a + , HasPipeTable a a + , HasStrikethrough a + , HasTaskList a a + , IsBlock a a + , IsInline a + , ToPlainText a + ) + +-- | Generic gfm markdown rendering. +renderMarkdown' + :: MarkdownRenderable a + => (a -> TL.Text) -- ^ HTML rendering function. + -> String -- ^ Name or path of input. + -> BS.ByteString -- ^ Commonmark text input. + -> XHtml.Html -- ^ Rendered HTML. +renderMarkdown' render name md = + either (const $ XHtml.pre XHtml.<< T.unpack txt) (XHtml.primHtml . T.unpack . sanitizeBalance . TL.toStrict . render) $ + runIdentity (commonmarkWith (mathSpec <> gfmExtensions <> defaultSyntaxSpec) name txt) where txt = T.decodeUtf8With T.lenientDecode . BS.toStrict $ md +-- | Does the file extension suggest that the file is in markdown syntax? supposedToBeMarkdown :: FilePath -> Bool supposedToBeMarkdown fname = takeExtension fname `elem` [".md", ".markdown"] diff --git a/hackage-server.cabal b/hackage-server.cabal index 49c4d83ee..b8474aa0b 100644 --- a/hackage-server.cabal +++ b/hackage-server.cabal @@ -363,8 +363,10 @@ library lib-server , blaze-builder ^>= 0.4 , blaze-html ^>= 0.9 , cereal ^>= 0.5 - , commonmark ^>= 0.1 - , commonmark-extensions ^>= 0.2 + , commonmark ^>= 0.2 + -- commonmark-0.2 needed by commonmark-extensions-0.2.2 + , commonmark-extensions ^>= 0.2.2 + -- Note: 0.2.2 added footnoteSpec to gfmExtensions , cryptohash-md5 ^>= 0.11.100 , cryptohash-sha256 ^>= 0.11.100 , csv ^>= 0.1