From 5bf42c363ba191e9c5d7bc16b0067daa4eccf81b Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Sun, 15 Sep 2024 19:05:29 +0900 Subject: [PATCH] Use `WithComments` instead of GHC's types (#959) --- src/HIndent/Ast/Declaration/Family/Type.hs | 4 +- src/HIndent/Ast/Import.hs | 17 +++++--- src/HIndent/Ast/Module/Export/Entry.hs | 46 ++++++++++++---------- src/HIndent/Ast/NodeComments.hs | 2 +- src/HIndent/Ast/WithComments.hs | 2 +- 5 files changed, 41 insertions(+), 30 deletions(-) diff --git a/src/HIndent/Ast/Declaration/Family/Type.hs b/src/HIndent/Ast/Declaration/Family/Type.hs index 3fa289349..292b71c2e 100644 --- a/src/HIndent/Ast/Declaration/Family/Type.hs +++ b/src/HIndent/Ast/Declaration/Family/Type.hs @@ -25,7 +25,7 @@ data TypeFamily = TypeFamily , typeVariables :: [WithComments TypeVariable] , signature :: WithComments ResultSignature , injectivity :: Maybe (WithComments Injectivity) - , equations :: Maybe [GHC.LTyFamInstEqn GHC.GhcPs] + , equations :: Maybe [WithComments (GHC.TyFamInstEqn GHC.GhcPs)] } instance CommentExtraction TypeFamily where @@ -60,4 +60,4 @@ mkTypeFamily GHC.FamilyDecl {fdTyVars = GHC.HsQTvs {..}, ..} GHC.DataFamily -> error "Not a TypeFamily" GHC.OpenTypeFamily -> Nothing GHC.ClosedTypeFamily Nothing -> Just [] - GHC.ClosedTypeFamily (Just xs) -> Just xs + GHC.ClosedTypeFamily (Just xs) -> Just $ fmap fromGenLocated xs diff --git a/src/HIndent/Ast/Import.hs b/src/HIndent/Ast/Import.hs index a038fb148..88a2f9b2b 100644 --- a/src/HIndent/Ast/Import.hs +++ b/src/HIndent/Ast/Import.hs @@ -28,12 +28,12 @@ data QualificationPosition deriving (Eq) data Qualification = Qualification - { qualifiedAs :: Maybe (GHC.XRec GHC.GhcPs GHC.ModuleName) + { qualifiedAs :: Maybe (WithComments GHC.ModuleName) , position :: QualificationPosition } deriving (Eq) data Import = Import - { moduleName :: GHC.XRec GHC.GhcPs GHC.ModuleName + { moduleName :: WithComments GHC.ModuleName , isSafe :: Bool , isBoot :: Bool , qualification :: Maybe Qualification @@ -62,7 +62,7 @@ instance Pretty Import where mkImport :: GHC.ImportDecl GHC.GhcPs -> Import mkImport decl@GHC.ImportDecl {..} = Import {..} where - moduleName = ideclName + moduleName = fromGenLocated ideclName isSafe = ideclSafe isBoot = ideclSource == GHC.IsBoot qualification = @@ -73,9 +73,13 @@ mkImport decl@GHC.ImportDecl {..} = Import {..} (_, Nothing, GHC.QualifiedPost) -> Just Qualification {qualifiedAs = Nothing, position = Post} (_, Just name, GHC.QualifiedPre) -> - Just Qualification {qualifiedAs = Just name, position = Pre} + Just + Qualification + {qualifiedAs = Just $ fromGenLocated name, position = Pre} (_, Just name, GHC.QualifiedPost) -> - Just Qualification {qualifiedAs = Just name, position = Post} + Just + Qualification + {qualifiedAs = Just $ fromGenLocated name, position = Post} packageName = GHC.getPackageName decl importEntries = mkImportEntryCollection decl @@ -84,7 +88,8 @@ sortByName = fmap sortExplicitImportsInDecl . sortByModuleName -- | This function sorts import declarations by their module names. sortByModuleName :: [WithComments Import] -> [WithComments Import] -sortByModuleName = sortBy (compare `on` showOutputable . moduleName . getNode) +sortByModuleName = + sortBy (compare `on` showOutputable . getNode . moduleName . getNode) -- | This function sorts explicit imports in the given import declaration -- by their names. diff --git a/src/HIndent/Ast/Module/Export/Entry.hs b/src/HIndent/Ast/Module/Export/Entry.hs index bdbf397be..b6c7369cb 100644 --- a/src/HIndent/Ast/Module/Export/Entry.hs +++ b/src/HIndent/Ast/Module/Export/Entry.hs @@ -6,29 +6,29 @@ module HIndent.Ast.Module.Export.Entry ) where import GHC.Stack -import qualified GHC.Types.SrcLoc as GHC import qualified GHC.Unit as GHC import HIndent.Ast.NodeComments +import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import HIndent.Pretty import HIndent.Pretty.Combinators import HIndent.Pretty.NodeComments #if MIN_VERSION_ghc_lib_parser(9, 6, 1) data ExportEntry - = SingleIdentifier (GHC.LIEWrappedName GHC.GhcPs) + = SingleIdentifier (WithComments (GHC.IEWrappedName GHC.GhcPs)) | WithSpecificConstructors - (GHC.LIEWrappedName GHC.GhcPs) - [GHC.LIEWrappedName GHC.GhcPs] - | WithAllConstructors (GHC.LIEWrappedName GHC.GhcPs) - | ByModule (GHC.GenLocated GHC.SrcSpanAnnA GHC.ModuleName) + (WithComments (GHC.IEWrappedName GHC.GhcPs)) + [WithComments (GHC.IEWrappedName GHC.GhcPs)] + | WithAllConstructors (WithComments (GHC.IEWrappedName GHC.GhcPs)) + | ByModule (WithComments GHC.ModuleName) #else data ExportEntry - = SingleIdentifier (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)) + = SingleIdentifier (WithComments (GHC.IEWrappedName (GHC.IdP GHC.GhcPs))) | WithSpecificConstructors - (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)) - [GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)] - | WithAllConstructors (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)) - | ByModule (GHC.GenLocated GHC.SrcSpanAnnA GHC.ModuleName) + (WithComments (GHC.IEWrappedName (GHC.IdP GHC.GhcPs))) + [WithComments (GHC.IEWrappedName (GHC.IdP GHC.GhcPs))] + | WithAllConstructors (WithComments (GHC.IEWrappedName (GHC.IdP GHC.GhcPs))) + | ByModule (WithComments GHC.ModuleName) #endif instance CommentExtraction ExportEntry where nodeComments SingleIdentifier {} = NodeComments [] [] [] @@ -44,19 +44,25 @@ instance Pretty ExportEntry where mkExportEntry :: GHC.IE GHC.GhcPs -> ExportEntry #if MIN_VERSION_ghc_lib_parser(9, 10, 1) -mkExportEntry (GHC.IEVar _ name _) = SingleIdentifier name -mkExportEntry (GHC.IEThingAbs _ name _) = SingleIdentifier name -mkExportEntry (GHC.IEThingAll _ name _) = WithAllConstructors name +mkExportEntry (GHC.IEVar _ name _) = SingleIdentifier $ fromGenLocated name +mkExportEntry (GHC.IEThingAbs _ name _) = SingleIdentifier $ fromGenLocated name +mkExportEntry (GHC.IEThingAll _ name _) = + WithAllConstructors $ fromGenLocated name mkExportEntry (GHC.IEThingWith _ name _ constructors _) = - WithSpecificConstructors name constructors + WithSpecificConstructors + (fromGenLocated name) + (fmap fromGenLocated constructors) #else -mkExportEntry (GHC.IEVar _ name) = SingleIdentifier name -mkExportEntry (GHC.IEThingAbs _ name) = SingleIdentifier name -mkExportEntry (GHC.IEThingAll _ name) = WithAllConstructors name +mkExportEntry (GHC.IEVar _ name) = SingleIdentifier $ fromGenLocated name +mkExportEntry (GHC.IEThingAbs _ name) = SingleIdentifier $ fromGenLocated name +mkExportEntry (GHC.IEThingAll _ name) = + WithAllConstructors $ fromGenLocated name mkExportEntry (GHC.IEThingWith _ name _ constructors) = - WithSpecificConstructors name constructors + WithSpecificConstructors + (fromGenLocated name) + (fmap fromGenLocated constructors) #endif -mkExportEntry (GHC.IEModuleContents _ name) = ByModule name +mkExportEntry (GHC.IEModuleContents _ name) = ByModule $ fromGenLocated name mkExportEntry GHC.IEGroup {} = neverAppears mkExportEntry GHC.IEDoc {} = neverAppears mkExportEntry GHC.IEDocNamed {} = neverAppears diff --git a/src/HIndent/Ast/NodeComments.hs b/src/HIndent/Ast/NodeComments.hs index 1d8c3b7ce..e61c579d6 100644 --- a/src/HIndent/Ast/NodeComments.hs +++ b/src/HIndent/Ast/NodeComments.hs @@ -15,7 +15,7 @@ data NodeComments = NodeComments { commentsBefore :: [GHC.LEpaComment] , commentsOnSameLine :: [GHC.LEpaComment] , commentsAfter :: [GHC.LEpaComment] - } + } deriving (Eq) instance Semigroup NodeComments where x <> y = diff --git a/src/HIndent/Ast/WithComments.hs b/src/HIndent/Ast/WithComments.hs index 110fd805f..4b816e94b 100644 --- a/src/HIndent/Ast/WithComments.hs +++ b/src/HIndent/Ast/WithComments.hs @@ -25,7 +25,7 @@ import HIndent.Printer data WithComments a = WithComments { comments :: NodeComments , node :: a - } deriving (Foldable, Traversable) + } deriving (Foldable, Traversable, Eq) instance Functor WithComments where fmap f WithComments {..} = WithComments comments (f node)