diff options
| author | Hécate Moonlight <Kleidukos@users.noreply.github.com> | 2021-02-07 16:18:10 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2021-02-07 16:18:10 +0100 |
| commit | a10d042ac76c990764250244ac801db16858b6ee (patch) | |
| tree | 40f8bc9066d9d96fa00163b10ac85d7645ad01d2 /haddock-api/src/Haddock/Backends | |
| parent | a2f9f297d17059b3fc68ce4a245702278a5d8340 (diff) | |
| parent | c31c156422785751e33c9a7a4f021ac8da77d364 (diff) | |
Merge pull request #1319 from alexbiehl/alex/compat
Backward compat: Add support for labeled module references
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 7 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs | 15 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Names.hs | 9 |
4 files changed, 21 insertions, 12 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 58809f73..9a304030 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -325,7 +325,7 @@ markupTag dflags = Markup { markupAppend = (++), markupIdentifier = box (TagInline "a") . str . out dflags, markupIdentifierUnchecked = box (TagInline "a") . str . showWrapped (out dflags . snd), - markupModule = box (TagInline "a") . str, + markupModule = \(ModLink m label) -> box (TagInline "a") (fromMaybe (str m) label), markupWarning = box (TagInline "i"), markupEmphasis = box (TagInline "i"), markupBold = box (TagInline "b"), diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index df81fd6e..2371695f 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -1210,7 +1210,12 @@ latexMarkup = Markup , markupAppend = \l r v -> l v . r v , markupIdentifier = \i v -> inlineElem (markupId v (fmap occName i)) , markupIdentifierUnchecked = \i v -> inlineElem (markupId v (fmap snd i)) - , markupModule = \m _ -> inlineElem (let (mdl,_ref) = break (=='#') m in (tt (text mdl))) + , markupModule = + \(ModLink m mLabel) v -> + case mLabel of + Just lbl -> inlineElem . tt $ lbl v empty + Nothing -> inlineElem (let (mdl,_ref) = break (=='#') m + in (tt (text mdl))) , markupWarning = \p v -> p v , markupEmphasis = \p v -> inlineElem (emph (p v empty)) , markupBold = \p v -> inlineElem (bold (p v empty)) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs index 378d0559..7670b193 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -44,13 +44,14 @@ parHtmlMarkup qual insertAnchors ppId = Markup { markupAppend = (+++), markupIdentifier = thecode . ppId insertAnchors, markupIdentifierUnchecked = thecode . ppUncheckedLink qual, - markupModule = \m -> let (mdl,ref) = break (=='#') m - -- Accomodate for old style - -- foo\#bar anchors - mdl' = case reverse mdl of - '\\':_ -> init mdl - _ -> mdl - in ppModuleRef (mkModuleName mdl') ref, + markupModule = \(ModLink m lbl) -> + let (mdl,ref) = break (=='#') m + -- Accomodate for old style + -- foo\#bar anchors + mdl' = case reverse mdl of + '\\':_ -> init mdl + _ -> mdl + in ppModuleRef lbl (mkModuleName mdl') ref, markupWarning = thediv ! [theclass "warning"], markupEmphasis = emphasize, markupBold = strong, diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs index 8553cdfb..b324fa38 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs @@ -186,9 +186,12 @@ ppModule mdl = anchor ! [href (moduleUrl mdl)] << toHtml (moduleString mdl) -ppModuleRef :: ModuleName -> String -> Html -ppModuleRef mdl ref = anchor ! [href (moduleHtmlFile' mdl ++ ref)] - << toHtml (moduleNameString mdl) +ppModuleRef :: Maybe Html -> ModuleName -> String -> Html +ppModuleRef Nothing mdl ref = anchor ! [href (moduleHtmlFile' mdl ++ ref)] + << toHtml (moduleNameString mdl) +ppModuleRef (Just lbl) mdl ref = anchor ! [href (moduleHtmlFile' mdl ++ ref)] + << lbl + -- NB: The ref parameter already includes the '#'. -- This function is only called from markupModule expanding a -- DocModule, which doesn't seem to be ever be used. |