diff options
| -rw-r--r-- | html-test/src/Ticket253_1.hs | 6 | ||||
| -rw-r--r-- | html-test/src/Ticket253_2.hs | 6 | ||||
| -rw-r--r-- | src/Haddock/Interface/LexParseRn.hs | 18 |
3 files changed, 28 insertions, 2 deletions
diff --git a/html-test/src/Ticket253_1.hs b/html-test/src/Ticket253_1.hs new file mode 100644 index 00000000..62ab4b17 --- /dev/null +++ b/html-test/src/Ticket253_1.hs @@ -0,0 +1,6 @@ +module Ticket253_1 where +-- | See 'Ticket253_2.bar'. +-- +-- Also see 'Ticket253_2.Baz' +foo :: Int +foo = 0 diff --git a/html-test/src/Ticket253_2.hs b/html-test/src/Ticket253_2.hs new file mode 100644 index 00000000..a19d4cee --- /dev/null +++ b/html-test/src/Ticket253_2.hs @@ -0,0 +1,6 @@ +module Ticket253_2 where +-- | Comment +bar :: Int +bar = 0 + +data Baz = Baz diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs index ced12d8d..9d775bcb 100644 --- a/src/Haddock/Interface/LexParseRn.hs +++ b/src/Haddock/Interface/LexParseRn.hs @@ -32,7 +32,6 @@ import GHC import Name import Outputable import RdrName -import RnEnv processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> ErrMsgM (Maybe (Doc Name)) @@ -96,7 +95,7 @@ rename dflags gre = rn DocAppend a b -> DocAppend (rn a) (rn b) DocParagraph doc -> DocParagraph (rn doc) DocIdentifier x -> do - let choices = dataTcOccs x + let choices = dataTcOccs' x let names = concatMap (\c -> map gre_name (lookupGRE_RdrName c gre)) choices case names of [] -> @@ -109,6 +108,7 @@ rename dflags gre = rn a:b:_ | isTyConName a -> DocIdentifier a | otherwise -> DocIdentifier b -- If an id can refer to multiple things, we give precedence to type -- constructors. + DocWarning doc -> DocWarning (rn doc) DocEmphasis doc -> DocEmphasis (rn doc) DocMonospaced doc -> DocMonospaced (rn doc) @@ -126,6 +126,20 @@ rename dflags gre = rn DocEmpty -> DocEmpty DocString str -> DocString str +dataTcOccs' :: RdrName -> [RdrName] +-- If the input is a data constructor, return both it and a type +-- constructor. This is useful when we aren't sure which we are +-- looking at. +-- +-- We use this definition instead of the GHC's to provide proper linking to +-- functions accross modules. See ticket #253 on Haddock Trac. +dataTcOccs' rdr_name + | isDataOcc occ = [rdr_name, rdr_name_tc] + | otherwise = [rdr_name] + where + occ = rdrNameOcc rdr_name + rdr_name_tc = setRdrNameSpace rdr_name tcName + outOfScope :: DynFlags -> RdrName -> Doc a outOfScope dflags x = |