[Git][ghc/ghc][wip/sol/reexported-error-message-refactor] Refactoring: De-obfuscate `GHC.Unit.State.ModuleOrigin.fromOrigUnit`

25 Jun 2026


      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.

    

Simon Hengel (＠sol)

tags

participants (1)