Simon Hengel pushed to branch wip/sol/reexported-error-message-refactor at Glasgow Haskell Compiler / GHC Commits: 3bf644b8 by Simon Hengel at 2026-06-25T14:27:28+07:00 Refactoring: De-obfuscate `GHC.Unit.State.ModuleOrigin.fromOrigUnit` (by using a proper data type instead of `Maybe Bool`) (see #27417) - - - - - 3 changed files: - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Unit/State.hs - utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs Changes: ===================================== compiler/GHC/Iface/Errors/Ppr.hs ===================================== @@ -205,7 +205,7 @@ cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInst provenance (ModOrigin{ fromOrigUnit = e, fromExposedReexport = res, fromPackageFlag = f }) - | Just True <- e + | AvailableFromExposedUnit <- e = parens (text "from" <+> ppr (moduleUnit mod)) | f && moduleName mod == m = parens (text "from" <+> ppr (moduleUnit mod)) @@ -221,7 +221,7 @@ cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInst provenance (ModUnusable _) = empty provenance (ModOrigin{ fromOrigUnit = e, fromHiddenReexport = rhs }) - | Just False <- e + | AvailableFromHiddenUnit <- e = parens (text "needs flag -package-id" <+> ppr (moduleUnit mod)) | (pkg:_) <- rhs @@ -240,7 +240,7 @@ cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInst -> vcat (map pprMod mods) where unambiguousPackages = foldl' unambiguousPackage (Just []) mods - unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) + unambiguousPackage (Just xs) (m, ModOrigin ((/= Renamed) -> True) _ _ _) = Just (moduleUnit m : xs) unambiguousPackage _ _ = Nothing GenericMissing pkg_hiddens mod_hiddens unusables files -> @@ -254,7 +254,7 @@ cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInst pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden" pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable" pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma ( - if e == Just True + if e == AvailableFromExposedUnit then [text "package" <+> ppr (moduleUnit m)] else [] ++ map ((text "a reexport in package" <+>) ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -38,6 +38,7 @@ module GHC.Unit.State ( LookupResult(..), ModuleSuggestion(..), ModuleOrigin(..), + AvailableFromOriginalUnit(..), UnusableUnit(..), UnusableUnitReason(..), pprReason, @@ -178,21 +179,26 @@ data ModuleOrigin = -- | Module is public, and could have come from some places. | ModOrigin { - -- | @Just False@ means that this module is in - -- someone's @exported-modules@ list, but that package is hidden; - -- @Just True@ means that it is available; @Nothing@ means neither - -- applies. - fromOrigUnit :: Maybe Bool + fromOrigUnit :: AvailableFromOriginalUnit -- | Is the module available from a reexport of an exposed package? -- There could be multiple. , fromExposedReexport :: [UnitInfo] - -- | Is the module available from a reexport of a hidden package? + -- | Is the module available from a reexport of a hidden unit? , fromHiddenReexport :: [UnitInfo] -- | Did the module export come from a package flag? (ToDo: track -- more information. , fromPackageFlag :: Bool } +data AvailableFromOriginalUnit = + -- | the canonical module name is different from the requested name + Renamed + -- | the module is in someone's @exposed-modules@ list, but that unit is hidden + | AvailableFromHiddenUnit + -- | the module is available from the original unit under the requested name + | AvailableFromExposedUnit + deriving (Eq, Show) + -- | A unusable unit module origin data UnusableUnit = UnusableUnit { uuUnit :: !Unit -- ^ Unusable unit @@ -205,9 +211,9 @@ instance Outputable ModuleOrigin where ppr (ModUnusable _) = text "unusable module" ppr (ModOrigin e res rhs f) = sep (punctuate comma ( (case e of - Nothing -> [] - Just False -> [text "hidden package"] - Just True -> [text "exposed package"]) ++ + Renamed -> [] + AvailableFromHiddenUnit -> [text "hidden package"] + AvailableFromExposedUnit -> [text "exposed package"]) ++ (if null res then [] else [text "reexport by" <+> @@ -222,34 +228,36 @@ instance Outputable ModuleOrigin where -- | Smart constructor for a module which is in @exposed-modules@. Takes -- as an argument whether or not the defining package is exposed. fromExposedModules :: Bool -> ModuleOrigin -fromExposedModules e = ModOrigin (Just e) [] [] False +fromExposedModules True = ModOrigin AvailableFromExposedUnit [] [] False +fromExposedModules False = ModOrigin AvailableFromHiddenUnit [] [] False -- | Smart constructor for a module which is in @reexported-modules@. Takes -- as an argument whether or not the reexporting package is exposed, and -- also its 'UnitInfo'. fromReexportedModules :: Bool -> UnitInfo -> ModuleOrigin -fromReexportedModules True pkg = ModOrigin Nothing [pkg] [] False -fromReexportedModules False pkg = ModOrigin Nothing [] [pkg] False +fromReexportedModules True pkg = ModOrigin Renamed [pkg] [] False +fromReexportedModules False pkg = ModOrigin Renamed [] [pkg] False -- | Smart constructor for a module which was bound by a package flag. fromFlag :: ModuleOrigin -fromFlag = ModOrigin Nothing [] [] True +fromFlag = ModOrigin Renamed [] [] True instance Semigroup ModuleOrigin where x@(ModOrigin e res rhs f) <> y@(ModOrigin e' res' rhs' f') = ModOrigin (g e e') (res ++ res') (rhs ++ rhs') (f || f') - where g (Just b) (Just b') - | b == b' = Just b - | otherwise = pprPanic "ModOrigin: package both exposed/hidden" $ + where + g AvailableFromHiddenUnit AvailableFromHiddenUnit = AvailableFromHiddenUnit + g AvailableFromExposedUnit AvailableFromExposedUnit = AvailableFromExposedUnit + g Renamed x = x + g x Renamed = x + g _ _ = pprPanic "ModOrigin: package both exposed/hidden" $ text "x: " <> ppr x $$ text "y: " <> ppr y - g Nothing x = x - g x Nothing = x x <> y = pprPanic "ModOrigin: module origin mismatch" $ text "x: " <> ppr x $$ text "y: " <> ppr y instance Monoid ModuleOrigin where - mempty = ModOrigin Nothing [] [] False + mempty = ModOrigin Renamed [] [] False mappend = (Semigroup.<>) -- | Is the name from the import actually visible? (i.e. does it cause @@ -257,12 +265,12 @@ instance Monoid ModuleOrigin where originVisible :: ModuleOrigin -> Bool originVisible ModHidden = False originVisible (ModUnusable _) = False -originVisible (ModOrigin b res _ f) = b == Just True || not (null res) || f +originVisible (ModOrigin b res _ f) = b == AvailableFromExposedUnit || not (null res) || f -- | Are there actually no providers for this module? This will never occur -- except when we're filtering based on package imports. originEmpty :: ModuleOrigin -> Bool -originEmpty (ModOrigin Nothing [] [] False) = True +originEmpty (ModOrigin Renamed [] [] False) = True originEmpty _ = False -- | 'UniqFM' map from 'Unit' to a 'UnitVisibility'. @@ -586,7 +594,7 @@ resolvePackageImport unit_st mn pn = do to_uid (mod, ModOrigin mo re_exps _ _) = case mo of -- Available directly, but also potentially from re-exports - Just True -> (toUnitId (moduleUnit mod)) : map unitId re_exps + AvailableFromExposedUnit -> (toUnitId (moduleUnit mod)) : map unitId re_exps -- Just available from these re-exports _ -> map unitId re_exps to_uid _ = [] @@ -1932,8 +1940,7 @@ lookupModulePackage pkgs mn mfs = case origin of ModOrigin {fromOrigUnit, fromExposedReexport} -> case fromOrigUnit of - -- Just True means, the import is available from its original location - Just True -> + AvailableFromExposedUnit -> pure [orig_unit] -- Otherwise, it must be available from a reexport _ -> pure fromExposedReexport @@ -1974,19 +1981,21 @@ lookupModuleWithSuggestions' pkgs mod_map name mb_pn -> (hidden_pkg, x:hidden_mod, unusable, exposed) ModUnusable _ -> (hidden_pkg, hidden_mod, x:unusable, exposed) - ModOrigin { fromOrigUnit = origAvailableUnderSameName, fromHiddenReexport } + ModOrigin { fromOrigUnit, fromHiddenReexport } | originEmpty origin -> (hidden_pkg, hidden_mod, unusable, exposed) | originVisible origin -> (hidden_pkg, hidden_mod, unusable, x:exposed) | otherwise - -> (reexports ++ maybe id (:) origUnit hidden_pkg, hidden_mod, unusable, exposed) + -> (reexports ++ maybe id (:) hiddenOrigUnit hidden_pkg, hidden_mod, unusable, exposed) where reexports :: [UnitInfo] reexports = sortOn unitId fromHiddenReexport - origUnit :: Maybe UnitInfo - origUnit = origAvailableUnderSameName >> lookupUnit pkgs (moduleUnit m) + hiddenOrigUnit :: Maybe UnitInfo + hiddenOrigUnit = case fromOrigUnit of + AvailableFromHiddenUnit -> lookupUnit pkgs (moduleUnit m) + _ -> Nothing unit_lookup p = lookupUnit pkgs p `orElse` pprPanic "lookupModuleWithSuggestions" (ppr p <+> ppr name) mod_unit = unit_lookup . moduleUnit @@ -2012,7 +2021,7 @@ lookupModuleWithSuggestions' pkgs mod_map name mb_pn ModOrigin { fromOrigUnit = e, fromExposedReexport = res, fromHiddenReexport = rhs } -> ModOrigin - { fromOrigUnit = if match_pkg pkg then e else Nothing + { fromOrigUnit = if match_pkg pkg then e else Renamed , fromExposedReexport = filter match_pkg res , fromHiddenReexport = filter match_pkg rhs , fromPackageFlag = False -- always excluded ===================================== utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs ===================================== @@ -85,7 +85,7 @@ attachInstances expInfo ifaces instIfaceMap isOneShot = do } ) <- nonDetUniqMapToList mod_map - , fromOrig == Just True || not (null reExp) + , fromOrig == AvailableFromExposedPackage || not (null reExp) ] mods_to_load = moduleSetElts mods -- We need to ensure orphans in modules outside of this package are included. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bf644b86455e182d31f1c5770975e47... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bf644b86455e182d31f1c5770975e47... You're receiving this email because of your account on gitlab.haskell.org.