aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2021-02-08 12:54:33 -0500
committerBen Gamari <ben@smart-cactus.org>2021-02-08 12:54:33 -0500
commite57d82dde105ffbfcb27ab261041c97b4dd0150a (patch)
treee4716c076ef5f05d63235bbf475f939fa1ed402f /haddock-api/src/Haddock/Backends
parentb995bfe84f9766e23ff78d7ccd520ec7d8cdbebc (diff)
parent4f1a309700106b62831309931e449a603093f521 (diff)
Merge remote-tracking branch 'upstream/ghc-head' into ghc-head
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs7
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs15
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Names.hs9
5 files changed, 23 insertions, 14 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 3bf12477..f7e1c77b 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -35,7 +35,7 @@ import GHC.Parser.Annotation (IsUnicodeSyntax(..))
import GHC.Unit.State
import Data.Char
-import Data.List
+import Data.List (intercalate, isPrefixOf)
import Data.Maybe
import Data.Version
@@ -343,7 +343,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/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 8ecc185b..d85a3970 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -18,7 +18,7 @@ import Data.Maybe
import System.Directory
import System.FilePath
-import GHC.Iface.Ext.Types
+import GHC.Iface.Ext.Types ( HieFile(..), HieASTs(..), HieAST(..), SourcedNodeInfo(..) )
import GHC.Iface.Ext.Binary ( readHieFile, hie_file_result, NameCacheUpdater(..))
import GHC.Types.SrcLoc ( realSrcLocSpan, mkRealSrcLoc )
import Data.Map as M
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 5b27847e..df1f94e6 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -1241,7 +1241,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.