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.)

data/10-structured/module-imports.blt

@@ -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

data/12-features/import-merging.blt

@@ -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
+                                                          )

data/30-tests-context-free.blt

@@ -848,8 +848,8 @@ import Test
   )
 
 #test long-bindings
-import Test (longbindingNameThatoverflowsColum)
+import TestA (longbindingNameThatoverflowsColum)
-import Test (Long(List, Of, Things))
+import TestB (Long(List, Of, Things))
 
 #test things-with-with-comments
 import Test

source/library/Language/Haskell/Brittany/Internal/SplitExactModule.hs

@@ -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 =
+extractDeclMap modul = Map.fromList
-  Map.fromList
+  [ ( case span of
-    [ ( case span of
+        GHC.RealSrcSpan s _ -> s
-          GHC.RealSrcSpan s _ -> s
+        GHC.UnhelpfulSpan _ -> error "unexpected UnhelpfulSpan"
-          GHC.UnhelpfulSpan _ -> error "unexpected UnhelpfulSpan"
+    , getDeclBindingNames decl
-      , getDeclBindingNames decl
+    )
-      )
+  | decl <- decls
-    | decl <- decls
+  , let (L (GHC.SrcSpanAnn _ span) _) = decl
-    , 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
+      "ImportStatement "
-        (length $ commentsAfter r)
+        ++ 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
+    "ImportStatement "
-      (length $ commentsAfter r)
+      ++ 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)]
+data Partial
-             | PartialImport ImportStatementRecord
+  = 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 (combineImports . sortGroups)) . groupify
-  mergeGroups . map (fmap (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@EmptyLines{} : rest) -> Left l : go [] rest
-      (l@NewlineComment{}  : 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@EmptyLines{} : rest) -> Right (reverse acc) : Left l : go [] rest
-      (l@NewlineComment{}  : rest) -> Left l : Right (reverse acc) : 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
+      (ImportStatement r : rest) -> go (r : acc) rest
-      []                           -> [Right (reverse acc)]
+      [] -> [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 _) ->
+  GHC.SigD _ (GHC.TypeSig _ ns _) -> ns <&> \(L _ n) ->
-    ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)
+    Text.unpack (rdrNameToText n)
   GHC.ValD _ (GHC.FunBind _ (L _ n) _ _) -> [Text.unpack $ rdrNameToText n]
   _ -> []