Commit 735519b4 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Improve the reporting of module cycles, to give a nice message like this

  Module imports form a cycle:
    module `Foo4' imports `Foo'
            which imports `Foo2'
            which imports `Foo3'
            which imports `Foo4'

as requested by Bryan Richter
parent c1c2c253
...@@ -1456,20 +1456,53 @@ multiRootsErr summs@(summ1:_) ...@@ -1456,20 +1456,53 @@ multiRootsErr summs@(summ1:_)
files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
cyclicModuleErr :: [ModSummary] -> SDoc cyclicModuleErr :: [ModSummary] -> SDoc
-- From a strongly connected component we find
-- a single cycle to report
cyclicModuleErr ms cyclicModuleErr ms
= hang (ptext (sLit "Module imports form a cycle for modules:")) = ASSERT( not (null ms) )
2 (vcat (map show_one ms)) hang (ptext (sLit "Module imports form a cycle:"))
2 (show_path (shortest [] root_mod))
where where
mods_in_cycle = map ms_mod_name ms deps :: [(ModuleName, [ModuleName])]
imp_modname = unLoc . ideclName . unLoc deps = [ (moduleName (ms_mod m), get_deps m) | m <- ms ]
just_in_cycle = filter ((`elem` mods_in_cycle) . imp_modname)
get_deps :: ModSummary -> [ModuleName]
show_one ms = get_deps m = filter (\k -> Map.member k dep_env) (map unLoc (ms_home_imps m))
vcat [ show_mod (ms_hsc_src ms) (ms_mod_name ms) <+>
maybe empty (parens . text) (ml_hs_file (ms_location ms)), dep_env :: Map.Map ModuleName [ModuleName]
nest 2 $ ptext (sLit "imports:") <+> vcat [ dep_env = Map.fromList deps
pp_imps HsBootFile (just_in_cycle $ ms_srcimps ms),
pp_imps HsSrcFile (just_in_cycle $ ms_imps ms) ] -- Find the module with fewest imports among the SCC modules
] -- This is just a heuristic to find some plausible root module
show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src) root_mod :: ModuleName
pp_imps src imps = fsep (map (show_mod src . unLoc . ideclName . unLoc) imps) root_mod = fst (minWith (length . snd) deps)
shortest :: [ModuleName] -> ModuleName -> [ModuleName]
-- (shortest [v1,v2,..,vn] m) assumes that
-- m is imported by v1
-- which is imported by v2
-- ...
-- which is imported by vn
-- It retuns an import chain [w1, w2, ..wm]
-- where w1 imports w2 imports .... imports wm imports w1
shortest visited m
| m `elem` visited
= m : reverse (takeWhile (/= m) visited)
| otherwise
= minWith length (map (shortest (m:visited)) deps)
where
Just deps = Map.lookup m dep_env
show_path [] = panic "show_path"
show_path [m] = ptext (sLit "module") <+> quotes (ppr m)
<+> ptext (sLit "imports itself")
show_path (m1:m2:ms) = ptext (sLit "module") <+> quotes (ppr m1)
<+> sep ( nest 6 (ptext (sLit "imports") <+> quotes (ppr m2))
: go ms)
where
go [] = [ptext (sLit "which imports") <+> quotes (ppr m1)]
go (m:ms) = (ptext (sLit "which imports") <+> quotes (ppr m)) : go ms
minWith :: Ord b => (a -> b) -> [a] -> a
minWith get_key xs = ASSERT( not (null xs) )
head (sortWith get_key xs)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment