From 566536d6a1db7959197bed086c07cd23457ca378 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sat, 7 Jul 2018 20:25:35 -0400 Subject: Support hyperlink labels with inline markup The parser for pictures hasn't been properly adjusted yet. --- haddock-api/src/Haddock/Backends/Hoogle.hs | 2 +- haddock-api/src/Haddock/Backends/LaTeX.hs | 6 +-- .../src/Haddock/Backends/Xhtml/DocMarkup.hs | 4 +- haddock-api/src/Haddock/Interface/LexParseRn.hs | 2 +- haddock-api/src/Haddock/InterfaceFile.hs | 2 +- haddock-api/src/Haddock/Types.hs | 2 +- .../src/Documentation/Haddock/Markup.hs | 48 +++++++++++----------- .../src/Documentation/Haddock/Parser.hs | 22 +++++----- haddock-library/src/Documentation/Haddock/Types.hs | 14 +++---- 9 files changed, 52 insertions(+), 50 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index eb93ade2..d6a6a12d 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -336,7 +336,7 @@ markupTag dflags = Markup { markupOrderedList = box (TagL 'o'), markupDefList = box (TagL 'u') . map (\(a,b) -> TagInline "i" a : Str " " : b), markupCodeBlock = box TagPre, - markupHyperlink = \(Hyperlink url mLabel) -> (box (TagInline "a") . str) (fromMaybe url mLabel), + markupHyperlink = \(Hyperlink url mLabel) -> box (TagInline "a") (fromMaybe (str url) mLabel), markupAName = const $ str "", markupProperty = box TagPre . str, markupExample = box TagPre . str . unlines . map exampleToString, diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index d2baf69a..d5b2f325 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -1182,7 +1182,7 @@ parLatexMarkup ppId = Markup { markupOrderedList = \p v -> enumeratedList (map ($v) p) $$ text "", markupDefList = \l v -> descriptionList (map (\(a,b) -> (a v, b v)) l), markupCodeBlock = \p _ -> quote (verb (p Verb)) $$ text "", - markupHyperlink = \l _ -> markupLink l, + markupHyperlink = \(Hyperlink u l) p -> markupLink u (fmap ($p) l), markupAName = \_ _ -> empty, markupProperty = \p _ -> quote $ verb $ text p, markupExample = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e, @@ -1202,8 +1202,8 @@ parLatexMarkup ppId = Markup { fixString Verb s = s fixString Mono s = latexMonoFilter s - markupLink (Hyperlink url mLabel) = case mLabel of - Just label -> text "\\href" <> braces (text url) <> braces (text label) + markupLink url mLabel = case mLabel of + Just label -> text "\\href" <> braces (text url) <> braces label Nothing -> text "\\url" <> braces (text url) -- Is there a better way of doing this? Just a space is an aribtrary choice. diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs index ed323a90..42643ed0 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -62,8 +62,8 @@ parHtmlMarkup qual insertAnchors ppId = Markup { markupHyperlink = \(Hyperlink url mLabel) -> if insertAnchors then anchor ! [href url] - << fromMaybe url mLabel - else toHtml $ fromMaybe url mLabel, + << fromMaybe (toHtml url) mLabel + else fromMaybe (toHtml url) mLabel, markupAName = \aname -> if insertAnchors then namedAnchor aname << "" diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index 87face7c..4dff77ce 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -135,7 +135,7 @@ rename dflags gre = rn DocCodeBlock doc -> DocCodeBlock <$> rn doc DocIdentifierUnchecked x -> pure (DocIdentifierUnchecked x) DocModule str -> pure (DocModule str) - DocHyperlink l -> pure (DocHyperlink l) + DocHyperlink (Hyperlink u l) -> DocHyperlink . Hyperlink u <$> traverse rn l DocPic str -> pure (DocPic str) DocMathInline str -> pure (DocMathInline str) DocMathDisplay str -> pure (DocMathDisplay str) diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index 30bd2b9a..8e01a38d 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -434,7 +434,7 @@ instance Binary Example where result <- get bh return (Example expression result) -instance Binary Hyperlink where +instance Binary a => Binary (Hyperlink a) where put_ bh (Hyperlink url label) = do put_ bh url put_ bh label diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 6da45a3b..39df598a 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -467,7 +467,7 @@ instance NFData ModuleName where rnf x = seq x () instance NFData id => NFData (Header id) where rnf (Header a b) = a `deepseq` b `deepseq` () -instance NFData Hyperlink where +instance NFData id => NFData (Hyperlink id) where rnf (Hyperlink a b) = a `deepseq` b `deepseq` () instance NFData Picture where diff --git a/haddock-library/src/Documentation/Haddock/Markup.hs b/haddock-library/src/Documentation/Haddock/Markup.hs index da8edcd4..b581a4d2 100644 --- a/haddock-library/src/Documentation/Haddock/Markup.hs +++ b/haddock-library/src/Documentation/Haddock/Markup.hs @@ -7,30 +7,30 @@ module Documentation.Haddock.Markup ( import Documentation.Haddock.Types markup :: DocMarkupH mod id a -> DocH mod id -> a -markup m DocEmpty = markupEmpty m -markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2) -markup m (DocString s) = markupString m s -markup m (DocParagraph d) = markupParagraph m (markup m d) -markup m (DocIdentifier x) = markupIdentifier m x -markup m (DocIdentifierUnchecked x) = markupIdentifierUnchecked m x -markup m (DocModule mod0) = markupModule m mod0 -markup m (DocWarning d) = markupWarning m (markup m d) -markup m (DocEmphasis d) = markupEmphasis m (markup m d) -markup m (DocBold d) = markupBold m (markup m d) -markup m (DocMonospaced d) = markupMonospaced m (markup m d) -markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds) -markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds) -markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds) -markup m (DocCodeBlock d) = markupCodeBlock m (markup m d) -markup m (DocHyperlink l) = markupHyperlink m l -markup m (DocAName ref) = markupAName m ref -markup m (DocPic img) = markupPic m img -markup m (DocMathInline mathjax) = markupMathInline m mathjax -markup m (DocMathDisplay mathjax) = markupMathDisplay m mathjax -markup m (DocProperty p) = markupProperty m p -markup m (DocExamples e) = markupExample m e -markup m (DocHeader (Header l t)) = markupHeader m (Header l (markup m t)) -markup m (DocTable (Table h b)) = markupTable m (Table (map (fmap (markup m)) h) (map (fmap (markup m)) b)) +markup m DocEmpty = markupEmpty m +markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2) +markup m (DocString s) = markupString m s +markup m (DocParagraph d) = markupParagraph m (markup m d) +markup m (DocIdentifier x) = markupIdentifier m x +markup m (DocIdentifierUnchecked x) = markupIdentifierUnchecked m x +markup m (DocModule mod0) = markupModule m mod0 +markup m (DocWarning d) = markupWarning m (markup m d) +markup m (DocEmphasis d) = markupEmphasis m (markup m d) +markup m (DocBold d) = markupBold m (markup m d) +markup m (DocMonospaced d) = markupMonospaced m (markup m d) +markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds) +markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds) +markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds) +markup m (DocCodeBlock d) = markupCodeBlock m (markup m d) +markup m (DocHyperlink (Hyperlink u l)) = markupHyperlink m (Hyperlink u (fmap (markup m) l)) +markup m (DocAName ref) = markupAName m ref +markup m (DocPic img) = markupPic m img +markup m (DocMathInline mathjax) = markupMathInline m mathjax +markup m (DocMathDisplay mathjax) = markupMathDisplay m mathjax +markup m (DocProperty p) = markupProperty m p +markup m (DocExamples e) = markupExample m e +markup m (DocHeader (Header l t)) = markupHeader m (Header l (markup m t)) +markup m (DocTable (Table h b)) = markupTable m (Table (map (fmap (markup m)) h) (map (fmap (markup m)) b)) markupPair :: DocMarkupH mod id a -> (DocH mod id, DocH mod id) -> (a, a) markupPair m (a,b) = (markup m a, markup m b) diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index 46b7ad3e..fb815dd9 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -107,7 +107,7 @@ overIdentifier f d = g d g (DocOrderedList x) = DocOrderedList $ fmap g x g (DocDefList x) = DocDefList $ fmap (\(y, z) -> (g y, g z)) x g (DocCodeBlock x) = DocCodeBlock $ g x - g (DocHyperlink x) = DocHyperlink x + g (DocHyperlink (Hyperlink u x)) = DocHyperlink (Hyperlink u (fmap g x)) g (DocPic x) = DocPic x g (DocMathInline x) = DocMathInline x g (DocMathDisplay x) = DocMathDisplay x @@ -305,9 +305,11 @@ mathDisplay = DocMathDisplay . T.unpack <$> ("\\[" *> takeUntil "\\]") markdownImage :: Parser (DocH mod a) -markdownImage = fromHyperlink <$> ("!" *> linkParser) +markdownImage = DocPic . fromHyperlink <$> ("!" *> linkParser) where - fromHyperlink (Hyperlink url label) = DocPic (Picture url label) + fromHyperlink (Hyperlink url Nothing) = Picture url Nothing + fromHyperlink (Hyperlink url (Just (DocString s))) = Picture url (Just s) + -- TODO partial ^ -- | Paragraph parser, called by 'parseParas'. paragraph :: Parser (DocH mod Identifier) @@ -784,22 +786,22 @@ codeblock = | isNewline && isSpace c = Just isNewline | otherwise = Just $ c == '\n' -hyperlink :: Parser (DocH mod a) +hyperlink :: Parser (DocH mod Identifier) hyperlink = choice' [ angleBracketLink, markdownLink, autoUrl ] angleBracketLink :: Parser (DocH mod a) angleBracketLink = - DocHyperlink . makeLabeled Hyperlink + DocHyperlink . flip Hyperlink Nothing . T.unpack . removeEscapes <$> disallowNewline ("<" *> takeUntil ">") -markdownLink :: Parser (DocH mod a) +markdownLink :: Parser (DocH mod Identifier) markdownLink = DocHyperlink <$> linkParser -linkParser :: Parser Hyperlink +linkParser :: Parser (Hyperlink (DocH mod Identifier)) linkParser = flip Hyperlink <$> label <*> (whitespace *> url) where - label :: Parser (Maybe String) - label = Just . decode . T.strip <$> ("[" *> takeUntil "]") + label :: Parser (Maybe (DocH mod Identifier)) + label = Just . parseParagraph . T.strip <$> ("[" *> takeUntil "]") whitespace :: Parser () whitespace = skipHorizontalSpace <* optional ("\n" *> skipHorizontalSpace) @@ -825,7 +827,7 @@ autoUrl = mkLink <$> url Just (xs,x) | x `elem` (",.!?" :: String) -> DocHyperlink (mkHyperlink xs) `docAppend` DocString [x] _ -> DocHyperlink (mkHyperlink s) - mkHyperlink :: Text -> Hyperlink + mkHyperlink :: Text -> Hyperlink (DocH mod a) mkHyperlink lnk = Hyperlink (T.unpack lnk) Nothing diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index b5dea3d4..f8f7d353 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -65,10 +65,10 @@ overDocF f d = (\x -> d { _doc = x }) <$> f (_doc d) type Version = [Int] type Package = String -data Hyperlink = Hyperlink +data Hyperlink id = Hyperlink { hyperlinkUrl :: String - , hyperlinkLabel :: Maybe String - } deriving (Eq, Show) + , hyperlinkLabel :: Maybe id + } deriving (Eq, Show, Functor, Foldable, Traversable) data Picture = Picture { pictureUri :: String @@ -118,7 +118,7 @@ data DocH mod id | DocOrderedList [DocH mod id] | DocDefList [(DocH mod id, DocH mod id)] | DocCodeBlock (DocH mod id) - | DocHyperlink Hyperlink + | DocHyperlink (Hyperlink (DocH mod id)) | DocPic Picture | DocMathInline String | DocMathDisplay String @@ -147,7 +147,7 @@ instance Bifunctor DocH where bimap f g (DocOrderedList docs) = DocOrderedList (map (bimap f g) docs) bimap f g (DocDefList docs) = DocDefList (map (bimap f g *** bimap f g) docs) bimap f g (DocCodeBlock doc) = DocCodeBlock (bimap f g doc) - bimap _ _ (DocHyperlink hyperlink) = DocHyperlink hyperlink + bimap f g (DocHyperlink (Hyperlink url lbl)) = DocHyperlink (Hyperlink url (fmap (bimap f g) lbl)) bimap _ _ (DocPic picture) = DocPic picture bimap _ _ (DocMathInline s) = DocMathInline s bimap _ _ (DocMathDisplay s) = DocMathDisplay s @@ -192,7 +192,7 @@ instance Bitraversable DocH where bitraverse f g (DocOrderedList docs) = DocOrderedList <$> traverse (bitraverse f g) docs bitraverse f g (DocDefList docs) = DocDefList <$> traverse (bitraverse (bitraverse f g) (bitraverse f g)) docs bitraverse f g (DocCodeBlock doc) = DocCodeBlock <$> bitraverse f g doc - bitraverse _ _ (DocHyperlink hyperlink) = pure (DocHyperlink hyperlink) + bitraverse f g (DocHyperlink (Hyperlink url lbl)) = DocHyperlink <$> (Hyperlink url <$> traverse (bitraverse f g) lbl) bitraverse _ _ (DocPic picture) = pure (DocPic picture) bitraverse _ _ (DocMathInline s) = pure (DocMathInline s) bitraverse _ _ (DocMathDisplay s) = pure (DocMathDisplay s) @@ -227,7 +227,7 @@ data DocMarkupH mod id a = Markup , markupOrderedList :: [a] -> a , markupDefList :: [(a,a)] -> a , markupCodeBlock :: a -> a - , markupHyperlink :: Hyperlink -> a + , markupHyperlink :: Hyperlink a -> a , markupAName :: String -> a , markupPic :: Picture -> a , markupMathInline :: String -> a -- cgit v1.2.3 From 59be4f386c3803aeab7a9b2bc9bca49f1fe113db Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sat, 7 Jul 2018 19:46:17 -0700 Subject: Support (and flatten) inline markup in image links Inline markup is supported in image links but, as per the [commonmark recommendation][0], it is stripped back to a plain text representation. [0]: https://spec.commonmark.org/0.28/#example-547 --- .../src/Documentation/Haddock/Markup.hs | 34 ++++++++++++++++++++++ .../src/Documentation/Haddock/Parser.hs | 15 ++++++---- html-test/src/Bug865.hs | 9 ++++++ 3 files changed, 53 insertions(+), 5 deletions(-) create mode 100644 html-test/src/Bug865.hs diff --git a/haddock-library/src/Documentation/Haddock/Markup.hs b/haddock-library/src/Documentation/Haddock/Markup.hs index b581a4d2..b44fef80 100644 --- a/haddock-library/src/Documentation/Haddock/Markup.hs +++ b/haddock-library/src/Documentation/Haddock/Markup.hs @@ -2,10 +2,13 @@ module Documentation.Haddock.Markup ( markup , idMarkup + , plainMarkup ) where import Documentation.Haddock.Types +import Data.Maybe ( fromMaybe ) + markup :: DocMarkupH mod id a -> DocH mod id -> a markup m DocEmpty = markupEmpty m markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2) @@ -63,3 +66,34 @@ idMarkup = Markup { markupHeader = DocHeader, markupTable = DocTable } + +-- | Map a 'DocH' into a best estimate of an alternate string. The idea is to +-- strip away any formatting while preserving as much of the actual text as +-- possible. +plainMarkup :: (mod -> String) -> (id -> String) -> DocMarkupH mod id String +plainMarkup plainMod plainIdent = Markup { + markupEmpty = "", + markupString = id, + markupParagraph = id, + markupAppend = (<>), + markupIdentifier = plainIdent, + markupIdentifierUnchecked = plainMod, + markupModule = id, + markupWarning = id, + markupEmphasis = id, + markupBold = id, + markupMonospaced = id, + markupUnorderedList = const "", + markupOrderedList = const "", + markupDefList = const "", + markupCodeBlock = id, + markupHyperlink = \(Hyperlink url lbl) -> fromMaybe url lbl, + markupAName = id, + markupPic = \(Picture uri title) -> fromMaybe uri title, + markupMathInline = id, + markupMathDisplay = id, + markupProperty = id, + markupExample = const "", + markupHeader = \(Header _ title) -> title, + markupTable = const "" + } diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index fb815dd9..0992dbbc 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -33,6 +33,7 @@ import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid import qualified Data.Set as Set import Documentation.Haddock.Doc +import Documentation.Haddock.Markup ( markup, plainMarkup ) import Documentation.Haddock.Parser.Monad import Documentation.Haddock.Parser.Util import Documentation.Haddock.Types @@ -301,15 +302,19 @@ mathInline = DocMathInline . T.unpack -- >>> parseString "\\[\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\]" -- DocMathDisplay "\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}" mathDisplay :: Parser (DocH mod a) -mathDisplay = DocMathDisplay . T.unpack +mathDisplay = DocMathDisplay . T.unpack <$> ("\\[" *> takeUntil "\\]") -markdownImage :: Parser (DocH mod a) +-- | Markdown image parser. As per the commonmark reference recommendation, the +-- description text for an image converted to its a plain string representation. +-- +-- >>> parseString "![some /emphasis/ in a description](www.site.com)" +-- DocPic (Picture "www.site.com" (Just "some emphasis in a description")) +markdownImage :: Parser (DocH mod Identifier) markdownImage = DocPic . fromHyperlink <$> ("!" *> linkParser) where - fromHyperlink (Hyperlink url Nothing) = Picture url Nothing - fromHyperlink (Hyperlink url (Just (DocString s))) = Picture url (Just s) - -- TODO partial ^ + fromHyperlink (Hyperlink u l) = Picture u (fmap (markup stringMarkup) l) + stringMarkup = plainMarkup (const "") (\(l,c,r) -> [l] <> c <> [r]) -- | Paragraph parser, called by 'parseParas'. paragraph :: Parser (DocH mod Identifier) diff --git a/html-test/src/Bug865.hs b/html-test/src/Bug865.hs new file mode 100644 index 00000000..71a6add1 --- /dev/null +++ b/html-test/src/Bug865.hs @@ -0,0 +1,9 @@ +module Bug865 where + +-- | An emphasized link [yes /this/ is emphasized while this is +-- @monospaced@](https://www.haskell.org/). And here is an image: +-- +-- ![/emphasis/ stripped](https://www.haskell.org/static/img/haskell-logo.svg) +-- +link :: () +link = () -- cgit v1.2.3 From 7c77914a3d47b78e690c820b0964a8f14b886cc9 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Fri, 20 Jul 2018 00:21:48 -0700 Subject: Accept test case --- .../src/Documentation/Haddock/Parser.hs | 2 +- html-test/ref/Bug865.html | 84 ++++++++++++++++++++++ 2 files changed, 85 insertions(+), 1 deletion(-) create mode 100644 html-test/ref/Bug865.html diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index 0992dbbc..f6c12d46 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -796,7 +796,7 @@ hyperlink = choice' [ angleBracketLink, markdownLink, autoUrl ] angleBracketLink :: Parser (DocH mod a) angleBracketLink = - DocHyperlink . flip Hyperlink Nothing . T.unpack . removeEscapes + DocHyperlink . makeLabeled (\s -> Hyperlink s . fmap DocString) <$> disallowNewline ("<" *> takeUntil ">") markdownLink :: Parser (DocH mod Identifier) diff --git a/html-test/ref/Bug865.html b/html-test/ref/Bug865.html new file mode 100644 index 00000000..6630a88d --- /dev/null +++ b/html-test/ref/Bug865.html @@ -0,0 +1,84 @@ +Bug865
Safe HaskellSafe

Bug865

Synopsis

Documentation

link :: () #

An emphasized link yes this is emphasized while this is + monospaced. And here is an image:

\ No newline at end of file -- cgit v1.2.3 From f11b26e952860f576b3321b35e572ebb339268de Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Fri, 20 Jul 2018 00:56:03 -0700 Subject: Fix/add to haddock-library test suite --- haddock-library/fixtures/Fixtures.hs | 4 ++-- haddock-library/fixtures/examples/link.parsed | 2 +- haddock-library/fixtures/examples/linkInline.parsed | 3 ++- haddock-library/fixtures/examples/linkInlineMarkup.input | 1 + haddock-library/fixtures/examples/linkInlineMarkup.parsed | 8 ++++++++ haddock-library/fixtures/examples/urlLabel.parsed | 2 +- haddock-library/test/Documentation/Haddock/ParserSpec.hs | 6 +++++- 7 files changed, 20 insertions(+), 6 deletions(-) create mode 100644 haddock-library/fixtures/examples/linkInlineMarkup.input create mode 100644 haddock-library/fixtures/examples/linkInlineMarkup.parsed diff --git a/haddock-library/fixtures/Fixtures.hs b/haddock-library/fixtures/Fixtures.hs index a4e4321f..72ea8525 100644 --- a/haddock-library/fixtures/Fixtures.hs +++ b/haddock-library/fixtures/Fixtures.hs @@ -146,8 +146,8 @@ instance (ToExpr mod, ToExpr id) => ToExpr (DocH mod id) deriving instance Generic (Header id) instance ToExpr id => ToExpr (Header id) -deriving instance Generic Hyperlink -instance ToExpr Hyperlink +deriving instance Generic (Hyperlink id) +instance ToExpr id => ToExpr (Hyperlink id) deriving instance Generic Picture instance ToExpr Picture diff --git a/haddock-library/fixtures/examples/link.parsed b/haddock-library/fixtures/examples/link.parsed index 0e85338c..781dee87 100644 --- a/haddock-library/fixtures/examples/link.parsed +++ b/haddock-library/fixtures/examples/link.parsed @@ -1,5 +1,5 @@ DocParagraph (DocHyperlink Hyperlink - {hyperlinkLabel = Just "link", + {hyperlinkLabel = Just (DocString "link"), hyperlinkUrl = "http://example.com"}) diff --git a/haddock-library/fixtures/examples/linkInline.parsed b/haddock-library/fixtures/examples/linkInline.parsed index 43470d7b..fe771598 100644 --- a/haddock-library/fixtures/examples/linkInline.parsed +++ b/haddock-library/fixtures/examples/linkInline.parsed @@ -3,4 +3,5 @@ DocParagraph (DocString "Bla ") (DocHyperlink Hyperlink - {hyperlinkLabel = Just "link", hyperlinkUrl = "http://example.com"})) + {hyperlinkLabel = Just (DocString "link"), + hyperlinkUrl = "http://example.com"})) diff --git a/haddock-library/fixtures/examples/linkInlineMarkup.input b/haddock-library/fixtures/examples/linkInlineMarkup.input new file mode 100644 index 00000000..e2f4e405 --- /dev/null +++ b/haddock-library/fixtures/examples/linkInlineMarkup.input @@ -0,0 +1 @@ +Bla [link /emphasized/](http://example.com) diff --git a/haddock-library/fixtures/examples/linkInlineMarkup.parsed b/haddock-library/fixtures/examples/linkInlineMarkup.parsed new file mode 100644 index 00000000..39adab64 --- /dev/null +++ b/haddock-library/fixtures/examples/linkInlineMarkup.parsed @@ -0,0 +1,8 @@ +DocParagraph + (DocAppend + (DocString "Bla ") + (DocHyperlink + Hyperlink + {hyperlinkLabel = Just (DocAppend (DocString "link ") + (DocEmphasis (DocString "emphasized"))), + hyperlinkUrl = "http://example.com"})) diff --git a/haddock-library/fixtures/examples/urlLabel.parsed b/haddock-library/fixtures/examples/urlLabel.parsed index d7e3a76c..58d2a81a 100644 --- a/haddock-library/fixtures/examples/urlLabel.parsed +++ b/haddock-library/fixtures/examples/urlLabel.parsed @@ -1,5 +1,5 @@ DocParagraph (DocHyperlink Hyperlink - {hyperlinkLabel = Just "some link", + {hyperlinkLabel = Just (DocString "some link"), hyperlinkUrl = "http://example.com/"}) diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs index 0449c917..6269184a 100644 --- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs +++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs @@ -37,7 +37,7 @@ parseParas = overDoc Parse.toRegular . Parse.parseParas Nothing parseString :: String -> Doc String parseString = Parse.toRegular . Parse.parseString -hyperlink :: String -> Maybe String -> Doc String +hyperlink :: String -> Maybe (Doc String) -> Doc String hyperlink url = DocHyperlink . Hyperlink url main :: IO () @@ -202,6 +202,10 @@ spec = do "[some label]( url)" `shouldParseTo` "[some label]( url)" + it "allows inline markup in the label" $ do + "[something /emphasized/](url)" `shouldParseTo` + hyperlink "url" (Just ("something " <> DocEmphasis "emphasized")) + context "when URL is on a separate line" $ do it "allows URL to be on a separate line" $ do "[some label]\n(url)" `shouldParseTo` -- cgit v1.2.3 From aeebb79290fb3983271ab9e3fe95dbdae7caccde Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Fri, 20 Jul 2018 15:02:46 -0700 Subject: Bump version bounds --- CHANGES.md | 2 ++ haddock-api/src/Haddock/InterfaceFile.hs | 2 +- haddock-library/CHANGES.md | 4 ++++ 3 files changed, 7 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 66703068..8240479f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,8 @@ * Make `--package-version` optional for `--hoogle` (#899) + * Support inline markup in markdown-style links (#875) + ## Changes in version 2.21.0 * Overhaul handling of data declarations in XHTML and LaTeX. Adds support for diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index 8e01a38d..e1d8dbe1 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -83,7 +83,7 @@ binaryInterfaceMagic = 0xD0Cface -- binaryInterfaceVersion :: Word16 #if (__GLASGOW_HASKELL__ >= 807) && (__GLASGOW_HASKELL__ < 809) -binaryInterfaceVersion = 33 +binaryInterfaceVersion = 34 binaryInterfaceVersionCompatibility :: [Word16] binaryInterfaceVersionCompatibility = [binaryInterfaceVersion] diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md index 0175b6af..971d8dc7 100644 --- a/haddock-library/CHANGES.md +++ b/haddock-library/CHANGES.md @@ -1,3 +1,7 @@ +## TBA + + * Support inline markup in markdown-style links (#875) + ## Changes in version 1.7.0 * Make `Documentation.Haddock.Parser.Monad` an internal module -- cgit v1.2.3