{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Ormolu.Imports
( normalizeImports,
)
where
import Data.Bifunctor
import Data.Char (isAlphaNum)
import Data.Foldable (toList)
import Data.Function (on)
import Data.List (foldl', nubBy, sortBy, sortOn)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import GHC.Data.FastString (FastString)
import GHC.Hs.Extension
import GHC.Hs.ImpExp as GHC
import GHC.Types.Basic
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import GHC.Unit.Module.Name
import GHC.Unit.Types
import Ormolu.Utils (groupBy', notImplemented, separatedByBlank, showOutputable)
normalizeImports :: Bool -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]
normalizeImports :: Bool -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]
normalizeImports Bool
preserveGroups =
([LImportDecl GhcPs] -> [LImportDecl GhcPs])
-> [[LImportDecl GhcPs]] -> [[LImportDecl GhcPs]]
forall a b. (a -> b) -> [a] -> [b]
map
( ((ImportId, LImportDecl GhcPs) -> LImportDecl GhcPs)
-> [(ImportId, LImportDecl GhcPs)] -> [LImportDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ImportId, LImportDecl GhcPs) -> LImportDecl GhcPs
forall a b. (a, b) -> b
snd
([(ImportId, LImportDecl GhcPs)] -> [LImportDecl GhcPs])
-> ([LImportDecl GhcPs] -> [(ImportId, LImportDecl GhcPs)])
-> [LImportDecl GhcPs]
-> [LImportDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ImportId (LImportDecl GhcPs) -> [(ImportId, LImportDecl GhcPs)]
forall k a. Map k a -> [(k, a)]
M.toAscList
(Map ImportId (LImportDecl GhcPs)
-> [(ImportId, LImportDecl GhcPs)])
-> ([LImportDecl GhcPs] -> Map ImportId (LImportDecl GhcPs))
-> [LImportDecl GhcPs]
-> [(ImportId, LImportDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs)
-> [(ImportId, LImportDecl GhcPs)]
-> Map ImportId (LImportDecl GhcPs)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs
combineImports
([(ImportId, LImportDecl GhcPs)]
-> Map ImportId (LImportDecl GhcPs))
-> ([LImportDecl GhcPs] -> [(ImportId, LImportDecl GhcPs)])
-> [LImportDecl GhcPs]
-> Map ImportId (LImportDecl GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LImportDecl GhcPs -> (ImportId, LImportDecl GhcPs))
-> [LImportDecl GhcPs] -> [(ImportId, LImportDecl GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\LImportDecl GhcPs
x -> (LImportDecl GhcPs -> ImportId
importId LImportDecl GhcPs
x, LImportDecl GhcPs -> LImportDecl GhcPs
forall l.
GenLocated l (ImportDecl GhcPs) -> GenLocated l (ImportDecl GhcPs)
g LImportDecl GhcPs
x))
)
([[LImportDecl GhcPs]] -> [[LImportDecl GhcPs]])
-> ([LImportDecl GhcPs] -> [[LImportDecl GhcPs]])
-> [LImportDecl GhcPs]
-> [[LImportDecl GhcPs]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. if Bool
preserveGroups
then (NonEmpty (LImportDecl GhcPs) -> [LImportDecl GhcPs])
-> [NonEmpty (LImportDecl GhcPs)] -> [[LImportDecl GhcPs]]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty (LImportDecl GhcPs) -> [LImportDecl GhcPs]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([NonEmpty (LImportDecl GhcPs)] -> [[LImportDecl GhcPs]])
-> ([LImportDecl GhcPs] -> [NonEmpty (LImportDecl GhcPs)])
-> [LImportDecl GhcPs]
-> [[LImportDecl GhcPs]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LImportDecl GhcPs -> LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> [NonEmpty (LImportDecl GhcPs)]
forall a. (a -> a -> Bool) -> [a] -> [NonEmpty a]
groupBy' (\LImportDecl GhcPs
x LImportDecl GhcPs
y -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (LImportDecl GhcPs -> SrcSpan)
-> LImportDecl GhcPs -> LImportDecl GhcPs -> Bool
forall a. (a -> SrcSpan) -> a -> a -> Bool
separatedByBlank LImportDecl GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LImportDecl GhcPs
x LImportDecl GhcPs
y)
else [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
where
g :: GenLocated l (ImportDecl GhcPs) -> GenLocated l (ImportDecl GhcPs)
g (L l
l ImportDecl {Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
IsBootInterface
SourceText
Located ModuleName
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
..}) =
l -> ImportDecl GhcPs -> GenLocated l (ImportDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L
l
l
ImportDecl :: forall pass.
XCImportDecl pass
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> IsBootInterface
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE pass])
-> ImportDecl pass
ImportDecl
{ ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = (Located [LIE GhcPs] -> Located [LIE GhcPs])
-> (Bool, Located [LIE GhcPs]) -> (Bool, Located [LIE GhcPs])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([LIE GhcPs] -> [LIE GhcPs])
-> Located [LIE GhcPs] -> Located [LIE GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [LIE GhcPs] -> [LIE GhcPs]
normalizeLies) ((Bool, Located [LIE GhcPs]) -> (Bool, Located [LIE GhcPs]))
-> Maybe (Bool, Located [LIE GhcPs])
-> Maybe (Bool, Located [LIE GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Bool, Located [LIE GhcPs])
ideclHiding,
Bool
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
IsBootInterface
SourceText
Located ModuleName
ideclExt :: XCImportDecl GhcPs
ideclSourceSrc :: SourceText
ideclName :: Located ModuleName
ideclPkgQual :: Maybe StringLiteral
ideclSource :: IsBootInterface
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclImplicit :: Bool
ideclAs :: Maybe (Located ModuleName)
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
..
}
combineImports ::
LImportDecl GhcPs ->
LImportDecl GhcPs ->
LImportDecl GhcPs
combineImports :: LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs
combineImports (L SrcSpan
lx ImportDecl {Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
IsBootInterface
SourceText
Located ModuleName
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
..}) (L SrcSpan
_ ImportDecl GhcPs
y) =
SrcSpan -> ImportDecl GhcPs -> LImportDecl GhcPs
forall l e. l -> e -> GenLocated l e
L
SrcSpan
lx
ImportDecl :: forall pass.
XCImportDecl pass
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> IsBootInterface
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE pass])
-> ImportDecl pass
ImportDecl
{ ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = case (Maybe (Bool, Located [LIE GhcPs])
ideclHiding, ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
GHC.ideclHiding ImportDecl GhcPs
y) of
(Just (Bool
hiding, L SrcSpan
l' [LIE GhcPs]
xs), Just (Bool
_, L SrcSpan
_ [LIE GhcPs]
ys)) ->
(Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool
hiding, (SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' ([LIE GhcPs] -> [LIE GhcPs]
normalizeLies ([LIE GhcPs]
xs [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a] -> [a]
++ [LIE GhcPs]
ys))))
(Maybe (Bool, Located [LIE GhcPs]),
Maybe (Bool, Located [LIE GhcPs]))
_ -> Maybe (Bool, Located [LIE GhcPs])
forall a. Maybe a
Nothing,
Bool
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
IsBootInterface
SourceText
Located ModuleName
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclExt :: XCImportDecl GhcPs
ideclSourceSrc :: SourceText
ideclName :: Located ModuleName
ideclPkgQual :: Maybe StringLiteral
ideclSource :: IsBootInterface
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclImplicit :: Bool
ideclAs :: Maybe (Located ModuleName)
..
}
data ImportId = ImportId
{ ImportId -> Bool
importIsPrelude :: Bool,
ImportId -> ModuleName
importIdName :: ModuleName,
ImportId -> Maybe FastString
importPkgQual :: Maybe FastString,
ImportId -> IsBootInterface
importSource :: IsBootInterface,
ImportId -> Bool
importSafe :: Bool,
ImportId -> Bool
importQualified :: Bool,
ImportId -> Bool
importImplicit :: Bool,
ImportId -> Maybe ModuleName
importAs :: Maybe ModuleName,
ImportId -> Maybe Bool
importHiding :: Maybe Bool
}
deriving (ImportId -> ImportId -> Bool
(ImportId -> ImportId -> Bool)
-> (ImportId -> ImportId -> Bool) -> Eq ImportId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportId -> ImportId -> Bool
$c/= :: ImportId -> ImportId -> Bool
== :: ImportId -> ImportId -> Bool
$c== :: ImportId -> ImportId -> Bool
Eq, Eq ImportId
Eq ImportId
-> (ImportId -> ImportId -> Ordering)
-> (ImportId -> ImportId -> Bool)
-> (ImportId -> ImportId -> Bool)
-> (ImportId -> ImportId -> Bool)
-> (ImportId -> ImportId -> Bool)
-> (ImportId -> ImportId -> ImportId)
-> (ImportId -> ImportId -> ImportId)
-> Ord ImportId
ImportId -> ImportId -> Bool
ImportId -> ImportId -> Ordering
ImportId -> ImportId -> ImportId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ImportId -> ImportId -> ImportId
$cmin :: ImportId -> ImportId -> ImportId
max :: ImportId -> ImportId -> ImportId
$cmax :: ImportId -> ImportId -> ImportId
>= :: ImportId -> ImportId -> Bool
$c>= :: ImportId -> ImportId -> Bool
> :: ImportId -> ImportId -> Bool
$c> :: ImportId -> ImportId -> Bool
<= :: ImportId -> ImportId -> Bool
$c<= :: ImportId -> ImportId -> Bool
< :: ImportId -> ImportId -> Bool
$c< :: ImportId -> ImportId -> Bool
compare :: ImportId -> ImportId -> Ordering
$ccompare :: ImportId -> ImportId -> Ordering
$cp1Ord :: Eq ImportId
Ord)
importId :: LImportDecl GhcPs -> ImportId
importId :: LImportDecl GhcPs -> ImportId
importId (L SrcSpan
_ ImportDecl {Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
IsBootInterface
SourceText
Located ModuleName
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
..}) =
ImportId :: Bool
-> ModuleName
-> Maybe FastString
-> IsBootInterface
-> Bool
-> Bool
-> Bool
-> Maybe ModuleName
-> Maybe Bool
-> ImportId
ImportId
{ importIsPrelude :: Bool
importIsPrelude = Bool
isPrelude,
importIdName :: ModuleName
importIdName = ModuleName
moduleName,
importPkgQual :: Maybe FastString
importPkgQual = StringLiteral -> FastString
sl_fs (StringLiteral -> FastString)
-> Maybe StringLiteral -> Maybe FastString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StringLiteral
ideclPkgQual,
importSource :: IsBootInterface
importSource = IsBootInterface
ideclSource,
importSafe :: Bool
importSafe = Bool
ideclSafe,
importQualified :: Bool
importQualified = case ImportDeclQualifiedStyle
ideclQualified of
ImportDeclQualifiedStyle
QualifiedPre -> Bool
True
ImportDeclQualifiedStyle
QualifiedPost -> Bool
True
ImportDeclQualifiedStyle
NotQualified -> Bool
False,
importImplicit :: Bool
importImplicit = Bool
ideclImplicit,
importAs :: Maybe ModuleName
importAs = Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (Located ModuleName -> ModuleName)
-> Maybe (Located ModuleName) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Located ModuleName)
ideclAs,
importHiding :: Maybe Bool
importHiding = (Bool, Located [LIE GhcPs]) -> Bool
forall a b. (a, b) -> a
fst ((Bool, Located [LIE GhcPs]) -> Bool)
-> Maybe (Bool, Located [LIE GhcPs]) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Bool, Located [LIE GhcPs])
ideclHiding
}
where
isPrelude :: Bool
isPrelude = ModuleName -> String
moduleNameString ModuleName
moduleName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Prelude"
moduleName :: ModuleName
moduleName = Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Located ModuleName
ideclName
normalizeLies :: [LIE GhcPs] -> [LIE GhcPs]
normalizeLies :: [LIE GhcPs] -> [LIE GhcPs]
normalizeLies = (LIE GhcPs -> IEWrappedNameOrd) -> [LIE GhcPs] -> [LIE GhcPs]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (IE GhcPs -> IEWrappedNameOrd
getIewn (IE GhcPs -> IEWrappedNameOrd)
-> (LIE GhcPs -> IE GhcPs) -> LIE GhcPs -> IEWrappedNameOrd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcPs -> IE GhcPs
forall l e. GenLocated l e -> e
unLoc) ([LIE GhcPs] -> [LIE GhcPs])
-> ([LIE GhcPs] -> [LIE GhcPs]) -> [LIE GhcPs] -> [LIE GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map IEWrappedNameOrd (LIE GhcPs) -> [LIE GhcPs]
forall k a. Map k a -> [a]
M.elems (Map IEWrappedNameOrd (LIE GhcPs) -> [LIE GhcPs])
-> ([LIE GhcPs] -> Map IEWrappedNameOrd (LIE GhcPs))
-> [LIE GhcPs]
-> [LIE GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map IEWrappedNameOrd (LIE GhcPs)
-> LIE GhcPs -> Map IEWrappedNameOrd (LIE GhcPs))
-> Map IEWrappedNameOrd (LIE GhcPs)
-> [LIE GhcPs]
-> Map IEWrappedNameOrd (LIE GhcPs)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map IEWrappedNameOrd (LIE GhcPs)
-> LIE GhcPs -> Map IEWrappedNameOrd (LIE GhcPs)
combine Map IEWrappedNameOrd (LIE GhcPs)
forall k a. Map k a
M.empty
where
combine ::
Map IEWrappedNameOrd (LIE GhcPs) ->
LIE GhcPs ->
Map IEWrappedNameOrd (LIE GhcPs)
combine :: Map IEWrappedNameOrd (LIE GhcPs)
-> LIE GhcPs -> Map IEWrappedNameOrd (LIE GhcPs)
combine Map IEWrappedNameOrd (LIE GhcPs)
m (L SrcSpan
new_l IE GhcPs
new) =
let wname :: IEWrappedNameOrd
wname = IE GhcPs -> IEWrappedNameOrd
getIewn IE GhcPs
new
normalizeWNames :: [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
normalizeWNames =
(LIEWrappedName RdrName -> LIEWrappedName RdrName -> Bool)
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\LIEWrappedName RdrName
x LIEWrappedName RdrName
y -> LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering
compareLIewn LIEWrappedName RdrName
x LIEWrappedName RdrName
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ) ([LIEWrappedName RdrName] -> [LIEWrappedName RdrName])
-> ([LIEWrappedName RdrName] -> [LIEWrappedName RdrName])
-> [LIEWrappedName RdrName]
-> [LIEWrappedName RdrName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering)
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering
compareLIewn
alter :: Maybe (LIE GhcPs) -> Maybe (LIE GhcPs)
alter = \case
Maybe (LIE GhcPs)
Nothing -> LIE GhcPs -> Maybe (LIE GhcPs)
forall a. a -> Maybe a
Just (LIE GhcPs -> Maybe (LIE GhcPs))
-> (IE GhcPs -> LIE GhcPs) -> IE GhcPs -> Maybe (LIE GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> IE GhcPs -> LIE GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
new_l (IE GhcPs -> Maybe (LIE GhcPs)) -> IE GhcPs -> Maybe (LIE GhcPs)
forall a b. (a -> b) -> a -> b
$
case IE GhcPs
new of
IEThingWith XIEThingWith GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
n IEWildcard
wildcard [LIEWrappedName (IdP GhcPs)]
g [Located (FieldLbl (IdP GhcPs))]
flbl ->
XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> [Located (FieldLbl (IdP GhcPs))]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [Located (FieldLbl (IdP pass))]
-> IE pass
IEThingWith NoExtField
XIEThingWith GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
n IEWildcard
wildcard ([LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
normalizeWNames [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
g) [Located (FieldLbl (IdP GhcPs))]
flbl
IE GhcPs
other -> IE GhcPs
other
Just LIE GhcPs
old ->
let f :: IE GhcPs -> IE GhcPs
f = \case
IEVar XIEVar GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
n -> XIEVar GhcPs -> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
XIEVar GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
n
IEThingAbs XIEThingAbs GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
_ -> IE GhcPs
new
IEThingAll XIEThingAll GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
n -> XIEThingAll GhcPs -> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll NoExtField
XIEThingAll GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
n
IEThingWith XIEThingWith GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
n IEWildcard
wildcard [LIEWrappedName (IdP GhcPs)]
g [Located (FieldLbl (IdP GhcPs))]
flbl ->
case IE GhcPs
new of
IEVar XIEVar GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
_ ->
String -> IE GhcPs
forall a. HasCallStack => String -> a
error String
"Ormolu.Imports broken presupposition"
IEThingAbs XIEThingAbs GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
_ ->
XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> [Located (FieldLbl (IdP GhcPs))]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [Located (FieldLbl (IdP pass))]
-> IE pass
IEThingWith NoExtField
XIEThingWith GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
n IEWildcard
wildcard [LIEWrappedName (IdP GhcPs)]
g [Located (FieldLbl (IdP GhcPs))]
flbl
IEThingAll XIEThingAll GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
n' ->
XIEThingAll GhcPs -> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll NoExtField
XIEThingAll GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
n'
IEThingWith XIEThingWith GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
n' IEWildcard
wildcard' [LIEWrappedName (IdP GhcPs)]
g' [Located (FieldLbl (IdP GhcPs))]
flbl' ->
let combinedWildcard :: IEWildcard
combinedWildcard =
case (IEWildcard
wildcard, IEWildcard
wildcard') of
(IEWildcard Int
_, IEWildcard
_) -> Int -> IEWildcard
IEWildcard Int
0
(IEWildcard
_, IEWildcard Int
_) -> Int -> IEWildcard
IEWildcard Int
0
(IEWildcard, IEWildcard)
_ -> IEWildcard
NoIEWildcard
in XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> [Located (FieldLbl (IdP GhcPs))]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [Located (FieldLbl (IdP pass))]
-> IE pass
IEThingWith
NoExtField
XIEThingWith GhcPs
NoExtField
LIEWrappedName (IdP GhcPs)
n'
IEWildcard
combinedWildcard
([LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
normalizeWNames ([LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
g [LIEWrappedName RdrName]
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a. Semigroup a => a -> a -> a
<> [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
g'))
[Located (FieldLbl (IdP GhcPs))]
flbl'
IEModuleContents XIEModuleContents GhcPs
NoExtField Located ModuleName
_ -> String -> IE GhcPs
forall a. String -> a
notImplemented String
"IEModuleContents"
IEGroup XIEGroup GhcPs
NoExtField Int
_ HsDocString
_ -> String -> IE GhcPs
forall a. String -> a
notImplemented String
"IEGroup"
IEDoc XIEDoc GhcPs
NoExtField HsDocString
_ -> String -> IE GhcPs
forall a. String -> a
notImplemented String
"IEDoc"
IEDocNamed XIEDocNamed GhcPs
NoExtField String
_ -> String -> IE GhcPs
forall a. String -> a
notImplemented String
"IEDocNamed"
IEModuleContents XIEModuleContents GhcPs
NoExtField Located ModuleName
_ -> String -> IE GhcPs
forall a. String -> a
notImplemented String
"IEModuleContents"
IEGroup XIEGroup GhcPs
NoExtField Int
_ HsDocString
_ -> String -> IE GhcPs
forall a. String -> a
notImplemented String
"IEGroup"
IEDoc XIEDoc GhcPs
NoExtField HsDocString
_ -> String -> IE GhcPs
forall a. String -> a
notImplemented String
"IEDoc"
IEDocNamed XIEDocNamed GhcPs
NoExtField String
_ -> String -> IE GhcPs
forall a. String -> a
notImplemented String
"IEDocNamed"
in LIE GhcPs -> Maybe (LIE GhcPs)
forall a. a -> Maybe a
Just (IE GhcPs -> IE GhcPs
f (IE GhcPs -> IE GhcPs) -> LIE GhcPs -> LIE GhcPs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LIE GhcPs
old)
in (Maybe (LIE GhcPs) -> Maybe (LIE GhcPs))
-> IEWrappedNameOrd
-> Map IEWrappedNameOrd (LIE GhcPs)
-> Map IEWrappedNameOrd (LIE GhcPs)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe (LIE GhcPs) -> Maybe (LIE GhcPs)
alter IEWrappedNameOrd
wname Map IEWrappedNameOrd (LIE GhcPs)
m
newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName)
deriving (IEWrappedNameOrd -> IEWrappedNameOrd -> Bool
(IEWrappedNameOrd -> IEWrappedNameOrd -> Bool)
-> (IEWrappedNameOrd -> IEWrappedNameOrd -> Bool)
-> Eq IEWrappedNameOrd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IEWrappedNameOrd -> IEWrappedNameOrd -> Bool
$c/= :: IEWrappedNameOrd -> IEWrappedNameOrd -> Bool
== :: IEWrappedNameOrd -> IEWrappedNameOrd -> Bool
$c== :: IEWrappedNameOrd -> IEWrappedNameOrd -> Bool
Eq)
instance Ord IEWrappedNameOrd where
compare :: IEWrappedNameOrd -> IEWrappedNameOrd -> Ordering
compare (IEWrappedNameOrd IEWrappedName RdrName
x) (IEWrappedNameOrd IEWrappedName RdrName
y) = IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareIewn IEWrappedName RdrName
x IEWrappedName RdrName
y
getIewn :: IE GhcPs -> IEWrappedNameOrd
getIewn :: IE GhcPs -> IEWrappedNameOrd
getIewn = \case
IEVar XIEVar GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
x -> IEWrappedName RdrName -> IEWrappedNameOrd
IEWrappedNameOrd (LIEWrappedName RdrName -> IEWrappedName RdrName
forall l e. GenLocated l e -> e
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x)
IEThingAbs XIEThingAbs GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
x -> IEWrappedName RdrName -> IEWrappedNameOrd
IEWrappedNameOrd (LIEWrappedName RdrName -> IEWrappedName RdrName
forall l e. GenLocated l e -> e
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x)
IEThingAll XIEThingAll GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
x -> IEWrappedName RdrName -> IEWrappedNameOrd
IEWrappedNameOrd (LIEWrappedName RdrName -> IEWrappedName RdrName
forall l e. GenLocated l e -> e
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x)
IEThingWith XIEThingWith GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
x IEWildcard
_ [LIEWrappedName (IdP GhcPs)]
_ [Located (FieldLbl (IdP GhcPs))]
_ -> IEWrappedName RdrName -> IEWrappedNameOrd
IEWrappedNameOrd (LIEWrappedName RdrName -> IEWrappedName RdrName
forall l e. GenLocated l e -> e
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x)
IEModuleContents XIEModuleContents GhcPs
NoExtField Located ModuleName
_ -> String -> IEWrappedNameOrd
forall a. String -> a
notImplemented String
"IEModuleContents"
IEGroup XIEGroup GhcPs
NoExtField Int
_ HsDocString
_ -> String -> IEWrappedNameOrd
forall a. String -> a
notImplemented String
"IEGroup"
IEDoc XIEDoc GhcPs
NoExtField HsDocString
_ -> String -> IEWrappedNameOrd
forall a. String -> a
notImplemented String
"IEDoc"
IEDocNamed XIEDocNamed GhcPs
NoExtField String
_ -> String -> IEWrappedNameOrd
forall a. String -> a
notImplemented String
"IEDocNamed"
compareLIewn :: LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering
compareLIewn :: LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering
compareLIewn = IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareIewn (IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering)
-> (LIEWrappedName RdrName -> IEWrappedName RdrName)
-> LIEWrappedName RdrName
-> LIEWrappedName RdrName
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LIEWrappedName RdrName -> IEWrappedName RdrName
forall l e. GenLocated l e -> e
unLoc
compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareIewn (IEName Located RdrName
x) (IEName Located RdrName
y) = Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc Located RdrName
x RdrName -> RdrName -> Ordering
`compareRdrName` Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc Located RdrName
y
compareIewn (IEName Located RdrName
_) (IEPattern Located RdrName
_) = Ordering
LT
compareIewn (IEName Located RdrName
_) (IEType Located RdrName
_) = Ordering
LT
compareIewn (IEPattern Located RdrName
_) (IEName Located RdrName
_) = Ordering
GT
compareIewn (IEPattern Located RdrName
x) (IEPattern Located RdrName
y) = Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc Located RdrName
x RdrName -> RdrName -> Ordering
`compareRdrName` Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc Located RdrName
y
compareIewn (IEPattern Located RdrName
_) (IEType Located RdrName
_) = Ordering
LT
compareIewn (IEType Located RdrName
_) (IEName Located RdrName
_) = Ordering
GT
compareIewn (IEType Located RdrName
_) (IEPattern Located RdrName
_) = Ordering
GT
compareIewn (IEType Located RdrName
x) (IEType Located RdrName
y) = Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc Located RdrName
x RdrName -> RdrName -> Ordering
`compareRdrName` Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc Located RdrName
y
compareRdrName :: RdrName -> RdrName -> Ordering
compareRdrName :: RdrName -> RdrName -> Ordering
compareRdrName RdrName
x RdrName
y =
case (RdrName -> String
getNameStr RdrName
x, RdrName -> String
getNameStr RdrName
y) of
([], []) -> Ordering
EQ
((Char
_ : String
_), []) -> Ordering
GT
([], (Char
_ : String
_)) -> Ordering
LT
((Char
x' : String
_), (Char
y' : String
_)) ->
case (Char -> Bool
isAlphaNum Char
x', Char -> Bool
isAlphaNum Char
y') of
(Bool
False, Bool
False) -> RdrName
x RdrName -> RdrName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` RdrName
y
(Bool
True, Bool
False) -> Ordering
LT
(Bool
False, Bool
True) -> Ordering
GT
(Bool
True, Bool
True) -> RdrName
x RdrName -> RdrName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` RdrName
y
where
getNameStr :: RdrName -> String
getNameStr = OccName -> String
forall o. Outputable o => o -> String
showOutputable (OccName -> String) -> (RdrName -> OccName) -> RdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc