From 566536d6a1db7959197bed086c07cd23457ca378 Mon Sep 17 00:00:00 2001
From: Alec Theriault <alec.theriault@gmail.com>
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 <alec.theriault@gmail.com>
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 ""
+-- 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:
+--
+-- 
+--
+link :: ()
+link = ()
--
cgit v1.2.3
From 7c77914a3d47b78e690c820b0964a8f14b886cc9 Mon Sep 17 00:00:00 2001
From: Alec Theriault <alec.theriault@gmail.com>
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 @@
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+ ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+ /><title
+ >Bug865</title
+ ><link href="#" rel="stylesheet" type="text/css" title="Ocean"
+ /><link rel="stylesheet" type="text/css" href="#"
+ /><script src="haddock-bundle.min.js" async="async" type="text/javascript"
+ ></script
+ ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
+ ></script
+ ></head
+ ><body
+ ><div id="package-header"
+ ><ul class="links" id="page-menu"
+ ><li
+ ><a href="#"
+ >Contents</a
+ ></li
+ ><li
+ ><a href="#"
+ >Index</a
+ ></li
+ ></ul
+ ><p class="caption empty"
+ ></p
+ ></div
+ ><div id="content"
+ ><div id="module-header"
+ ><table class="info"
+ ><tr
+ ><th
+ >Safe Haskell</th
+ ><td
+ >Safe</td
+ ></tr
+ ></table
+ ><p class="caption"
+ >Bug865</p
+ ></div
+ ><div id="synopsis"
+ ><details id="syn"
+ ><summary
+ >Synopsis</summary
+ ><ul class="details-toggle" data-details-id="syn"
+ ><li class="src short"
+ ><a href="#"
+ >link</a
+ > :: ()</li
+ ></ul
+ ></details
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><a id="v:link" class="def"
+ >link</a
+ > :: () <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >An emphasized link <a href="#"
+ >yes <em
+ >this</em
+ > is emphasized while this is
+ <code
+ >monospaced</code
+ ></a
+ >. And here is an image:</p
+ ><p
+ ><img src="https://www.haskell.org/static/img/haskell-logo.svg" title="emphasis stripped"
+ /></p
+ ></div
+ ></div
+ ></div
+ ></div
+ ><div id="footer"
+ ></div
+ ></body
+ ></html
+>
\ No newline at end of file
--
cgit v1.2.3
From f11b26e952860f576b3321b35e572ebb339268de Mon Sep 17 00:00:00 2001
From: Alec Theriault <alec.theriault@gmail.com>
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 <alec.theriault@gmail.com>
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