Implement merging of imports
I.e. not merging of items inside one import, but merging imports of the same module (and the same qualified name, if present etc.)
parent
2ff31d5811
commit
9103ed55c2
|
|
@ -0,0 +1,45 @@
|
|||
#group feature/import-merging
|
||||
|
||||
|
||||
#golden merge imports down to constructor-level
|
||||
import Data.Bool ( Bool(True) )
|
||||
import Data.Bool ( Bool(False) )
|
||||
#expected
|
||||
import Data.Bool ( Bool(False, True) )
|
||||
|
||||
#golden wildcard trumps explicit+hiding
|
||||
import Data.Map ( Map )
|
||||
import Data.Map
|
||||
import Data.Map hiding ( toList )
|
||||
#expected
|
||||
import Data.Map
|
||||
|
||||
#golden explicit+hiding do not merge for now
|
||||
import Data.Map ( Map )
|
||||
import Data.Map hiding ( toList )
|
||||
#expected
|
||||
import Data.Map ( Map )
|
||||
import Data.Map hiding ( toList )
|
||||
|
||||
#golden hiding+hiding do not merge for now
|
||||
import Data.Map hiding ( toList )
|
||||
import Data.Map hiding ( fromList )
|
||||
#expected
|
||||
import Data.Map hiding ( toList )
|
||||
import Data.Map hiding ( fromList )
|
||||
|
||||
#golden qualified and qualified-as merge but separately
|
||||
import qualified Data.Map ( toList )
|
||||
import qualified Data.Map ( fromList )
|
||||
import qualified Data.Map as M
|
||||
( Map )
|
||||
import qualified Data.Map as M
|
||||
( take )
|
||||
#expected
|
||||
import qualified Data.Map ( fromList
|
||||
, toList
|
||||
)
|
||||
import qualified Data.Map as M
|
||||
( Map
|
||||
, take
|
||||
)
|
||||
|
|
@ -47,6 +47,7 @@ import GHC ( AddEpAnn(AddEpAnn)
|
|||
)
|
||||
, SrcSpanAnn'(SrcSpanAnn)
|
||||
, anchor
|
||||
, getLoc
|
||||
, ideclName
|
||||
, moduleName
|
||||
, moduleNameString
|
||||
|
|
@ -63,6 +64,7 @@ import GHC.Types.Name.Reader ( RdrName
|
|||
, Unqual
|
||||
)
|
||||
)
|
||||
import GHC.Types.SourceText ( SourceText(NoSourceText) )
|
||||
import qualified GHC.OldList as List
|
||||
import GHC.Parser.Annotation ( DeltaPos
|
||||
( DifferentLine
|
||||
|
|
@ -88,16 +90,15 @@ import Language.Haskell.Brittany.Internal.Types
|
|||
|
||||
|
||||
extractDeclMap :: GHC.ParsedSource -> Map GHC.RealSrcSpan [String]
|
||||
extractDeclMap modul =
|
||||
Map.fromList
|
||||
[ ( case span of
|
||||
GHC.RealSrcSpan s _ -> s
|
||||
GHC.UnhelpfulSpan _ -> error "unexpected UnhelpfulSpan"
|
||||
, getDeclBindingNames decl
|
||||
)
|
||||
| decl <- decls
|
||||
, let (L (GHC.SrcSpanAnn _ span) _) = decl
|
||||
]
|
||||
extractDeclMap modul = Map.fromList
|
||||
[ ( case span of
|
||||
GHC.RealSrcSpan s _ -> s
|
||||
GHC.UnhelpfulSpan _ -> error "unexpected UnhelpfulSpan"
|
||||
, getDeclBindingNames decl
|
||||
)
|
||||
| decl <- decls
|
||||
, let (L (GHC.SrcSpanAnn _ span) _) = decl
|
||||
]
|
||||
where (L _ (GHC.HsModule _ _ _ _ _ decls _ _)) = modul
|
||||
|
||||
splitModuleDecls :: GHC.ParsedSource -> FinalList ModuleElement ExactPrint.Pos
|
||||
|
|
@ -140,7 +141,7 @@ splitModuleDecls lmod = do
|
|||
spanAfterImports <- do
|
||||
finalYield $ MEExactModuleHead moduleWithoutComments
|
||||
pure
|
||||
$ maybe (0, 1) (ExactPrint.ss2posEnd)
|
||||
$ maybe (0, 1) ExactPrint.ss2posEnd
|
||||
$ maximumMay
|
||||
$ [ GHC.anchor a
|
||||
| L a _ <- GHC.priorComments $ case hsModAnn' of
|
||||
|
|
@ -265,7 +266,7 @@ enrichDecls lastSpanEnd = \case
|
|||
data ImportLine
|
||||
= EmptyLines Int
|
||||
| SamelineComment (Int, LEpaComment)
|
||||
| NewlineComment (Int, LEpaComment) -- indentation and comment
|
||||
| NewlineComment (Int, LEpaComment) -- indentation and comment
|
||||
| ImportStatement ImportStatementRecord
|
||||
|
||||
instance Show ImportLine where
|
||||
|
|
@ -274,8 +275,10 @@ instance Show ImportLine where
|
|||
SamelineComment{} -> "SamelineComment"
|
||||
NewlineComment{} -> "NewlineComment"
|
||||
ImportStatement r ->
|
||||
"ImportStatement " ++ show (length $ commentsBefore r) ++ " " ++ show
|
||||
(length $ commentsAfter r)
|
||||
"ImportStatement "
|
||||
++ show (length $ commentsBefore r)
|
||||
++ " "
|
||||
++ show (length $ commentsAfter r)
|
||||
|
||||
data ImportStatementRecord = ImportStatementRecord
|
||||
{ commentsBefore :: [(Int, LEpaComment)]
|
||||
|
|
@ -286,8 +289,10 @@ data ImportStatementRecord = ImportStatementRecord
|
|||
|
||||
instance Show ImportStatementRecord where
|
||||
show r =
|
||||
"ImportStatement " ++ show (length $ commentsBefore r) ++ " " ++ show
|
||||
(length $ commentsAfter r)
|
||||
"ImportStatement "
|
||||
++ show (length $ commentsBefore r)
|
||||
++ " "
|
||||
++ show (length $ commentsAfter r)
|
||||
|
||||
|
||||
transformToImportLine
|
||||
|
|
@ -341,8 +346,9 @@ transformToImportLine startPos is =
|
|||
in
|
||||
flattenDecls is startPos
|
||||
|
||||
data Partial = PartialCommsOnly [(Int, LEpaComment)]
|
||||
| PartialImport ImportStatementRecord
|
||||
data Partial
|
||||
= PartialCommsOnly [(Int, LEpaComment)]
|
||||
| PartialImport ImportStatementRecord
|
||||
|
||||
groupifyImportLines :: [ImportLine] -> [ImportLine]
|
||||
groupifyImportLines ls = finalToList_ $ go (PartialCommsOnly []) ls
|
||||
|
|
@ -404,18 +410,8 @@ groupifyImportLines ls = finalToList_ $ go (PartialCommsOnly []) ls
|
|||
|
||||
sortCommentedImports :: [ImportLine] -> [ImportLine]
|
||||
sortCommentedImports =
|
||||
-- TODO92 we don't need this unpackImports, it is implied later in the process
|
||||
mergeGroups . map (fmap (sortGroups)) . groupify
|
||||
mergeGroups . map (fmap (combineImports . sortGroups)) . groupify
|
||||
where
|
||||
-- unpackImports :: [ImportLine] -> [ImportLine]
|
||||
-- unpackImports xs = xs >>= \case
|
||||
-- l@EmptyLines{} -> [l]
|
||||
-- l@NewlineComment{} -> [l]
|
||||
-- l@SamelineComment{} -> [l]
|
||||
-- ImportStatement r ->
|
||||
-- map NewlineComment (commentsBefore r) ++ [ImportStatement r] ++ map
|
||||
-- NewlineComment
|
||||
-- (commentsAfter r)
|
||||
mergeGroups :: [Either ImportLine [ImportStatementRecord]] -> [ImportLine]
|
||||
mergeGroups xs = xs >>= \case
|
||||
Left x -> [x]
|
||||
|
|
@ -423,6 +419,61 @@ sortCommentedImports =
|
|||
sortGroups :: [ImportStatementRecord] -> [ImportStatementRecord]
|
||||
sortGroups = List.sortOn
|
||||
(moduleNameString . unLoc . ideclName . unLoc . importStatement)
|
||||
combineImports :: [ImportStatementRecord] -> [ImportStatementRecord]
|
||||
combineImports = go Nothing
|
||||
where
|
||||
go Nothing [] = []
|
||||
go (Just r1) [] = [r1]
|
||||
go Nothing (r2 : rs) = go (Just r2) rs
|
||||
go (Just r1) (r2 : rs) = case (unpack r1, unpack r2) of
|
||||
(Nothing, _ ) -> r1 : go (Just r2) rs
|
||||
(_ , Nothing) -> r1 : go (Just r2) rs
|
||||
(Just u1, Just u2) ->
|
||||
let
|
||||
(modName1, pkg1, src1, safe1, q1, alias1, mllies1) = u1
|
||||
(modName2, pkg2, src2, safe2, q2, alias2, mllies2) = u2
|
||||
inner1 = GHC.unLoc $ importStatement r1
|
||||
mostThingsEqual =
|
||||
modName1 == modName2
|
||||
&& pkg1 == pkg2
|
||||
&& src1 == src2
|
||||
&& safe1 == safe2
|
||||
&& ((q1 == GHC.NotQualified) == (q2 == GHC.NotQualified))
|
||||
&& (unLoc <$> alias1) == (unLoc <$> alias2)
|
||||
merged explicits =
|
||||
go
|
||||
(Just ImportStatementRecord
|
||||
{ commentsBefore = commentsBefore r1 ++ commentsBefore r2
|
||||
, importStatement =
|
||||
L (getLoc $ importStatement r1) GHC.ImportDecl
|
||||
{ GHC.ideclExt = GHC.ideclExt inner1
|
||||
, GHC.ideclSourceSrc = NoSourceText
|
||||
, GHC.ideclName = GHC.ideclName inner1
|
||||
, GHC.ideclPkgQual = pkg1
|
||||
, GHC.ideclSource = src1
|
||||
, GHC.ideclSafe = safe1
|
||||
, GHC.ideclQualified = q1
|
||||
, GHC.ideclImplicit = False
|
||||
, GHC.ideclAs = alias1
|
||||
, GHC.ideclHiding = explicits
|
||||
}
|
||||
, commentsSameline = ( commentsSameline r1
|
||||
++ commentsSameline r2
|
||||
)
|
||||
, commentsAfter = commentsAfter r1 ++ commentsAfter r2
|
||||
}
|
||||
)
|
||||
rs
|
||||
in case (mostThingsEqual, mllies1, mllies2) of
|
||||
(True, Nothing , _ ) -> merged Nothing
|
||||
(True, _ , Nothing ) -> merged Nothing
|
||||
(True, Just (False, l1), Just (False, l2)) -> merged
|
||||
(Just (False, L (getLoc l1) (unLoc l1 ++ unLoc l2)))
|
||||
_ -> r1 : go (Just r2) rs
|
||||
unpack x = case unLoc $ importStatement x of
|
||||
GHC.ImportDecl _ _ (L _ modName) pkg src safe q False alias mllies ->
|
||||
Just (modName, pkg, src, safe, q, alias, mllies)
|
||||
_ -> Nothing
|
||||
groupify :: [ImportLine] -> [Either ImportLine [ImportStatementRecord]]
|
||||
groupify cs = go [] cs
|
||||
where
|
||||
|
|
@ -450,7 +501,7 @@ rdrNameToText (Exact name) = Text.pack $ getOccString name
|
|||
|
||||
getDeclBindingNames :: GHC.LHsDecl GhcPs -> [String]
|
||||
getDeclBindingNames (L _ decl) = case decl of
|
||||
GHC.SigD _ (GHC.TypeSig _ ns _) ->
|
||||
ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)
|
||||
GHC.SigD _ (GHC.TypeSig _ ns _) -> ns <&> \(L _ n) ->
|
||||
Text.unpack (rdrNameToText n)
|
||||
GHC.ValD _ (GHC.FunBind _ (L _ n) _ _) -> [Text.unpack $ rdrNameToText n]
|
||||
_ -> []
|
||||
|
|
|
|||
Loading…
Reference in New Issue