Avoid using showOutputable if possible (#900)

src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs

@@ -20,7 +20,7 @@ import HIndent.Pretty.NodeComments
 import qualified Data.List.NonEmpty as NE
 #endif
 data GADTConstructor = GADTConstructor
-  { names :: [WithComments String]
+  { names :: [WithComments (GHC.IdP GHC.GhcPs)]
   , forallNeeded :: Bool
   , bindings :: WithComments (GHC.HsOuterSigTyVarBndrs GHC.GhcPs)
   , context :: Maybe (WithComments Context)
@@ -32,7 +32,7 @@ instance CommentExtraction GADTConstructor where
 
 instance Pretty GADTConstructor where
   pretty' (GADTConstructor {..}) = do
-    hCommaSep $ fmap (`prettyWith` string) names
+    hCommaSep $ fmap (`prettyWith` pretty) names
     hor <-|> ver
     where
       hor = string " :: " |=> body
@@ -71,12 +71,10 @@ mkGADTConstructor [email protected] {..} = Just $ GADTConstructor {..}
     context = fmap (fmap mkContext . fromGenLocated) con_mb_cxt
 mkGADTConstructor _ = Nothing
 
-getNames :: GHC.ConDecl GHC.GhcPs -> Maybe [WithComments String]
+getNames :: GHC.ConDecl GHC.GhcPs -> Maybe [WithComments (GHC.IdP GHC.GhcPs)]
 #if MIN_VERSION_ghc_lib_parser(9, 6, 0)
-getNames GHC.ConDeclGADT {..} =
-  Just $ NE.toList $ fmap (fmap showOutputable . fromGenLocated) con_names
+getNames GHC.ConDeclGADT {..} = Just $ NE.toList $ fmap fromGenLocated con_names
 #else
-getNames GHC.ConDeclGADT {..} =
-  Just $ fmap (fmap showOutputable . fromGenLocated) con_names
+getNames GHC.ConDeclGADT {..} = Just $ fmap fromGenLocated con_names
 #endif
 getNames _ = Nothing

src/HIndent/Ast/Declaration/Family/Data.hs

@@ -20,7 +20,7 @@ import HIndent.Pretty.NodeComments
 
 data DataFamily = DataFamily
   { isTopLevel :: Bool
-  , name :: String
+  , name :: GHC.LIdP GHC.GhcPs
   , typeVariables :: [WithComments TypeVariable]
   , signature :: Maybe (WithComments Type)
   }
@@ -32,7 +32,7 @@ instance Pretty DataFamily where
   pretty' DataFamily {..} = do
     string "data "
     when isTopLevel $ string "family "
-    string name
+    pretty name
     spacePrefixed $ fmap pretty typeVariables
     whenJust signature $ \sig -> space >> pretty sig
 
@@ -46,7 +46,7 @@ mkDataFamily GHC.FamilyDecl {fdTyVars = GHC.HsQTvs {..}, ..}
       case fdTopLevel of
         GHC.TopLevel -> True
         GHC.NotTopLevel -> False
-    name = showOutputable fdLName
+    name = fdLName
     typeVariables = fmap (fmap mkTypeVariable . fromGenLocated) hsq_explicit
     signature =
       case GHC.unLoc fdResultSig of

src/HIndent/Ast/Declaration/Family/Type.hs

@@ -20,7 +20,7 @@ import HIndent.Pretty.NodeComments
 
 data TypeFamily = TypeFamily
   { isTopLevel :: Bool
-  , name :: String
+  , name :: GHC.LIdP GHC.GhcPs
   , typeVariables :: [WithComments TypeVariable]
   , signature :: WithComments ResultSignature
   , injectivity :: Maybe (WithComments Injectivity)
@@ -34,7 +34,7 @@ instance Pretty TypeFamily where
   pretty' TypeFamily {..} = do
     string "type "
     when isTopLevel $ string "family "
-    string name
+    pretty name
     spacePrefixed $ fmap pretty typeVariables
     pretty signature
     whenJust injectivity $ \x -> string " | " >> pretty x
@@ -50,7 +50,7 @@ mkTypeFamily GHC.FamilyDecl {fdTyVars = GHC.HsQTvs {..}, ..}
       case fdTopLevel of
         GHC.TopLevel -> True
         GHC.NotTopLevel -> False
-    name = showOutputable fdLName
+    name = fdLName
     typeVariables = fmap (fmap mkTypeVariable . fromGenLocated) hsq_explicit
     signature = mkResultSignature <$> fromGenLocated fdResultSig
     injectivity = fmap (fmap mkInjectivity . fromGenLocated) fdInjectivityAnn

src/HIndent/Ast/Import.hs

@@ -10,6 +10,7 @@ module HIndent.Ast.Import
 import Control.Monad
 import Data.Function
 import Data.List
+import qualified GHC.Types.SourceText as GHC
 import qualified GHC.Unit as GHC
 import HIndent.Applicative
 import HIndent.Ast.Import.Entry.Collection
@@ -27,16 +28,16 @@ data QualificationPosition
   deriving (Eq)
 
 data Qualification = Qualification
-  { qualifiedAs :: Maybe String
+  { qualifiedAs :: Maybe (GHC.XRec GHC.GhcPs GHC.ModuleName)
   , position :: QualificationPosition
   } deriving (Eq)
 
 data Import = Import
-  { moduleName :: String
+  { moduleName :: GHC.XRec GHC.GhcPs GHC.ModuleName
   , isSafe :: Bool
   , isBoot :: Bool
   , qualification :: Maybe Qualification
-  , packageName :: Maybe String
+  , packageName :: Maybe GHC.StringLiteral
   , importEntries :: Maybe (WithComments ImportEntryCollection)
   }
 
@@ -49,19 +50,19 @@ instance Pretty Import where
     when isBoot $ string "{-# SOURCE #-} "
     when isSafe $ string "safe "
     when (fmap position qualification == Just Pre) $ string "qualified "
-    whenJust packageName $ \name -> string name >> space
-    string moduleName
+    whenJust packageName $ \name -> pretty name >> space
+    pretty moduleName
     when (fmap position qualification == Just Post) $ string " qualified"
     case qualification of
       Just Qualification {qualifiedAs = Just name} ->
-        string " as " >> string name
+        string " as " >> pretty name
       _ -> pure ()
     whenJust importEntries pretty
 
 mkImport :: GHC.ImportDecl GHC.GhcPs -> Import
 mkImport decl@GHC.ImportDecl {..} = Import {..}
   where
-    moduleName = showOutputable ideclName
+    moduleName = ideclName
     isSafe = ideclSafe
     isBoot = ideclSource == GHC.IsBoot
     qualification =
@@ -72,22 +73,18 @@ mkImport [email protected] {..} = Import {..}
         (_, Nothing, GHC.QualifiedPost) ->
           Just Qualification {qualifiedAs = Nothing, position = Post}
         (_, Just name, GHC.QualifiedPre) ->
-          Just
-            Qualification
-              {qualifiedAs = Just $ showOutputable name, position = Pre}
+          Just Qualification {qualifiedAs = Just name, position = Pre}
         (_, Just name, GHC.QualifiedPost) ->
-          Just
-            Qualification
-              {qualifiedAs = Just $ showOutputable name, position = Post}
-    packageName = showOutputable <$> GHC.getPackageName decl
+          Just Qualification {qualifiedAs = Just name, position = Post}
+    packageName = GHC.getPackageName decl
     importEntries = mkImportEntryCollection decl
 
 sortByName :: [WithComments Import] -> [WithComments Import]
 sortByName = fmap sortExplicitImportsInDecl . sortByModuleName
 
 -- | This function sorts import declarations by their module names.
 sortByModuleName :: [WithComments Import] -> [WithComments Import]
-sortByModuleName = sortBy (compare `on` moduleName . getNode)
+sortByModuleName = sortBy (compare `on` showOutputable . moduleName . getNode)
 
 -- | This function sorts explicit imports in the given import declaration
 -- by their names.

src/HIndent/Ast/Import/Entry.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module HIndent.Ast.Import.Entry
@@ -15,32 +16,38 @@ import HIndent.Ast.WithComments
 import HIndent.Pretty
 import HIndent.Pretty.Combinators
 import HIndent.Pretty.NodeComments
-
+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
 data ImportEntry
-  = SingleIdentifier String
+  = SingleIdentifier (GHC.LIEWrappedName GHC.GhcPs)
   | WithSpecificConstructors
-      { name :: String
-      , constructors :: [String]
+      { name :: GHC.LIEWrappedName GHC.GhcPs
+      , constructors :: [GHC.LIEWrappedName GHC.GhcPs]
       }
-  | WithAllConstructors String
-
+  | WithAllConstructors (GHC.LIEWrappedName GHC.GhcPs)
+#else
+data ImportEntry
+  = SingleIdentifier (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))
+  | WithSpecificConstructors
+      { name :: GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)
+      , constructors :: [GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)]
+      }
+  | WithAllConstructors (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))
+#endif
 instance CommentExtraction ImportEntry where
   nodeComments _ = NodeComments [] [] []
 
 instance Pretty ImportEntry where
-  pretty' (SingleIdentifier wrapped) = string wrapped
-  pretty' (WithAllConstructors wrapped) = string wrapped >> string "(..)"
+  pretty' (SingleIdentifier wrapped) = pretty wrapped
+  pretty' (WithAllConstructors wrapped) = pretty wrapped >> string "(..)"
   pretty' WithSpecificConstructors {..} =
-    string name >> hFillingTuple (fmap string constructors)
+    pretty name >> hFillingTuple (fmap pretty constructors)
 
 mkImportEntry :: GHC.IE GHC.GhcPs -> ImportEntry
-mkImportEntry (GHC.IEVar _ name) = SingleIdentifier $ showOutputable name
-mkImportEntry (GHC.IEThingAbs _ name) = SingleIdentifier $ showOutputable name
-mkImportEntry (GHC.IEThingAll _ name) =
-  WithAllConstructors $ showOutputable name
-mkImportEntry (GHC.IEThingWith _ name _ xs) =
-  WithSpecificConstructors
-    {name = showOutputable name, constructors = fmap showOutputable xs}
+mkImportEntry (GHC.IEVar _ name) = SingleIdentifier name
+mkImportEntry (GHC.IEThingAbs _ name) = SingleIdentifier name
+mkImportEntry (GHC.IEThingAll _ name) = WithAllConstructors name
+mkImportEntry (GHC.IEThingWith _ name _ constructors) =
+  WithSpecificConstructors {..}
 mkImportEntry _ = undefined
 
 sortVariantsAndExplicitImports ::
@@ -53,7 +60,8 @@ sortVariants :: WithComments ImportEntry -> WithComments ImportEntry
 sortVariants = fmap f
   where
     f WithSpecificConstructors {..} =
-      WithSpecificConstructors {constructors = sort constructors, ..}
+      WithSpecificConstructors
+        {constructors = sortBy (compare `on` showOutputable) constructors, ..}
     f x = x
 
 -- | This function sorts the given explicit imports by their names.
@@ -62,11 +70,14 @@ sortExplicitImports = sortBy (compareImportEntities `on` getNode)
 
 -- | This function compares two import declarations by their module names.
 compareImportEntities :: ImportEntry -> ImportEntry -> Ordering
-compareImportEntities = compareIdentifier `on` getModuleName
-
+compareImportEntities = compareIdentifier `on` showOutputable . getModuleName
 -- | This function returns a 'Just' value with the module name extracted
 -- from the import declaration. Otherwise, it returns a 'Nothing'.
-getModuleName :: ImportEntry -> String
+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
+getModuleName :: ImportEntry -> GHC.LIEWrappedName GHC.GhcPs
+#else
+getModuleName :: ImportEntry -> GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)
+#endif
 getModuleName (SingleIdentifier wrapped) = wrapped
 getModuleName (WithAllConstructors wrapped) = wrapped
 getModuleName (WithSpecificConstructors wrapped _) = wrapped

src/HIndent/Ast/Module/Export/Entry.hs

@@ -1,43 +1,54 @@
+{-# LANGUAGE CPP #-}
+
 module HIndent.Ast.Module.Export.Entry
   ( ExportEntry
   , mkExportEntry
   ) where
 
 import GHC.Stack
+import qualified GHC.Types.SrcLoc as GHC
+import qualified GHC.Unit as GHC
 import HIndent.Ast.NodeComments
 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 String
-  | WithSpecificConstructors String [String]
-  | WithAllConstructors String
-  | ByModule String
-
+  = SingleIdentifier (GHC.LIEWrappedName GHC.GhcPs)
+  | WithSpecificConstructors
+      (GHC.LIEWrappedName GHC.GhcPs)
+      [GHC.LIEWrappedName GHC.GhcPs]
+  | WithAllConstructors (GHC.LIEWrappedName GHC.GhcPs)
+  | ByModule (GHC.GenLocated GHC.SrcSpanAnnA GHC.ModuleName)
+#else
+data ExportEntry
+  = SingleIdentifier (GHC.LIEWrappedName (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)
+#endif
 instance CommentExtraction ExportEntry where
   nodeComments SingleIdentifier {} = NodeComments [] [] []
   nodeComments WithSpecificConstructors {} = NodeComments [] [] []
   nodeComments WithAllConstructors {} = NodeComments [] [] []
   nodeComments ByModule {} = NodeComments [] [] []
 
 instance Pretty ExportEntry where
-  pretty' (SingleIdentifier s) = string s
-  pretty' (WithSpecificConstructors s xs) = string s >> hTuple (fmap string xs)
-  pretty' (WithAllConstructors s) = string s >> string "(..)"
-  pretty' (ByModule s) = string "module " >> string s
+  pretty' (SingleIdentifier s) = pretty s
+  pretty' (WithSpecificConstructors s xs) = pretty s >> hTuple (fmap pretty xs)
+  pretty' (WithAllConstructors s) = pretty s >> string "(..)"
+  pretty' (ByModule s) = string "module " >> pretty s
 
 mkExportEntry :: GHC.IE GHC.GhcPs -> ExportEntry
-mkExportEntry (GHC.IEVar _ name) = SingleIdentifier $ showOutputable name
-mkExportEntry (GHC.IEThingAbs _ name) = SingleIdentifier $ showOutputable name
-mkExportEntry (GHC.IEThingAll _ name) =
-  WithAllConstructors $ showOutputable name
+mkExportEntry (GHC.IEVar _ name) = SingleIdentifier name
+mkExportEntry (GHC.IEThingAbs _ name) = SingleIdentifier name
+mkExportEntry (GHC.IEThingAll _ name) = WithAllConstructors name
 mkExportEntry (GHC.IEThingWith _ name _ constructors) =
-  WithSpecificConstructors
-    (showOutputable name)
-    (fmap showOutputable constructors)
-mkExportEntry (GHC.IEModuleContents _ name) = ByModule $ showOutputable name
+  WithSpecificConstructors name constructors
+mkExportEntry (GHC.IEModuleContents _ name) = ByModule name
 mkExportEntry GHC.IEGroup {} = neverAppears
 mkExportEntry GHC.IEDoc {} = neverAppears
 mkExportEntry GHC.IEDocNamed {} = neverAppears

src/HIndent/Ast/Module/Name.hs

@@ -19,4 +19,4 @@ instance Pretty ModuleName where
   pretty' (ModuleName x) = string "module " >> string x
 
 mkModuleName :: GHC.ModuleName -> ModuleName
-mkModuleName = ModuleName . showOutputable
+mkModuleName = ModuleName . GHC.moduleNameString