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.)ghc92
parent
7d84705e7a
commit
812957dca4
|
|
@ -183,9 +183,9 @@ import Test ( -- comment
|
|||
)
|
||||
|
||||
#test long-bindings
|
||||
import Test ( longbindingNameThatoverflowsColum
|
||||
import TestA ( longbindingNameThatoverflowsColum
|
||||
)
|
||||
import Test ( Long
|
||||
import TestB ( Long
|
||||
( List
|
||||
, Of
|
||||
, Things
|
||||
|
|
|
|||
|
|
@ -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
|
||||
)
|
||||
|
|
@ -848,8 +848,8 @@ import Test
|
|||
)
|
||||
|
||||
#test long-bindings
|
||||
import Test (longbindingNameThatoverflowsColum)
|
||||
import Test (Long(List, Of, Things))
|
||||
import TestA (longbindingNameThatoverflowsColum)
|
||||
import TestB (Long(List, Of, Things))
|
||||
|
||||
#test things-with-with-comments
|
||||
import Test
|
||||
|
|
|
|||
|
|
@ -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,40 +410,90 @@ 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]
|
||||
Left x -> [x]
|
||||
Right y -> ImportStatement <$> y
|
||||
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 ->
|
||||
case mllies of
|
||||
Nothing -> Just (modName, pkg, src, safe, q, alias, Nothing)
|
||||
Just (_, (L ann _)) -> case GHC.comments $ GHC.ann ann of
|
||||
EpaComments [] -> Just (modName, pkg, src, safe, q, alias, mllies)
|
||||
EpaCommentsBalanced [] [] -> Just
|
||||
(modName, pkg, src, safe, q, alias, mllies)
|
||||
_ -> Nothing
|
||||
_ -> Nothing
|
||||
groupify :: [ImportLine] -> [Either ImportLine [ImportStatementRecord]]
|
||||
groupify cs = go [] cs
|
||||
where
|
||||
go [] = \case
|
||||
(l@EmptyLines{} : rest) -> Left l : go [] rest
|
||||
(l@NewlineComment{} : rest) -> Left l : go [] rest
|
||||
(l@EmptyLines{} : rest) -> Left l : go [] rest
|
||||
(l@NewlineComment{} : rest) -> Left l : go [] rest
|
||||
(l@SamelineComment{} : rest) -> Left l : go [] rest
|
||||
(ImportStatement r : rest) -> go [r] rest
|
||||
[] -> []
|
||||
(ImportStatement r : rest) -> go [r] rest
|
||||
[] -> []
|
||||
go acc = \case
|
||||
(l@EmptyLines{} : rest) -> Right (reverse acc) : Left l : go [] rest
|
||||
(l@NewlineComment{} : rest) -> Left l : Right (reverse acc) : go [] rest
|
||||
(l@EmptyLines{} : rest) -> Right (reverse acc) : Left l : go [] rest
|
||||
(l@NewlineComment{} : rest) -> Left l : Right (reverse acc) : go [] rest
|
||||
(l@SamelineComment{} : rest) -> Left l : Right (reverse acc) : go [] rest
|
||||
(ImportStatement r : rest) -> go (r : acc) rest
|
||||
[] -> [Right (reverse acc)]
|
||||
(ImportStatement r : rest) -> go (r : acc) rest
|
||||
[] -> [Right (reverse acc)]
|
||||
|
||||
rdrNameToText :: RdrName -> Text
|
||||
-- rdrNameToText = Text.pack . show . flip runSDoc unsafeGlobalDynFlags . ppr
|
||||
|
|
@ -450,7 +506,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