aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2018-07-07 20:25:35 -0400
committerAlec Theriault <alec.theriault@gmail.com>2018-11-06 12:03:24 -0800
commit566536d6a1db7959197bed086c07cd23457ca378 (patch)
tree6d60dd0c2127886482766a0f1231310d8871bd86 /haddock-api/src
parent82b8f491e18d707f67857bcb170b2147fa275ccc (diff)
Support hyperlink labels with inline markup
The parser for pictures hasn't been properly adjusted yet.
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs6
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs4
-rw-r--r--haddock-api/src/Haddock/Interface/LexParseRn.hs2
-rw-r--r--haddock-api/src/Haddock/InterfaceFile.hs2
-rw-r--r--haddock-api/src/Haddock/Types.hs2
6 files changed, 9 insertions, 9 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