From d8b79d35ddd96c83f4a3a0303011defc209aa318 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Fri, 15 Oct 2021 22:20:10 +0200 Subject: Fix after PkgQual refactoring (#1429) --- haddock-api/src/Haddock/Interface/Create.hs | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 2782f711..75789a06 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -59,7 +59,6 @@ import GHC.Data.FastString (bytesFS, unpackFS) import GHC.Driver.Ppr (showSDoc) import GHC.HsToCore.Docs hiding (mkMaps) import GHC.IORef (readIORef) -import GHC.Parser.Annotation (IsUnicodeSyntax (..)) import GHC.Stack (HasCallStack) import GHC.Tc.Types hiding (IfM) import GHC.Tc.Utils.Monad (finalSafeMode) @@ -72,14 +71,13 @@ import GHC.Types.Name.Reader (GlobalRdrEnv, greMangledName, lookupGlobalRdrEnv) import GHC.Types.Name.Set (elemNameSet, mkNameSet) import GHC.Types.SourceFile (HscSource (..)) import GHC.Types.SourceText (SourceText (..), sl_fs) +import GHC.Unit.Types import qualified GHC.Types.SrcLoc as SrcLoc import qualified GHC.Unit.Module as Module import GHC.Unit.Module.ModSummary (msHsFilePath) -import GHC.Unit.Module.Warnings (WarningTxt (..), Warnings (..)) import GHC.Unit.State (PackageName (..), UnitState, lookupModuleInAllUnits) import qualified GHC.Utils.Outputable as O import GHC.Utils.Panic (pprPanic) -import GHC.HsToCore.Docs hiding (mkMaps) import GHC.Unit.Module.Warnings newtype IfEnv m = IfEnv @@ -351,8 +349,7 @@ mkAliasMap state impDecls = -- them to the user. We should reuse that information; -- or at least reuse the renamed imports, which know what -- they import! - (fmap Module.fsToUnit $ - fmap sl_fs $ ideclPkgQual impDecl) + (ideclPkgQual impDecl) (case ideclName impDecl of SrcLoc.L _ name -> name), alias)) impDecls @@ -395,11 +392,11 @@ unrestrictedModuleImports idecls = -- Similar to GHC.lookupModule -- ezyang: Not really... lookupModuleDyn :: - UnitState -> Maybe Unit -> ModuleName -> Module -lookupModuleDyn _ (Just pkgId) mdlName = - Module.mkModule pkgId mdlName -lookupModuleDyn state Nothing mdlName = - case lookupModuleInAllUnits state mdlName of + UnitState -> PkgQual -> ModuleName -> Module +lookupModuleDyn state pkg_qual mdlName = case pkg_qual of + OtherPkg uid -> Module.mkModule (RealUnit (Definite uid)) mdlName + ThisPkg uid -> Module.mkModule (RealUnit (Definite uid)) mdlName + NoPkgQual -> case lookupModuleInAllUnits state mdlName of (m,_):_ -> m [] -> Module.mkModule Module.mainUnit mdlName -- cgit v1.2.3