From c6ad57e33028dcd962a5f81e47a0a91d3ad295fe Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Mon, 30 Mar 2020 19:59:25 +0200 Subject: [PATCH] Start implementing sort/uniq on imports/exports --- .../Haskell/Brittany/Internal/Layouters/IE.hs | 123 +++++++++++++----- 1 file changed, 93 insertions(+), 30 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs index f2c36de..7e7eff1 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs +++ b/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 - , runGhc - , GenLocated(L) - , moduleNameString - , AnnKeywordId(..) - , Located - ) +import GHC ( unLoc + , GenLocated(L) + , moduleNameString + , AnnKeywordId(..) + , 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 $ - case ieDs of - [] -> do - addAlternativeCond (not hasComments) $ - docLit $ Text.pack "()" - addAlternativeCond hasComments $ - docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty]) - docParenR - (ieDsH:ieDsT) -> do - addAlternativeCond (not hasComments && enableSingleline) - $ docSeq - $ [docLit (Text.pack "(")] - ++ (docForceSingleline <$> ieDs) - ++ [docParenR] - addAlternative - $ docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH]) - $ docLines - $ ieDsT - ++ [docParenR] + runFilteredAlternative $ case ieDs of + [] -> do + addAlternativeCond (not hasComments) $ docLit $ Text.pack "()" + addAlternativeCond hasComments $ docPar + (docSeq [docParenLSep, docWrapNodeRest llies docEmpty]) + docParenR + (ieDsH : ieDsT) -> do + addAlternativeCond (not hasComments && enableSingleline) + $ docSeq + $ [docLit (Text.pack "(")] + ++ (docForceSingleline <$> ieDs) + ++ [docParenR] + addAlternative + $ docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH]) + $ docLines + $ 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"