aboutsummaryrefslogtreecommitdiff
path: root/haddock-api
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2019-02-26 08:46:45 -0800
committerAlec Theriault <alec.theriault@gmail.com>2019-02-26 19:14:59 -0800
commitb682041ed1cbeaf5aa501f85e4e46a6d2e39da3a (patch)
tree6ce1d082d44e12af408d8c9d9210297b846d159d /haddock-api
parenta5199600c39d25d7b71dcb2328000c1c49ad95a2 (diff)
Fix bogus identifier defaulting
This avoids a situation in which an identifier would get defaulted to a completely different identifier. Prior to this commit, the 'Bug1035' test case would hyperlink 'Foo' into 'Bar'! Fixes #1035.
Diffstat (limited to 'haddock-api')
-rw-r--r--haddock-api/src/Haddock/Interface/LexParseRn.hs14
1 files changed, 5 insertions, 9 deletions
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index faf23728..0b40ed3c 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -19,7 +19,6 @@ module Haddock.Interface.LexParseRn
, processModuleHeader
) where
-import Avail
import Control.Arrow
import Control.Monad
import Data.Functor (($>))
@@ -200,10 +199,9 @@ ambiguous :: DynFlags
-> [GlobalRdrElt] -- ^ More than one @gre@s sharing the same `RdrName` above.
-> ErrMsgM (Doc Name)
ambiguous dflags x gres = do
- let noChildren = map availName (gresToAvailInfo gres)
- dflt = maximumBy (comparing (isLocalName &&& isTyConName)) noChildren
+ let dflt = maximumBy (comparing (gre_lcl &&& isTyConName . gre_name)) gres
msg = "Warning: " ++ showNsRdrName dflags x ++ " is ambiguous. It is defined\n" ++
- concatMap (\n -> " * " ++ defnLoc n ++ "\n") (map gre_name gres) ++
+ concatMap (\n -> " * " ++ defnLoc n ++ "\n") gres ++
" You may be able to disambiguate the identifier by qualifying it or\n" ++
" by specifying the type/value namespace explicitly.\n" ++
" Defaulting to the one defined " ++ defnLoc dflt
@@ -212,12 +210,10 @@ ambiguous dflags x gres = do
-- of the same name, but not the only constructor.
-- For example, for @data D = C | D@, someone may want to reference the @D@
-- constructor.
- when (length noChildren > 1) $ tell [msg]
- pure (DocIdentifier (x $> dflt))
+ when (length (gresToAvailInfo gres) > 1) $ tell [msg]
+ pure (DocIdentifier (x $> gre_name dflt))
where
- isLocalName (nameSrcLoc -> RealSrcLoc {}) = True
- isLocalName _ = False
- defnLoc = showSDoc dflags . pprNameDefnLoc
+ defnLoc = showSDoc dflags . pprNameDefnLoc . gre_name
-- | Handle value-namespaced names that cannot be for values.
--