diff options
| author | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2013-08-29 23:21:30 +0100 | 
|---|---|---|
| committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2013-09-02 23:21:43 +0100 | 
| commit | 87f255f4407e4548083c8c87d27cdfab08a1f504 (patch) | |
| tree | c3d96d1d78ae9f8e38d49e1272d32da0abc1effd /src/Haddock | |
| parent | 355087a58416683f16d65457577ef4b575b55a64 (diff) | |
Fixes #253
Diffstat (limited to 'src/Haddock')
| -rw-r--r-- | src/Haddock/Interface/LexParseRn.hs | 18 | 
1 files changed, 16 insertions, 2 deletions
| 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 = | 
