diff options
author | M Farkas-Dyck <strake888@proton.me> | 2022-08-25 11:33:46 -0800 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-09-28 22:51:59 -0400 |
commit | bc0020fa0871aff23d26b0116c1d4e43b8a3e9a9 (patch) | |
tree | 6959cf9ae1d3e0ad5b7f3a9c685d10f282445b19 | |
parent | 2f050687e75ffe6fbf140cacd15fd916d2997499 (diff) | |
download | haskell-bc0020fa0871aff23d26b0116c1d4e43b8a3e9a9.tar.gz |
Clean up `findWiredInUnit`. In particular, avoid `head`.
-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 |