From d8b79d35ddd96c83f4a3a0303011defc209aa318 Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Fri, 15 Oct 2021 22:20:10 +0200
Subject: [PATCH] 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 2782f711fb..75789a0695 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
--
GitLab