@@ -4,176 +4,92 @@
44
55-- | Manipulations on import lists.
66module Ormolu.Imports
7− ( normalizeImports,
7+ ( sortImports,
88 )
99where
1010
1111import Data.Bifunctor
1212import Data.Char (isAlphaNum)
1313import Data.Function (on)
14−import Data.List (foldl', nubBy, sortBy, sortOn)
15−import Data.Map.Strict (Map)
16−import qualified Data.Map.Strict as M
17−import FastString (FastString)
14+import Data.Generics (gcompare)
15+import Data.List (nubBy, sortBy)
1816import GHC hiding (GhcPs, IE)
1917import GHC.Hs.Extension
2018import GHC.Hs.ImpExp (IE (..))
2119import Ormolu.Utils (notImplemented, showOutputable)
2220
23−-- | Sort and normalize imports.
24−normalizeImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
25−normalizeImports =
26− fmap snd
27− . M.toAscList
28− . M.fromListWith combineImports
29− . fmap (\x -> (importId x, g x))
21+-- | Sort imports by module name. This also sorts explicit import lists for
22+-- each declaration.
23+sortImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
24+sortImports = sortBy compareIdecl . fmap (fmap sortImportLists)
3025 where
31− g (L l ImportDecl {..}) =
32− L
33− l
26+ sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs
27+ sortImportLists = \case
28+ ImportDecl {..} ->
3429 ImportDecl
35− { ideclHiding = second (fmap normalizeLies) <$> ideclHiding,
30+ { ideclHiding = second (fmap sortLies) <$> ideclHiding,
3631 ..
3732 }
38− g _ = notImplemented "XImportDecl"
33+ XImportDecl x -> noExtCon x
3934
40−-- | Combine two import declarations. It should be assumed that 'ImportId's
41−-- are equal.
42−combineImports ::
43− LImportDecl GhcPs ->
44− LImportDecl GhcPs ->
45− LImportDecl GhcPs
46−combineImports (L lx ImportDecl {..}) (L _ y) =
47− L
48− lx
49− ImportDecl
50− { ideclHiding = case (ideclHiding, GHC.ideclHiding y) of
51− (Just (hiding, L l' xs), Just (_, L _ ys)) ->
52− Just (hiding, (L l' (normalizeLies (xs ++ ys))))
53− _ -> Nothing,
54− ..
55− }
56−combineImports _ _ = notImplemented "XImportDecl"
35+-- | Compare two @'LImportDecl' 'GhcPs'@ things.
36+compareIdecl :: LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering
37+compareIdecl (L _ m0) (L _ m1) =
38+ case (isPrelude n0, isPrelude n1) of
39+ (False, False) -> n0 `compare` n1
40+ (True, False) -> GT
41+ (False, True) -> LT
42+ (True, True) -> m0 `gcompare` m1
43+ where
44+ n0 = unLoc (ideclName m0)
45+ n1 = unLoc (ideclName m1)
46+ isPrelude = (== "Prelude") . moduleNameString
5747
58−-- | Import id, a collection of all things that justify having a separate
59−-- import entry. This is used for merging of imports. If two imports have
60−-- the same 'ImportId' they can be merged.
61−data ImportId = ImportId
62− { importIsPrelude :: Bool,
63− importIdName :: ModuleName,
64− importPkgQual :: Maybe FastString,
65− importSource :: Bool,
66− importSafe :: Bool,
67− importQualified :: Bool,
68− importImplicit :: Bool,
69− importAs :: Maybe ModuleName,
70− importHiding :: Maybe Bool
71− }
72− deriving (Eq, Ord)
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)
7354
74−-- | Obtain an 'ImportId' for a given import.
75−importId :: LImportDecl GhcPs -> ImportId
76−importId (L _ ImportDecl {..}) =
77− ImportId
78− { importIsPrelude = isPrelude,
79− importIdName = moduleName,
80− importPkgQual = sl_fs <$> ideclPkgQual,
81− importSource = ideclSource,
82− importSafe = ideclSafe,
83− importQualified = case ideclQualified of
84− QualifiedPre -> True
85− QualifiedPost -> True
86− NotQualified -> False,
87− importImplicit = ideclImplicit,
88− importAs = unLoc <$> ideclAs,
89− importHiding = fst <$> ideclHiding
90− }
91− where
92− isPrelude = moduleNameString moduleName == "Prelude"
93− moduleName = unLoc ideclName
94−importId _ = notImplemented "XImportDecl"
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
9561
96−-- | Normalize a collection of import\/export items.
97−normalizeLies :: [LIE GhcPs] -> [LIE GhcPs]
98−normalizeLies = sortOn (getIewn . unLoc) . M.elems . foldl' combine M.empty
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
9966 where
100− combine ::
101− Map IEWrappedNameOrd (LIE GhcPs) ->
102− LIE GhcPs ->
103− Map IEWrappedNameOrd (LIE GhcPs)
104− combine m (L new_l new) =
105− let wname = getIewn new
106− normalizeWNames =
107− nubBy (\x y -> compareLIewn x y == EQ) . sortBy compareLIewn
108− alter = \case
109− Nothing -> Just . L new_l $
110− case new of
111− IEThingWith NoExtField n wildcard g flbl ->
112− IEThingWith NoExtField n wildcard (normalizeWNames g) flbl
113− other -> other
114− Just old ->
115− let f = \case
116− IEVar NoExtField n -> IEVar NoExtField n
117− IEThingAbs NoExtField _ -> new
118− IEThingAll NoExtField n -> IEThingAll NoExtField n
119− IEThingWith NoExtField n wildcard g flbl ->
120− case new of
121− IEVar NoExtField _ ->
122− error "Ormolu.Imports broken presupposition"
123− IEThingAbs NoExtField _ ->
124− IEThingWith NoExtField n wildcard g flbl
125− IEThingAll NoExtField n' ->
126− IEThingAll NoExtField n'
127− IEThingWith NoExtField n' wildcard' g' flbl' ->
128− let combinedWildcard =
129− case (wildcard, wildcard') of
130− (IEWildcard _, _) -> IEWildcard 0
131− (_, IEWildcard _) -> IEWildcard 0
132− _ -> NoIEWildcard
133− in IEThingWith
134− NoExtField
135− n'
136− combinedWildcard
137− (normalizeWNames (g <> g'))
138− flbl'
139− IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"
140− IEGroup NoExtField _ _ -> notImplemented "IEGroup"
141− IEDoc NoExtField _ -> notImplemented "IEDoc"
142− IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"
143− XIE x -> noExtCon x
144− IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"
145− IEGroup NoExtField _ _ -> notImplemented "IEGroup"
146− IEDoc NoExtField _ -> notImplemented "IEDoc"
147− IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"
148− XIE x -> noExtCon x
149− in Just (f <$> old)
150− in M.alter alter wname m
67+ f (x, xall) (y, yall) =
68+ case x `compareIewn` y of
69+ EQ -> xall `compare` yall
70+ ordering -> ordering
15171
152−-- | A wrapper for @'IEWrappedName' 'RdrName'@ that allows us to define an
153−-- 'Ord' instance for it.
154−newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName)
155− deriving (Eq)
72+-- | The same as 'compareLIEAll'.
73+compareLIE :: LIE GhcPs -> LIE GhcPs -> Ordering
74+compareLIE = compareIewn `on` fst . getIewn . unLoc
15675
157−instance Ord IEWrappedNameOrd where
158− compare (IEWrappedNameOrd x) (IEWrappedNameOrd y) = compareIewn x y
76+-- | Indication whether or not a wildcard is used by an import item.
77+data IEWild = All | NoWild
78+ deriving (Eq, Ord)
15979
16080-- | Project @'IEWrappedName' 'RdrName'@ from @'IE' 'GhcPs'@.
161−getIewn :: IE GhcPs -> IEWrappedNameOrd
81+getIewn :: IE GhcPs -> (IEWrappedName RdrName, IEWild)
16282getIewn = \case
163− IEVar NoExtField x -> IEWrappedNameOrd (unLoc x)
164− IEThingAbs NoExtField x -> IEWrappedNameOrd (unLoc x)
165− IEThingAll NoExtField x -> IEWrappedNameOrd (unLoc x)
166− IEThingWith NoExtField x _ _ _ -> IEWrappedNameOrd (unLoc x)
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)
16787 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"
16888 IEGroup NoExtField _ _ -> notImplemented "IEGroup"
16989 IEDoc NoExtField _ -> notImplemented "IEDoc"
17090 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"
17191 XIE x -> noExtCon x
17292
173−-- | Like 'compareIewn' for located wrapped names.
174−compareLIewn :: LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering
175−compareLIewn = compareIewn `on` unLoc
176−
17793-- | Compare two @'IEWrapppedName' 'RdrName'@ things.
17894compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
17995compareIewn (IEName x) (IEName y) = unLoc x `compareRdrName` unLoc y