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

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,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 (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]
@@ -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 _) ->
+  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]
   _ -> []