Start implementing sort/uniq on imports/exports

src/Language/Haskell/Brittany/Internal/Layouters/IE.hs

@@ -11,15 +11,14 @@ import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.LayouterBasics
 import           Language.Haskell.Brittany.Internal.Config.Types
 
-import           GHC     ( unLoc
+import           GHC                            ( unLoc
-                         , runGhc
+                                                , GenLocated(L)
-                         , GenLocated(L)
+                                                , moduleNameString
-                         , moduleNameString
+                                                , AnnKeywordId(..)
-                         , AnnKeywordId(..)
+                                                , Located
-                         , Located
+                                                , runGhc
-                         )
+                                                )
 import           HsSyn
-import           Name
 import           HsImpExp
 import           FieldLabel
 import qualified FastString
@@ -70,18 +69,19 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
       : hasAnyCommentsBelow x
       : map hasAnyCommentsBelow ns
       )
+    let sortedNs = List.sortOn wrappedNameToText ns
     runFilteredAlternative $ do
       addAlternativeCond (not hasComments)
         $  docSeq
         $  [layoutWrapped lie x, docLit $ Text.pack "("]
-        ++ intersperse docCommaSep (map nameDoc ns)
+        ++ intersperse docCommaSep (map nameDoc sortedNs)
         ++ [docParenR]
       addAlternative
         $ docWrapNodeRest lie
         $ docAddBaseY BrIndentRegular
         $ docPar
             (layoutWrapped lie x)
-            (layoutItems (splitFirstLast ns))
+            (layoutItems (splitFirstLast sortedNs))
    where
     nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName
     layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n]
@@ -137,7 +137,13 @@ layoutAnnAndSepLLIEs
   :: Located [LIE GhcPs] -> ToBriDocM [ToBriDocM BriDocNumbered]
 layoutAnnAndSepLLIEs llies@(L _ lies) = do
   let makeIENode ie = docSeq [docCommaSep, ie]
-  let ieDocs = layoutIE <$> lies
+  let sortedLies =
+        [ items
+        | group <- Data.List.Extra.groupOn lieToText
+          $ List.sortOn lieToText lies
+        , items <- mergeGroup group
+        ]
+  let ieDocs = layoutIE <$> sortedLies
   ieCommaDocs <-
     docWrapNodeRest llies $ sequence $ case splitFirstLast ieDocs of
       FirstLastEmpty        -> []
@@ -145,6 +151,39 @@ layoutAnnAndSepLLIEs llies@(L _ lies) = do
       FirstLast ie1 ieMs ieN ->
         [ie1] ++ map makeIENode ieMs ++ [makeIENode ieN]
   pure $ fmap pure ieCommaDocs -- returned shared nodes
+ where
+  mergeGroup :: [LIE GhcPs] -> [LIE GhcPs]
+  mergeGroup []        = []
+  mergeGroup items@[_] = items
+  mergeGroup items     = if
+    | all isProperIEThing items -> [List.foldl1' thingFolder items]
+    | otherwise                 -> items
+  -- proper means that if it is a ThingWith, it does not contain a wildcard
+  -- (because I don't know what a wildcard means if it is not already a
+  -- IEThingAll).
+  isProperIEThing :: LIE GhcPs -> Bool
+  isProperIEThing = \case
+    L _ (IEThingAbs _ _wn) -> True
+    L _ (IEThingAll _ _wn) -> True
+    L _ (IEThingWith _ _wn NoIEWildcard _ _) -> True
+    _ -> False
+  thingFolder :: LIE GhcPs -> LIE GhcPs -> LIE GhcPs
+  thingFolder l1@(L _ IEThingAll{}) _                     = l1
+  thingFolder _                     l2@(L _ IEThingAll{}) = l2
+  thingFolder l1                    (   L _ IEThingAbs{}) = l1
+  thingFolder (L _ IEThingAbs{})    l2                    = l2
+  thingFolder (L l (IEThingWith x wn _ consItems1 fieldLbls1)) (L _ (IEThingWith _ _ _ consItems2 fieldLbls2))
+    = L
+      l
+      (IEThingWith x
+                   wn
+                   NoIEWildcard
+                   (consItems1 ++ consItems2)
+                   (fieldLbls1 ++ fieldLbls2)
+      )
+  thingFolder _ _ =
+    error "thingFolder should be exhaustive because we have a guard above"
+
 
 -- Builds a complete layout for the given located
 -- list of LIEs. The layout provides two alternatives:
@@ -163,22 +202,46 @@ layoutLLIEs :: Bool -> Located [LIE GhcPs] -> ToBriDocM BriDocNumbered
 layoutLLIEs enableSingleline llies = do
   ieDs        <- layoutAnnAndSepLLIEs llies
   hasComments <- hasAnyCommentsBelow llies
-  runFilteredAlternative $
+  runFilteredAlternative $ case ieDs of
-    case ieDs of
+    [] -> do
-      [] -> do
+      addAlternativeCond (not hasComments) $ docLit $ Text.pack "()"
-        addAlternativeCond (not hasComments) $
+      addAlternativeCond hasComments $ docPar
-          docLit $ Text.pack "()"
+        (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
-        addAlternativeCond hasComments $
+        docParenR
-          docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
+    (ieDsH : ieDsT) -> do
-                 docParenR
+      addAlternativeCond (not hasComments && enableSingleline)
-      (ieDsH:ieDsT) -> do
+        $  docSeq
-        addAlternativeCond (not hasComments && enableSingleline)
+        $  [docLit (Text.pack "(")]
-          $  docSeq
+        ++ (docForceSingleline <$> ieDs)
-          $  [docLit (Text.pack "(")]
+        ++ [docParenR]
-          ++ (docForceSingleline <$> ieDs)
+      addAlternative
-          ++ [docParenR]
+        $  docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])
-        addAlternative
+        $  docLines
-          $  docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])
+        $  ieDsT
-          $  docLines
+        ++ [docParenR]
-          $  ieDsT
+
-          ++ [docParenR]
+-- | Returns a "fingerprint string", not a full text representation, nor even
+-- a source code representation of this syntax node.
+-- Used for sorting, not for printing the formatter's output source code.
+wrappedNameToText :: LIEWrappedName RdrName -> Text
+wrappedNameToText = \case
+  L _ (IEName    n) -> lrdrNameToText n
+  L _ (IEPattern n) -> lrdrNameToText n
+  L _ (IEType    n) -> lrdrNameToText n
+-- | Returns a "fingerprint string", not a full text representation, nor even
+-- a source code representation of this syntax node.
+-- Used for sorting, not for printing the formatter's output source code.
+lieToText :: LIE GhcPs -> Text
+lieToText = \case
+  L _ (IEVar      _ wn       ) -> wrappedNameToText wn
+  L _ (IEThingAbs _ wn       ) -> wrappedNameToText wn
+  L _ (IEThingAll _ wn       ) -> wrappedNameToText wn
+  L _ (IEThingWith _ wn _ _ _) -> wrappedNameToText wn
+  -- TODO: These _may_ appear in exports!
+  -- Need to check, and either put them at the top (for module) or do some
+  -- other clever thing.
+  L _ (IEModuleContents _ _  ) -> Text.pack "IEModuleContents"
+  L _ (IEGroup _ _ _         ) -> Text.pack "IEGroup"
+  L _ (IEDoc      _ _        ) -> Text.pack "IEDoc"
+  L _ (IEDocNamed _ _        ) -> Text.pack "IEDocNamed"
+  L _ (XIE _                 ) -> Text.pack "XIE"