Start implementing sort/uniq on imports/exports
parent
86c25ff315
commit
9eaa8c6a62
|
|
@ -12,14 +12,13 @@ import Language.Haskell.Brittany.Internal.LayouterBasics
|
|||
import Language.Haskell.Brittany.Internal.Config.Types
|
||||
|
||||
import GHC ( unLoc
|
||||
, runGhc
|
||||
, 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,13 +202,11 @@ layoutLLIEs :: Bool -> Located [LIE GhcPs] -> ToBriDocM BriDocNumbered
|
|||
layoutLLIEs enableSingleline llies = do
|
||||
ieDs <- layoutAnnAndSepLLIEs llies
|
||||
hasComments <- hasAnyCommentsBelow llies
|
||||
runFilteredAlternative $
|
||||
case ieDs of
|
||||
runFilteredAlternative $ case ieDs of
|
||||
[] -> do
|
||||
addAlternativeCond (not hasComments) $
|
||||
docLit $ Text.pack "()"
|
||||
addAlternativeCond hasComments $
|
||||
docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
|
||||
addAlternativeCond (not hasComments) $ docLit $ Text.pack "()"
|
||||
addAlternativeCond hasComments $ docPar
|
||||
(docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
|
||||
docParenR
|
||||
(ieDsH : ieDsT) -> do
|
||||
addAlternativeCond (not hasComments && enableSingleline)
|
||||
|
|
@ -182,3 +219,29 @@ layoutLLIEs enableSingleline llies = do
|
|||
$ 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"
|
||||
|
|
|
|||
Loading…
Reference in New Issue