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))  | 
