Use WithComments instead of GHC's types (#959)

mihaimaruseac · Sep 15, 2024 · 5bf42c3 · 5bf42c3
1 parent 4bb1d6b
commit 5bf42c3
Show file tree

Hide file tree

Showing 5 changed files with 41 additions and 30 deletions.
diff --git 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
@@ -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 [email protected] {..} = 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
@@ -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
@@ -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
@@ -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)