@@ -12,9 +12,10 @@ module Language.PureScript.Sugar.Names.Imports
1212import Prelude ()
1313import Prelude.Compat
1414
15−import Data.List (find, delete, (\\))
16−import Data.Maybe (fromMaybe, isJust, isNothing, fromJust)
1715import Data.Foldable (traverse_, for_)
16+import Data.Function (on)
17+import Data.List (find, sortBy, groupBy, (\\))
18+import Data.Maybe (fromMaybe, isNothing, fromJust)
1819import Data.Traversable (for)
1920
2021import Control.Arrow (first)
@@ -68,29 +69,23 @@ resolveImports env (Module ss coms currentModule decls exps) =
6869
6970 for_ (M.toList imports) $ \(mn, imps) -> do
7071
71− -- Better ordering for the warnings: the list is in last-import-first
72− -- order, but we want the first appearence of an import to be the primary,
73− -- and warnings to appear for later imports
74− let imps' = reverse imps
75−
76− warned <- foldM (checkDuplicateImports mn) [] (selfCartesianSubset imps')
77−
78− let unqual = filter (\(_, _, q) -> isJust q) (imps' \\ warned)
79−
80− warned' <- (warned ++) <$>
81− if (length unqual < 2)
82− then return []
83− else case find (\(_, typ, _) -> isImplicit typ) unqual of
84− Just i ->
85− for (delete i unqual) $ \i'@(pos, typ, _) -> do
86− warn pos $ RedundantUnqualifiedImport mn typ
87− return i'
88− Nothing ->
89− for (tail unqual) $ \i@(pos, _, _) -> do
90− warn pos $ DuplicateSelectiveImport mn
91− return i
92−
93− for_ (imps' \\ warned') $ \(pos, typ, _) ->
72+ warned <- foldM (checkDuplicateImports mn) [] (selfCartesianSubset imps)
73+
74+ let unwarned = imps \\ warned
75+ duplicates
76+ = join
77+ . map tail
78+ . filter ((> 1) . length)
79+ . groupBy ((==) `on` defQual)
80+ . sortBy (compare `on` defQual)
81+ $ unwarned
82+
83+ warned' <-
84+ for duplicates $ \i@(pos, _, _) -> do
85+ warn pos $ DuplicateSelectiveImport mn
86+ return i
87+
88+ for_ (imps \\ (warned ++ warned')) $ \(pos, typ, _) ->
9489 let (dupeRefs, dupeDctors) = findDuplicateRefs $ case typ of
9590 Explicit refs -> refs
9691 Hiding refs -> refs
@@ -105,6 +100,9 @@ resolveImports env (Module ss coms currentModule decls exps) =
105100 return (Module ss coms currentModule decls' exps, resolved)
106101
107102 where
103+ defQual :: ImportDef -> Maybe ModuleName
104+ defQual (_, _, q) = q
105+
108106 selfCartesianSubset :: [a] -> [(a, a)]
109107 selfCartesianSubset (x : xs) = [(x, y) | y <- xs] ++ selfCartesianSubset xs
110108 selfCartesianSubset [] = []