mihaimaruseac · mihaimaruseac · Jul 26, 2024 · Jul 23, 2024
diff --git a/src/HIndent/Ast/Declaration/Annotation/Provenance.hs b/src/HIndent/Ast/Declaration/Annotation/Provenance.hs
@@ -3,15 +3,17 @@ module HIndent.Ast.Declaration.Annotation.Provenance
   , mkProvenance
   ) where
 
+import HIndent.Ast.Name.Prefix
 import HIndent.Ast.NodeComments
+import HIndent.Ast.WithComments
 import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
 import {-# SOURCE #-} HIndent.Pretty
 import HIndent.Pretty.Combinators
 import HIndent.Pretty.NodeComments
 
 data Provenance
-  = Value (GHC.LIdP GHC.GhcPs)
-  | Type (GHC.LIdP GHC.GhcPs)
+  = Value (WithComments PrefixName)
+  | Type (WithComments PrefixName)
   | Module
 
 instance CommentExtraction Provenance where
@@ -25,6 +27,8 @@ instance Pretty Provenance where
   pretty' Module = string "module"
 
 mkProvenance :: GHC.AnnProvenance GHC.GhcPs -> Provenance
-mkProvenance (GHC.ValueAnnProvenance x) = Value x
-mkProvenance (GHC.TypeAnnProvenance x) = Type x
+mkProvenance (GHC.ValueAnnProvenance x) =
+  Value $ fromGenLocated $ fmap mkPrefixName x
+mkProvenance (GHC.TypeAnnProvenance x) =
+  Type $ fromGenLocated $ fmap mkPrefixName x
 mkProvenance GHC.ModuleAnnProvenance = Module
diff --git a/src/HIndent/Ast/Declaration/Annotation/Role.hs b/src/HIndent/Ast/Declaration/Annotation/Role.hs
@@ -5,6 +5,7 @@ module HIndent.Ast.Declaration.Annotation.Role
   , mkRoleAnnotation
   ) where
 
+import HIndent.Ast.Name.Prefix
 import HIndent.Ast.NodeComments
 import HIndent.Ast.Role
 import HIndent.Ast.WithComments
@@ -14,7 +15,7 @@ import HIndent.Pretty.Combinators
 import HIndent.Pretty.NodeComments
 
 data RoleAnnotation = RoleAnnotation
-  { name :: GHC.LIdP GHC.GhcPs
+  { name :: WithComments PrefixName
   , roles :: [WithComments (Maybe Role)]
   }
 
@@ -28,6 +29,7 @@ instance Pretty RoleAnnotation where
           ++ fmap (`prettyWith` maybe (string "_") pretty) roles
 
 mkRoleAnnotation :: GHC.RoleAnnotDecl GHC.GhcPs -> RoleAnnotation
-mkRoleAnnotation (GHC.RoleAnnotDecl _ name rs) = RoleAnnotation {..}
+mkRoleAnnotation (GHC.RoleAnnotDecl _ nm rs) = RoleAnnotation {..}
   where
+    name = fromGenLocated $ fmap mkPrefixName nm
     roles = fmap (fmap (fmap mkRole) . fromGenLocated) rs
diff --git a/src/HIndent/Ast/Declaration/Bind.hs b/src/HIndent/Ast/Declaration/Bind.hs
@@ -7,6 +7,7 @@ module HIndent.Ast.Declaration.Bind
   ) where
 
 import HIndent.Ast.Name.Infix
+import HIndent.Ast.Name.Prefix
 import HIndent.Ast.NodeComments
 import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
 import {-# SOURCE #-} HIndent.Pretty
@@ -46,9 +47,13 @@ instance Pretty Bind where
     string "pattern "
     case parameters of
       GHC.InfixCon l r ->
-        spaced [pretty l, pretty $ fmap mkInfixName name, pretty r]
-      GHC.PrefixCon _ [] -> pretty name
-      _ -> spaced [pretty name, pretty parameters]
+        spaced
+          [ pretty $ fmap mkPrefixName l
+          , pretty $ fmap mkInfixName name
+          , pretty $ fmap mkPrefixName r
+          ]
+      GHC.PrefixCon _ [] -> pretty $ fmap mkPrefixName name
+      _ -> spaced [pretty $ fmap mkPrefixName name, pretty parameters]
     spacePrefixed [pretty direction, pretty $ fmap PatInsidePatDecl definition]
     case direction of
       GHC.ExplicitBidirectional matches -> do

diff --git a/src/HIndent/Ast/Declaration/Class/FunctionalDependency.hs b/src/HIndent/Ast/Declaration/Class/FunctionalDependency.hs
@@ -5,15 +5,17 @@ module HIndent.Ast.Declaration.Class.FunctionalDependency
   , mkFunctionalDependency
   ) where
 
+import HIndent.Ast.Name.Prefix
 import HIndent.Ast.NodeComments
+import HIndent.Ast.WithComments
 import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
 import {-# SOURCE #-} HIndent.Pretty
 import HIndent.Pretty.Combinators
 import HIndent.Pretty.NodeComments
 
 data FunctionalDependency = FunctionalDependency
-  { from :: [GHC.LIdP GHC.GhcPs]
-  , to :: [GHC.LIdP GHC.GhcPs]
+  { from :: [WithComments PrefixName]
+  , to :: [WithComments PrefixName]
   }
 
 instance CommentExtraction FunctionalDependency where
@@ -24,4 +26,7 @@ instance Pretty FunctionalDependency where
     spaced $ fmap pretty from ++ [string "->"] ++ fmap pretty to
 
 mkFunctionalDependency :: GHC.FunDep GHC.GhcPs -> FunctionalDependency
-mkFunctionalDependency (GHC.FunDep _ from to) = FunctionalDependency {..}
+mkFunctionalDependency (GHC.FunDep _ f t) = FunctionalDependency {..}
+  where
+    from = fmap (fromGenLocated . fmap mkPrefixName) f
+    to = fmap (fromGenLocated . fmap mkPrefixName) t
diff --git a/src/HIndent/Ast/Declaration/Class/NameAndTypeVariables.hs b/src/HIndent/Ast/Declaration/Class/NameAndTypeVariables.hs
@@ -7,6 +7,7 @@ module HIndent.Ast.Declaration.Class.NameAndTypeVariables
 
 import qualified GHC.Types.Fixity as GHC
 import HIndent.Ast.Name.Infix
+import HIndent.Ast.Name.Prefix
 import HIndent.Ast.NodeComments
 import HIndent.Ast.Type.Variable
 import HIndent.Ast.WithComments
@@ -17,12 +18,12 @@ import HIndent.Pretty.NodeComments
 
 data NameAndTypeVariables
   = Prefix
-      { name :: GHC.LIdP GHC.GhcPs
+      { pName :: WithComments PrefixName -- Using `name` in both `Prefix` and `Infix` causes a type conflict.
       , typeVariables :: [WithComments TypeVariable]
       }
   | Infix
       { left :: WithComments TypeVariable
-      , name :: GHC.LIdP GHC.GhcPs
+      , iName :: WithComments InfixName
       , right :: WithComments TypeVariable
       , remains :: [WithComments TypeVariable]
       }
@@ -32,16 +33,16 @@ instance CommentExtraction NameAndTypeVariables where
   nodeComments Infix {} = NodeComments [] [] []
 
 instance Pretty NameAndTypeVariables where
-  pretty' Prefix {..} = spaced $ pretty name : fmap pretty typeVariables
+  pretty' Prefix {..} = spaced $ pretty pName : fmap pretty typeVariables
   pretty' Infix {..} = do
-    parens $ spaced [pretty left, pretty $ fmap mkInfixName name, pretty right]
+    parens $ spaced [pretty left, pretty iName, pretty right]
     spacePrefixed $ fmap pretty remains
 
 mkNameAndTypeVariables :: GHC.TyClDecl GHC.GhcPs -> Maybe NameAndTypeVariables
 mkNameAndTypeVariables GHC.ClassDecl {tcdFixity = GHC.Prefix, ..} =
   Just Prefix {..}
   where
-    name = tcdLName
+    pName = fromGenLocated $ fmap mkPrefixName tcdLName
     typeVariables =
       fmap mkTypeVariable . fromGenLocated <$> GHC.hsq_explicit tcdTyVars
 mkNameAndTypeVariables GHC.ClassDecl { tcdFixity = GHC.Infix
@@ -50,7 +51,7 @@ mkNameAndTypeVariables GHC.ClassDecl { tcdFixity = GHC.Infix
                                      } = Just Infix {..}
   where
     left = mkTypeVariable <$> fromGenLocated h
-    name = tcdLName
+    iName = fromGenLocated $ fmap mkInfixName tcdLName
     right = mkTypeVariable <$> fromGenLocated t
     remains = fmap (fmap mkTypeVariable . fromGenLocated) xs
 mkNameAndTypeVariables _ = Nothing
diff --git a/src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs b/src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs
@@ -10,6 +10,7 @@ import Data.Maybe
 import qualified GHC.Types.SrcLoc as GHC
 import HIndent.Ast.Context
 import HIndent.Ast.Declaration.Data.GADT.Constructor.Signature
+import HIndent.Ast.Name.Prefix
 import HIndent.Ast.NodeComments
 import HIndent.Ast.Type.Variable
 import HIndent.Ast.WithComments
@@ -21,7 +22,7 @@ import HIndent.Pretty.NodeComments
 import qualified Data.List.NonEmpty as NE
 #endif
 data GADTConstructor = GADTConstructor
-  { names :: [WithComments (GHC.IdP GHC.GhcPs)]
+  { names :: [WithComments PrefixName]
   , bindings :: Maybe (WithComments [WithComments TypeVariable])
   , context :: Maybe (WithComments Context)
   , signature :: ConstructorSignature
@@ -79,10 +80,12 @@ mkGADTConstructor decl@GHC.ConDeclGADT {..} = Just $ GADTConstructor {..}
     context = fmap (fmap mkContext . fromGenLocated) con_mb_cxt
 mkGADTConstructor _ = Nothing
 
-getNames :: GHC.ConDecl GHC.GhcPs -> Maybe [WithComments (GHC.IdP GHC.GhcPs)]
+getNames :: GHC.ConDecl GHC.GhcPs -> Maybe [WithComments PrefixName]
 #if MIN_VERSION_ghc_lib_parser(9, 6, 0)
-getNames GHC.ConDeclGADT {..} = Just $ NE.toList $ fmap fromGenLocated con_names
+getNames GHC.ConDeclGADT {..} =
+  Just $ NE.toList $ fmap (fromGenLocated . fmap mkPrefixName) con_names
 #else
-getNames GHC.ConDeclGADT {..} = Just $ fmap fromGenLocated con_names
+getNames GHC.ConDeclGADT {..} =
+  Just $ fmap (fromGenLocated . fmap mkPrefixName) con_names
 #endif
 getNames _ = Nothing
diff --git a/src/HIndent/Ast/Declaration/Data/Haskell98/Constructor/Body.hs b/src/HIndent/Ast/Declaration/Data/Haskell98/Constructor/Body.hs
@@ -8,6 +8,7 @@ module HIndent.Ast.Declaration.Data.Haskell98.Constructor.Body
 
 import HIndent.Ast.Declaration.Data.Record.Field
 import HIndent.Ast.Name.Infix
+import HIndent.Ast.Name.Prefix
 import HIndent.Ast.NodeComments
 import HIndent.Ast.WithComments
 import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
@@ -17,16 +18,16 @@ import HIndent.Pretty.NodeComments
 
 data Haskell98ConstructorBody
   = Infix
-      { name :: GHC.LIdP GHC.GhcPs
+      { iName :: WithComments InfixName -- Using `name` in all constructors causes a type clash
       , left :: GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)
       , right :: GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)
       }
   | Prefix
-      { name :: GHC.LIdP GHC.GhcPs
+      { pName :: WithComments PrefixName
       , types :: [GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)]
       }
   | Record
-      { name :: GHC.LIdP GHC.GhcPs
+      { rName :: WithComments PrefixName
       , records :: WithComments [WithComments RecordField]
       }
 
@@ -36,30 +37,31 @@ instance CommentExtraction Haskell98ConstructorBody where
   nodeComments Record {} = NodeComments [] [] []
 
 instance Pretty Haskell98ConstructorBody where
-  pretty' Infix {..} =
-    spaced [pretty left, pretty $ fmap mkInfixName name, pretty right]
-  pretty' Prefix {..} = pretty name >> hor <-|> ver
+  pretty' Infix {..} = spaced [pretty left, pretty iName, pretty right]
+  pretty' Prefix {..} = pretty pName >> hor <-|> ver
     where
       hor = spacePrefixed $ fmap pretty types
       ver = indentedBlock $ newlinePrefixed $ fmap pretty types
   pretty' Record {..} = do
-    pretty name
+    pretty rName
     prettyWith records $ \r ->
       newline >> indentedBlock (vFields $ fmap pretty r)
 
 mkHaskell98ConstructorBody ::
      GHC.ConDecl GHC.GhcPs -> Maybe Haskell98ConstructorBody
 mkHaskell98ConstructorBody GHC.ConDeclH98 { con_args = GHC.InfixCon left right
                                           , ..
-                                          } = Just Infix {name = con_name, ..}
+                                          } = Just Infix {..}
+  where
+    iName = fromGenLocated $ fmap mkInfixName con_name
 mkHaskell98ConstructorBody GHC.ConDeclH98 {con_args = GHC.PrefixCon _ types, ..} =
   Just Prefix {..}
   where
-    name = con_name
+    pName = fromGenLocated $ fmap mkPrefixName con_name
 mkHaskell98ConstructorBody GHC.ConDeclH98 {con_args = GHC.RecCon rs, ..} =
   Just Record {..}
   where
-    name = con_name
+    rName = fromGenLocated $ fmap mkPrefixName con_name
     records =
       fromGenLocated $ fmap (fmap (fmap mkRecordField . fromGenLocated)) rs
 mkHaskell98ConstructorBody GHC.ConDeclGADT {} = Nothing

diff --git a/src/HIndent/Ast/Declaration/Data/Header.hs b/src/HIndent/Ast/Declaration/Data/Header.hs
@@ -8,6 +8,7 @@ module HIndent.Ast.Declaration.Data.Header
 import HIndent.Applicative
 import HIndent.Ast.Context
 import HIndent.Ast.Declaration.Data.NewOrData
+import HIndent.Ast.Name.Prefix
 import HIndent.Ast.NodeComments
 import HIndent.Ast.Type.Variable
 import HIndent.Ast.WithComments
@@ -18,7 +19,7 @@ import HIndent.Pretty.NodeComments
 
 data Header = Header
   { newOrData :: NewOrData
-  , name :: WithComments (GHC.IdP GHC.GhcPs)
+  , name :: WithComments PrefixName
   , context :: Maybe (WithComments Context)
   , typeVariables :: [WithComments TypeVariable]
   }
@@ -39,7 +40,7 @@ mkHeader GHC.DataDecl {tcdDataDefn = defn@GHC.HsDataDefn {..}, ..} =
   where
     newOrData = mkNewOrData defn
     context = fmap (fmap mkContext . fromGenLocated) dd_ctxt
-    name = fromGenLocated tcdLName
+    name = fromGenLocated $ fmap mkPrefixName tcdLName
     typeVariables =
       fmap mkTypeVariable . fromGenLocated <$> GHC.hsq_explicit tcdTyVars
 mkHeader _ = Nothing
diff --git a/src/HIndent/Ast/Declaration/Family/Data.hs b/src/HIndent/Ast/Declaration/Family/Data.hs
@@ -9,6 +9,7 @@ import Control.Monad
 import qualified GHC.Types.Basic as GHC
 import qualified GHC.Types.SrcLoc as GHC
 import HIndent.Applicative
+import HIndent.Ast.Name.Prefix
 import HIndent.Ast.NodeComments hiding (fromEpAnn)
 import HIndent.Ast.Type
 import HIndent.Ast.Type.Variable
@@ -20,7 +21,7 @@ import HIndent.Pretty.NodeComments
 
 data DataFamily = DataFamily
   { isTopLevel :: Bool
-  , name :: GHC.LIdP GHC.GhcPs
+  , name :: WithComments PrefixName
   , typeVariables :: [WithComments TypeVariable]
   , signature :: Maybe (WithComments Type)
   }
@@ -46,7 +47,7 @@ mkDataFamily GHC.FamilyDecl {fdTyVars = GHC.HsQTvs {..}, ..}
       case fdTopLevel of
         GHC.TopLevel -> True
         GHC.NotTopLevel -> False
-    name = fdLName
+    name = fromGenLocated $ fmap mkPrefixName fdLName
     typeVariables = fmap (fmap mkTypeVariable . fromGenLocated) hsq_explicit
     signature =
       case GHC.unLoc fdResultSig of

diff --git a/src/HIndent/Ast/Declaration/Family/Type.hs b/src/HIndent/Ast/Declaration/Family/Type.hs
@@ -10,6 +10,7 @@ import qualified GHC.Types.Basic as GHC
 import HIndent.Applicative
 import HIndent.Ast.Declaration.Family.Type.Injectivity
 import HIndent.Ast.Declaration.Family.Type.ResultSignature
+import HIndent.Ast.Name.Prefix
 import HIndent.Ast.NodeComments hiding (fromEpAnn)
 import HIndent.Ast.Type.Variable
 import HIndent.Ast.WithComments
@@ -20,7 +21,7 @@ import HIndent.Pretty.NodeComments
 
 data TypeFamily = TypeFamily
   { isTopLevel :: Bool
-  , name :: GHC.LIdP GHC.GhcPs
+  , name :: WithComments PrefixName
   , typeVariables :: [WithComments TypeVariable]
   , signature :: WithComments ResultSignature
   , injectivity :: Maybe (WithComments Injectivity)
@@ -50,7 +51,7 @@ mkTypeFamily GHC.FamilyDecl {fdTyVars = GHC.HsQTvs {..}, ..}
       case fdTopLevel of
         GHC.TopLevel -> True
         GHC.NotTopLevel -> False
-    name = fdLName
+    name = fromGenLocated $ fmap mkPrefixName fdLName
     typeVariables = fmap (fmap mkTypeVariable . fromGenLocated) hsq_explicit
     signature = mkResultSignature <$> fromGenLocated fdResultSig
     injectivity = fmap (fmap mkInjectivity . fromGenLocated) fdInjectivityAnn

diff --git a/src/HIndent/Ast/Declaration/Family/Type/Injectivity.hs b/src/HIndent/Ast/Declaration/Family/Type/Injectivity.hs
@@ -5,15 +5,17 @@ module HIndent.Ast.Declaration.Family.Type.Injectivity
   , mkInjectivity
   ) where
 
+import HIndent.Ast.Name.Prefix
 import HIndent.Ast.NodeComments
+import HIndent.Ast.WithComments
 import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
 import {-# SOURCE #-} HIndent.Pretty
 import HIndent.Pretty.Combinators
 import HIndent.Pretty.NodeComments
 
 data Injectivity = Injectivity
-  { from :: GHC.LIdP GHC.GhcPs
-  , to :: [GHC.LIdP GHC.GhcPs]
+  { from :: WithComments PrefixName
+  , to :: [WithComments PrefixName]
   }
 
 instance CommentExtraction Injectivity where
@@ -23,4 +25,7 @@ instance Pretty Injectivity where
   pretty' Injectivity {..} = spaced $ pretty from : string "->" : fmap pretty to
 
 mkInjectivity :: GHC.InjectivityAnn GHC.GhcPs -> Injectivity
-mkInjectivity (GHC.InjectivityAnn _ from to) = Injectivity {..}
+mkInjectivity (GHC.InjectivityAnn _ f t) = Injectivity {..}
+  where
+    from = fromGenLocated $ fmap mkPrefixName f
+    to = fmap (fromGenLocated . fmap mkPrefixName) t