From 8a5ccf93c53a40abe42134c2282ac9b9d653224c Mon Sep 17 00:00:00 2001 From: Adam Gundry Date: Tue, 1 Dec 2020 09:17:04 +0000 Subject: Adapt to changes to GlobalRdrElt and AvailInfo Needed for ghc/ghc!4467 --- haddock-api/src/Haddock/Interface.hs | 4 ++-- haddock-api/src/Haddock/Interface/Create.hs | 12 ++---------- haddock-api/src/Haddock/Interface/LexParseRn.hs | 4 ++-- 3 files changed, 6 insertions(+), 14 deletions(-) (limited to 'haddock-api') diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index be9bd09a..e9cd6e0d 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -61,7 +61,7 @@ import GHC.Data.FastString (unpackFS) import GHC.Tc.Types (tcg_rdr_env) import GHC.Types.Name (nameIsFromExternalPackage, nameOccName) import GHC.Types.Name.Occurrence (isTcOcc) -import GHC.Types.Name.Reader (unQualOK, gre_name, globalRdrEnvElts) +import GHC.Types.Name.Reader (unQualOK, greMangledName, globalRdrEnvElts) import GHC.Utils.Error (withTimingD) import GHC.HsToCore.Docs @@ -174,7 +174,7 @@ processModule verbosity modsum flags modMap instIfaceMap = do home_unit = hsc_home_unit hsc_env !mods = mkModuleSet [ nameModule name | gre <- globalRdrEnvElts new_rdr_env - , let name = gre_name gre + , let name = greMangledName gre , nameIsFromExternalPackage home_unit name , isTcOcc (nameOccName name) -- Types and classes only , unQualOK gre ] -- In scope unqualified diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 7ef64a94..e3263f9d 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -293,7 +293,7 @@ mkWarningMap dflags warnings gre exps = case warnings of let ws' = [ (n, w) | (occ, w) <- ws , elt <- lookupGlobalRdrEnv gre occ - , let n = gre_name elt, n `elem` exps ] + , let n = greMangledName elt, n `elem` exps ] in M.fromList <$> traverse (bitraverse pure (parseWarning dflags gre)) ws' moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name)) @@ -693,16 +693,8 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames constructor_names = filter isDataConName (availSubordinates avail) --- this heavily depends on the invariants stated in Avail -availExportsDecl :: AvailInfo -> Bool -availExportsDecl (AvailTC ty_name names _) - | n : _ <- names = ty_name == n - | otherwise = False -availExportsDecl _ = True - availSubordinates :: AvailInfo -> [Name] -availSubordinates avail = - filter (/= availName avail) (availNamesWithSelectors avail) +availSubordinates = map greNameMangledName . availSubordinateGreNames availNoDocs :: AvailInfo -> [(Name, DocForDecl Name)] availNoDocs avail = diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index 2c06438f..44c02875 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -120,7 +120,7 @@ rename dflags gre = rn -- There is only one name in the environment that matches so -- use it. - [a] -> pure (DocIdentifier (gre_name a)) + [a] -> pure (DocIdentifier (greMangledName a)) -- There are multiple names available. gres -> ambiguous dflags x gres @@ -182,7 +182,7 @@ ambiguous dflags x gres = do let noChildren = map availName (gresToAvailInfo gres) dflt = maximumBy (comparing (isLocalName &&& isTyConName)) noChildren msg = "Warning: " ++ x_str ++ " is ambiguous. It is defined\n" ++ - concatMap (\n -> " * " ++ defnLoc n ++ "\n") (map gre_name gres) ++ + concatMap (\n -> " * " ++ defnLoc n ++ "\n") (map greMangledName gres) ++ " You may be able to disambiguate the identifier by qualifying it or\n" ++ " by hiding some imports.\n" ++ " Defaulting to " ++ x_str ++ " defined " ++ defnLoc dflt -- cgit v1.2.3