@@ -12,14 +12,16 @@ import Data.Bifunctor
1212import Data.Char (isAlphaNum)
1313import Data.Function (on)
1414import Data.Generics (gcompare)
15−import Data.List (nubBy, sortBy)
15+import Data.List (foldl', nubBy, sortBy, sortOn)
16+import Data.Map.Strict (Map)
17+import qualified Data.Map.Strict as M
1618import GHC hiding (GhcPs, IE)
1719import GHC.Hs.Extension
1820import GHC.Hs.ImpExp (IE (..))
1921import Ormolu.Utils (notImplemented, showOutputable)
2022
21−-- | Sort imports by module name. This also sorts explicit import lists for
22−-- each declaration.
23+-- | Sort imports by module name. This also sorts and normalizes explicit
24+-- import lists for each declaration.
2325sortImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
2426sortImports = sortBy compareIdecl . fmap (fmap sortImportLists)
2527 where
@@ -27,7 +29,7 @@ sortImports = sortBy compareIdecl . fmap (fmap sortImportLists)
2729 sortImportLists = \case
2830 ImportDecl {..} ->
2931 ImportDecl
30− { ideclHiding = second (fmap sortLies) <$> ideclHiding,
32+ { ideclHiding = second (fmap normalizeLies) <$> ideclHiding,
3133 ..
3234 }
3335 XImportDecl x -> noExtCon x
@@ -45,51 +47,87 @@ compareIdecl (L _ m0) (L _ m1) =
4547 n1 = unLoc (ideclName m1)
4648 isPrelude = (== "Prelude") . moduleNameString
4749
48−-- | Sort located import or export, dropping duplicates.
49−sortLies :: [LIE GhcPs] -> [LIE GhcPs]
50−sortLies =
51− nubBy (\x y -> compareLIE x y == EQ)
52− . sortBy compareLIEAll
53− . fmap (fmap sortThings)
54−
55−-- | Sort imports\/exports inside of 'IEThingWith'.
56−sortThings :: IE GhcPs -> IE GhcPs
57−sortThings = \case
58− IEThingWith NoExtField x w xs fl ->
59− IEThingWith NoExtField x w (sortBy (compareIewn `on` unLoc) xs) fl
60− other -> other
61−
62−-- | Compare a pair of located imports or exports taking into account
63−-- wildcards.
64−compareLIEAll :: LIE GhcPs -> LIE GhcPs -> Ordering
65−compareLIEAll = f `on` getIewn . unLoc
50+-- | Normalize a collection of import\/export items.
51+normalizeLies :: [LIE GhcPs] -> [LIE GhcPs]
52+normalizeLies = sortOn (getIewn . unLoc) . M.elems . foldl' combine M.empty
6653 where
67− f (x, xall) (y, yall) =
68− case x `compareIewn` y of
69− EQ -> xall `compare` yall
70− ordering -> ordering
54+ combine ::
55+ Map IEWrappedNameOrd (LIE GhcPs) ->
56+ LIE GhcPs ->
57+ Map IEWrappedNameOrd (LIE GhcPs)
58+ combine m (L new_l new) =
59+ let wname = getIewn new
60+ normalizeWNames =
61+ nubBy (\x y -> compareLIewn x y == EQ) . sortBy compareLIewn
62+ alter = \case
63+ Nothing -> Just . L new_l $
64+ case new of
65+ IEThingWith NoExtField n wildcard g flbl ->
66+ IEThingWith NoExtField n wildcard (normalizeWNames g) flbl
67+ other -> other
68+ Just old ->
69+ let f = \case
70+ IEVar NoExtField n -> IEVar NoExtField n
71+ IEThingAbs NoExtField _ -> new
72+ IEThingAll NoExtField n -> IEThingAll NoExtField n
73+ IEThingWith NoExtField n wildcard g flbl ->
74+ case new of
75+ IEVar NoExtField _ ->
76+ error "Ormolu.Imports broken presupposition"
77+ IEThingAbs NoExtField _ ->
78+ IEThingWith NoExtField n wildcard g flbl
79+ IEThingAll NoExtField n' ->
80+ IEThingAll NoExtField n'
81+ IEThingWith NoExtField n' wildcard' g' flbl' ->
82+ let combinedWildcard =
83+ case (wildcard, wildcard') of
84+ (IEWildcard _, _) -> IEWildcard 0
85+ (_, IEWildcard _) -> IEWildcard 0
86+ _ -> NoIEWildcard
87+ in IEThingWith
88+ NoExtField
89+ n'
90+ combinedWildcard
91+ (normalizeWNames (g <> g'))
92+ flbl'
93+ IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"
94+ IEGroup NoExtField _ _ -> notImplemented "IEGroup"
95+ IEDoc NoExtField _ -> notImplemented "IEDoc"
96+ IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"
97+ XIE x -> noExtCon x
98+ IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"
99+ IEGroup NoExtField _ _ -> notImplemented "IEGroup"
100+ IEDoc NoExtField _ -> notImplemented "IEDoc"
101+ IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"
102+ XIE x -> noExtCon x
103+ in Just (f <$> old)
104+ in M.alter alter wname m
71105
72−-- | The same as 'compareLIEAll'.
73−compareLIE :: LIE GhcPs -> LIE GhcPs -> Ordering
74−compareLIE = compareIewn `on` fst . getIewn . unLoc
106+-- | A wrapper for @'IEWrappedName' 'RdrName'@ that allows us to define an
107+-- 'Ord' instance for it.
108+newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName)
109+ deriving (Eq)
75110
76−-- | Indication whether or not a wildcard is used by an import item.
77−data IEWild = All | NoWild
78− deriving (Eq, Ord)
111+instance Ord IEWrappedNameOrd where
112+ compare (IEWrappedNameOrd x) (IEWrappedNameOrd y) = compareIewn x y
79113
80114-- | Project @'IEWrappedName' 'RdrName'@ from @'IE' 'GhcPs'@.
81−getIewn :: IE GhcPs -> (IEWrappedName RdrName, IEWild)
115+getIewn :: IE GhcPs -> IEWrappedNameOrd
82116getIewn = \case
83− IEVar NoExtField x -> (unLoc x, NoWild)
84− IEThingAbs NoExtField x -> (unLoc x, NoWild)
85− IEThingAll NoExtField x -> (unLoc x, All)
86− IEThingWith NoExtField x _ _ _ -> (unLoc x, NoWild)
117+ IEVar NoExtField x -> IEWrappedNameOrd (unLoc x)
118+ IEThingAbs NoExtField x -> IEWrappedNameOrd (unLoc x)
119+ IEThingAll NoExtField x -> IEWrappedNameOrd (unLoc x)
120+ IEThingWith NoExtField x _ _ _ -> IEWrappedNameOrd (unLoc x)
87121 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"
88122 IEGroup NoExtField _ _ -> notImplemented "IEGroup"
89123 IEDoc NoExtField _ -> notImplemented "IEDoc"
90124 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"
91125 XIE x -> noExtCon x
92126
127+-- | Like 'compareIewn' for located wrapped names.
128+compareLIewn :: LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering
129+compareLIewn = compareIewn `on` unLoc
130+
93131-- | Compare two @'IEWrapppedName' 'RdrName'@ things.
94132compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
95133compareIewn (IEName x) (IEName y) = unLoc x `compareRdrName` unLoc y