diff options
| -rw-r--r-- | compiler/GHC/Unit/State.hs | 22 |
1 files changed, 10 insertions, 12 deletions
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs index 17d39d1590..cea7537773 100644 --- a/compiler/GHC/Unit/State.hs +++ b/compiler/GHC/Unit/State.hs @@ -1105,31 +1105,29 @@ findWiredInUnits logger prec_map pkgs vis_map = do -- available. -- findWiredInUnit :: [UnitInfo] -> UnitId -> IO (Maybe (UnitId, UnitInfo)) - findWiredInUnit pkgs wired_pkg = - let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ] - all_exposed_ps = - [ p | p <- all_ps - , Map.member (mkUnit p) vis_map ] in - case all_exposed_ps of - [] -> case all_ps of - [] -> notfound - many -> pick (head (sortByPreference prec_map many)) - many -> pick (head (sortByPreference prec_map many)) + findWiredInUnit pkgs wired_pkg = firstJustsM [try all_exposed_ps, try all_ps, notfound] where + all_ps = [ p | p <- pkgs, p `matches` wired_pkg ] + all_exposed_ps = [ p | p <- all_ps, Map.member (mkUnit p) vis_map ] + + try ps = case sortByPreference prec_map ps of + p:_ -> Just <$> pick p + _ -> pure Nothing + notfound = do debugTraceMsg logger 2 $ text "wired-in package " <> ftext (unitIdFS wired_pkg) <> text " not found." return Nothing - pick :: UnitInfo -> IO (Maybe (UnitId, UnitInfo)) + pick :: UnitInfo -> IO (UnitId, UnitInfo) pick pkg = do debugTraceMsg logger 2 $ text "wired-in package " <> ftext (unitIdFS wired_pkg) <> text " mapped to " <> ppr (unitId pkg) - return (Just (wired_pkg, pkg)) + return (wired_pkg, pkg) mb_wired_in_pkgs <- mapM (findWiredInUnit pkgs) wiredInUnitIds |