diff options
author | David Waern <david.waern@gmail.com> | 2011-11-26 17:01:06 +0100 |
---|---|---|
committer | David Waern <david.waern@gmail.com> | 2011-11-26 17:01:06 +0100 |
commit | 1345132fd141b8d9b12e858ccc0765272f703e49 (patch) | |
tree | af13cc6fca295a35cf8d4d3c8391ebab5f87f83c /src/Haddock/Interface | |
parent | 3ebdc745d7bc79307986332dc71f3495099b4579 (diff) |
Allow doc comments to link to out-of-scope things (#78).
(A bug that should have been fixed long ago.)
Diffstat (limited to 'src/Haddock/Interface')
-rw-r--r-- | src/Haddock/Interface/Rename.hs | 1 | ||||
-rw-r--r-- | src/Haddock/Interface/Rn.hs | 35 |
2 files changed, 27 insertions, 9 deletions
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index 2c10146d..35ff8542 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -174,6 +174,7 @@ renameDoc d = case d of DocIdentifier x -> do x' <- rename x return (DocIdentifier x') + DocIdentifierUnchecked x -> return (DocIdentifierUnchecked x) DocModule str -> return (DocModule str) DocEmphasis doc -> do doc' <- renameDoc doc diff --git a/src/Haddock/Interface/Rn.hs b/src/Haddock/Interface/Rn.hs index 57704db7..0b5efe4b 100644 --- a/src/Haddock/Interface/Rn.hs +++ b/src/Haddock/Interface/Rn.hs @@ -4,7 +4,7 @@ import Haddock.Types import RnEnv ( dataTcOccs ) -import RdrName ( RdrName, gre_name, GlobalRdrEnv, lookupGRE_RdrName ) +import RdrName import Name ( Name, isTyConName ) import Outputable ( ppr, showSDoc ) @@ -36,14 +36,20 @@ rnDoc gre = unId . do_rn DocIdentifier x -> do let choices = dataTcOccs x - let gres = concatMap (\rdrName -> - map gre_name (lookupGRE_RdrName rdrName gre)) choices - return $ case gres of - [] -> DocMonospaced (DocString (showSDoc $ ppr x)) -- TODO: DocIdentifierRdrName - [a] -> DocIdentifier a - a:b:_ | isTyConName a -> DocIdentifier a | otherwise -> DocIdentifier b - -- If an id can refer to multiple things, we give precedence to type - -- constructors. + let names = concatMap (\c -> map gre_name (lookupGRE_RdrName c gre)) choices + return $ + case names of + [] -> + case choices of + [] -> DocMonospaced (DocString (showSDoc $ ppr x)) + [a] -> outOfScope a + a:b:_ | isRdrTc a -> outOfScope a | otherwise -> outOfScope b + [a] -> DocIdentifier a + a:b:_ | isTyConName a -> DocIdentifier a | otherwise -> DocIdentifier b + -- If an id can refer to multiple things, we give precedence to type + -- constructors. + + DocIdentifierUnchecked x -> return (DocIdentifierUnchecked x) DocModule str -> return (DocModule str) @@ -81,3 +87,14 @@ rnDoc gre = unId . do_rn DocAName str -> return (DocAName str) DocExamples e -> return (DocExamples e) + + +outOfScope :: RdrName -> Doc a +outOfScope x = + case x of + Unqual occ -> monospaced occ + Qual mdl occ -> DocIdentifierUnchecked (mdl, occ) + Orig _ occ -> monospaced occ + Exact name -> monospaced name -- Shouldn't happen since x is out of scope + where + monospaced a = DocMonospaced (DocString (showSDoc $ ppr a)) |