From 22ea944c4c6e6a399158469403534ed6c44e813c Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Mon, 24 Jun 2024 00:05:40 +0900 Subject: [PATCH] s/Operator/Name (#919) "Operator" was too specific and did not accurately represent non-operator identifiers such as function and variable names. "Name" is more versatile and appropriately covers both operators and identifiers. --- hindent.cabal | 4 +- src/HIndent/Ast/Declaration/Bind.hs | 4 +- .../Declaration/Class/NameAndTypeVariables.hs | 5 +- .../Data/Haskell98/Constructor/Body.hs | 4 +- src/HIndent/Ast/Declaration/Signature.hs | 5 +- .../Ast/Declaration/TypeSynonym/Lhs.hs | 4 +- src/HIndent/Ast/{Operator => Name}/Infix.hs | 31 ++++++------- src/HIndent/Ast/Name/Prefix.hs | 46 +++++++++++++++++++ src/HIndent/Ast/Operator/Prefix.hs | 46 ------------------- src/HIndent/Pretty.hs | 26 +++++------ 10 files changed, 86 insertions(+), 89 deletions(-) rename src/HIndent/Ast/{Operator => Name}/Infix.hs (52%) create mode 100644 src/HIndent/Ast/Name/Prefix.hs delete mode 100644 src/HIndent/Ast/Operator/Prefix.hs diff --git a/hindent.cabal b/hindent.cabal index dd2b187ae..6f629aa14 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -103,9 +103,9 @@ library HIndent.Ast.Module.Export.Entry HIndent.Ast.Module.Name HIndent.Ast.Module.Warning + HIndent.Ast.Name.Infix + HIndent.Ast.Name.Prefix HIndent.Ast.NodeComments - HIndent.Ast.Operator.Infix - HIndent.Ast.Operator.Prefix HIndent.Ast.Role HIndent.Ast.Type HIndent.Ast.Type.Variable diff --git a/src/HIndent/Ast/Declaration/Bind.hs b/src/HIndent/Ast/Declaration/Bind.hs index 7fee4489b..3b3009ff6 100644 --- a/src/HIndent/Ast/Declaration/Bind.hs +++ b/src/HIndent/Ast/Declaration/Bind.hs @@ -6,8 +6,8 @@ module HIndent.Ast.Declaration.Bind , mkBind ) where +import HIndent.Ast.Name.Infix import HIndent.Ast.NodeComments -import HIndent.Ast.Operator.Infix import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import {-# SOURCE #-} HIndent.Pretty import HIndent.Pretty.Combinators @@ -46,7 +46,7 @@ instance Pretty Bind where string "pattern " case parameters of GHC.InfixCon l r -> - spaced [pretty l, pretty $ fmap mkInfixOperator name, pretty r] + spaced [pretty l, pretty $ fmap mkInfixName name, pretty r] GHC.PrefixCon _ [] -> pretty name _ -> spaced [pretty name, pretty parameters] spacePrefixed [pretty direction, pretty $ fmap PatInsidePatDecl definition] diff --git a/src/HIndent/Ast/Declaration/Class/NameAndTypeVariables.hs b/src/HIndent/Ast/Declaration/Class/NameAndTypeVariables.hs index ee098d575..1486a263b 100644 --- a/src/HIndent/Ast/Declaration/Class/NameAndTypeVariables.hs +++ b/src/HIndent/Ast/Declaration/Class/NameAndTypeVariables.hs @@ -6,8 +6,8 @@ module HIndent.Ast.Declaration.Class.NameAndTypeVariables ) where import qualified GHC.Types.Fixity as GHC +import HIndent.Ast.Name.Infix import HIndent.Ast.NodeComments -import HIndent.Ast.Operator.Infix import HIndent.Ast.Type.Variable import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC @@ -34,8 +34,7 @@ instance CommentExtraction NameAndTypeVariables where instance Pretty NameAndTypeVariables where pretty' Prefix {..} = spaced $ pretty name : fmap pretty typeVariables pretty' Infix {..} = do - parens - $ spaced [pretty left, pretty $ fmap mkInfixOperator name, pretty right] + parens $ spaced [pretty left, pretty $ fmap mkInfixName name, pretty right] spacePrefixed $ fmap pretty remains mkNameAndTypeVariables :: GHC.TyClDecl GHC.GhcPs -> Maybe NameAndTypeVariables diff --git a/src/HIndent/Ast/Declaration/Data/Haskell98/Constructor/Body.hs b/src/HIndent/Ast/Declaration/Data/Haskell98/Constructor/Body.hs index c9e79629e..2a4f745e1 100644 --- a/src/HIndent/Ast/Declaration/Data/Haskell98/Constructor/Body.hs +++ b/src/HIndent/Ast/Declaration/Data/Haskell98/Constructor/Body.hs @@ -7,8 +7,8 @@ module HIndent.Ast.Declaration.Data.Haskell98.Constructor.Body ) where import HIndent.Ast.Declaration.Data.Record.Field +import HIndent.Ast.Name.Infix import HIndent.Ast.NodeComments -import HIndent.Ast.Operator.Infix import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import {-# SOURCE #-} HIndent.Pretty @@ -37,7 +37,7 @@ instance CommentExtraction Haskell98ConstructorBody where instance Pretty Haskell98ConstructorBody where pretty' Infix {..} = - spaced [pretty left, pretty $ fmap mkInfixOperator name, pretty right] + spaced [pretty left, pretty $ fmap mkInfixName name, pretty right] pretty' Prefix {..} = pretty name >> hor <-|> ver where hor = spacePrefixed $ fmap pretty types diff --git a/src/HIndent/Ast/Declaration/Signature.hs b/src/HIndent/Ast/Declaration/Signature.hs index 8b48aef72..960523cbb 100644 --- a/src/HIndent/Ast/Declaration/Signature.hs +++ b/src/HIndent/Ast/Declaration/Signature.hs @@ -13,8 +13,8 @@ import HIndent.Ast.Declaration.Signature.BooleanFormula import HIndent.Ast.Declaration.Signature.Fixity import HIndent.Ast.Declaration.Signature.Inline.Phase import HIndent.Ast.Declaration.Signature.Inline.Spec +import HIndent.Ast.Name.Infix import HIndent.Ast.NodeComments -import HIndent.Ast.Operator.Infix import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import {-# SOURCE #-} HIndent.Pretty @@ -122,8 +122,7 @@ instance Pretty Signature where $ indentedWithSpace 3 $ printCommentsAnd signature (pretty . HsSigTypeInsideDeclSig) pretty' Fixity {..} = - spaced - [pretty fixity, hCommaSep $ fmap (pretty . fmap mkInfixOperator) names] + spaced [pretty fixity, hCommaSep $ fmap (pretty . fmap mkInfixName) names] pretty' Inline {..} = do string "{-# " pretty spec diff --git a/src/HIndent/Ast/Declaration/TypeSynonym/Lhs.hs b/src/HIndent/Ast/Declaration/TypeSynonym/Lhs.hs index a0128eab7..bf2a7376f 100644 --- a/src/HIndent/Ast/Declaration/TypeSynonym/Lhs.hs +++ b/src/HIndent/Ast/Declaration/TypeSynonym/Lhs.hs @@ -6,8 +6,8 @@ module HIndent.Ast.Declaration.TypeSynonym.Lhs ) where import qualified GHC.Types.Fixity as GHC +import HIndent.Ast.Name.Infix import HIndent.Ast.NodeComments -import HIndent.Ast.Operator.Infix import HIndent.Ast.Type.Variable import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC @@ -33,7 +33,7 @@ instance CommentExtraction TypeSynonymLhs where instance Pretty TypeSynonymLhs where pretty' Prefix {..} = spaced $ pretty name : fmap pretty typeVariables pretty' Infix {..} = - spaced [pretty left, pretty $ fmap mkInfixOperator name, pretty right] + spaced [pretty left, pretty $ fmap mkInfixName name, pretty right] mkTypeSynonymLhs :: GHC.TyClDecl GHC.GhcPs -> TypeSynonymLhs mkTypeSynonymLhs GHC.SynDecl {tcdFixity = GHC.Prefix, ..} = diff --git a/src/HIndent/Ast/Operator/Infix.hs b/src/HIndent/Ast/Name/Infix.hs similarity index 52% rename from src/HIndent/Ast/Operator/Infix.hs rename to src/HIndent/Ast/Name/Infix.hs index 93e2a7020..d3b5df4ad 100644 --- a/src/HIndent/Ast/Operator/Infix.hs +++ b/src/HIndent/Ast/Name/Infix.hs @@ -1,8 +1,8 @@ {-# LANGUAGE RecordWildCards #-} -module HIndent.Ast.Operator.Infix - ( InfixOperator - , mkInfixOperator +module HIndent.Ast.Name.Infix + ( InfixName + , mkInfixName ) where import Data.Maybe @@ -14,17 +14,17 @@ import {-# SOURCE #-} HIndent.Pretty import HIndent.Pretty.Combinators import HIndent.Pretty.NodeComments -data InfixOperator = InfixOperator +data InfixName = InfixName { name :: GHC.OccName , moduleName :: Maybe GHC.ModuleName , backtick :: Bool } -instance CommentExtraction InfixOperator where - nodeComments InfixOperator {} = NodeComments [] [] [] +instance CommentExtraction InfixName where + nodeComments InfixName {} = NodeComments [] [] [] -instance Pretty InfixOperator where - pretty' InfixOperator {..} = +instance Pretty InfixName where + pretty' InfixName {..} = wrap $ hDotSep $ catMaybes [pretty <$> moduleName, Just $ pretty name] where wrap = @@ -32,15 +32,14 @@ instance Pretty InfixOperator where then backticks else id -mkInfixOperator :: GHC.RdrName -> InfixOperator -mkInfixOperator (GHC.Unqual name) = - InfixOperator name Nothing (backticksNeeded name) -mkInfixOperator (GHC.Qual modName name) = - InfixOperator name (Just modName) (backticksNeeded name) -mkInfixOperator (GHC.Orig {}) = +mkInfixName :: GHC.RdrName -> InfixName +mkInfixName (GHC.Unqual name) = InfixName name Nothing (backticksNeeded name) +mkInfixName (GHC.Qual modName name) = + InfixName name (Just modName) (backticksNeeded name) +mkInfixName (GHC.Orig {}) = error "This AST node should not appear in the parser output." -mkInfixOperator (GHC.Exact name) = - InfixOperator (GHC.occName name) Nothing (backticksNeeded $ GHC.occName name) +mkInfixName (GHC.Exact name) = + InfixName (GHC.occName name) Nothing (backticksNeeded $ GHC.occName name) backticksNeeded :: GHC.OccName -> Bool backticksNeeded = not . GHC.isSymOcc diff --git a/src/HIndent/Ast/Name/Prefix.hs b/src/HIndent/Ast/Name/Prefix.hs new file mode 100644 index 000000000..a2e2f2852 --- /dev/null +++ b/src/HIndent/Ast/Name/Prefix.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE RecordWildCards #-} + +module HIndent.Ast.Name.Prefix + ( PrefixName + , mkPrefixName + ) where + +import Data.Maybe +import qualified GHC.Types.Name as GHC +import qualified GHC.Types.Name.Reader as GHC +import qualified GHC.Unit.Module as GHC +import HIndent.Ast.NodeComments +import {-# SOURCE #-} HIndent.Pretty +import HIndent.Pretty.Combinators +import HIndent.Pretty.NodeComments + +data PrefixName = PrefixName + { name :: String + , moduleName :: Maybe GHC.ModuleName + , parentheses :: Bool + } + +instance CommentExtraction PrefixName where + nodeComments PrefixName {} = NodeComments [] [] [] + +instance Pretty PrefixName where + pretty' PrefixName {..} = + wrap $ hDotSep $ catMaybes [pretty <$> moduleName, Just $ string name] + where + wrap = + if parentheses + then parens + else id + +mkPrefixName :: GHC.RdrName -> PrefixName +mkPrefixName (GHC.Unqual name) = + PrefixName (showOutputable name) Nothing (parensNeeded name) +mkPrefixName (GHC.Qual modName name) = + PrefixName (showOutputable name) (Just modName) (parensNeeded name) +mkPrefixName (GHC.Orig {}) = + error "This AST node should not appear in the parser output." +mkPrefixName (GHC.Exact name) = + PrefixName (showOutputable name) Nothing (parensNeeded $ GHC.occName name) + +parensNeeded :: GHC.OccName -> Bool +parensNeeded = GHC.isSymOcc diff --git a/src/HIndent/Ast/Operator/Prefix.hs b/src/HIndent/Ast/Operator/Prefix.hs deleted file mode 100644 index b286b54dd..000000000 --- a/src/HIndent/Ast/Operator/Prefix.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - -module HIndent.Ast.Operator.Prefix - ( PrefixOperator - , mkPrefixOperator - ) where - -import Data.Maybe -import qualified GHC.Types.Name as GHC -import qualified GHC.Types.Name.Reader as GHC -import qualified GHC.Unit.Module as GHC -import HIndent.Ast.NodeComments -import {-# SOURCE #-} HIndent.Pretty -import HIndent.Pretty.Combinators -import HIndent.Pretty.NodeComments - -data PrefixOperator = PrefixOperator - { name :: String - , moduleName :: Maybe GHC.ModuleName - , parentheses :: Bool - } - -instance CommentExtraction PrefixOperator where - nodeComments PrefixOperator {} = NodeComments [] [] [] - -instance Pretty PrefixOperator where - pretty' PrefixOperator {..} = - wrap $ hDotSep $ catMaybes [pretty <$> moduleName, Just $ string name] - where - wrap = - if parentheses - then parens - else id - -mkPrefixOperator :: GHC.RdrName -> PrefixOperator -mkPrefixOperator (GHC.Unqual name) = - PrefixOperator (showOutputable name) Nothing (parensNeeded name) -mkPrefixOperator (GHC.Qual modName name) = - PrefixOperator (showOutputable name) (Just modName) (parensNeeded name) -mkPrefixOperator (GHC.Orig {}) = - error "This AST node should not appear in the parser output." -mkPrefixOperator (GHC.Exact name) = - PrefixOperator (showOutputable name) Nothing (parensNeeded $ GHC.occName name) - -parensNeeded :: GHC.OccName -> Bool -parensNeeded = GHC.isSymOcc diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs index 4855b01cd..8c3a283ea 100644 --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -42,9 +42,9 @@ import HIndent.Ast.Declaration.Family.Type import HIndent.Ast.Declaration.Signature import HIndent.Ast.Expression.Bracket import HIndent.Ast.Expression.Splice +import HIndent.Ast.Name.Infix +import HIndent.Ast.Name.Prefix import HIndent.Ast.NodeComments -import HIndent.Ast.Operator.Infix -import HIndent.Ast.Operator.Prefix import HIndent.Ast.Type.Variable import HIndent.Ast.WithComments import HIndent.Config @@ -152,7 +152,7 @@ instance Pretty (GHC.HsExpr GHC.GhcPs) where pretty' = prettyHsExpr prettyHsExpr :: GHC.HsExpr GHC.GhcPs -> Printer () -prettyHsExpr (GHC.HsVar _ bind) = pretty $ fmap mkPrefixOperator bind +prettyHsExpr (GHC.HsVar _ bind) = pretty $ fmap mkPrefixName bind prettyHsExpr (GHC.HsUnboundVar _ x) = pretty x #if MIN_VERSION_ghc_lib_parser(9,6,1) prettyHsExpr (GHC.HsOverLabel _ _ l) = string "#" >> string (GHC.unpackFS l) @@ -551,7 +551,7 @@ prettyMatchExpr GHC.Match {..} = case (m_pats, m_ctxt) of (l:r:xs, GHC.FunRhs {..}) -> do spaced - $ [pretty l, pretty $ fmap mkInfixOperator mc_fun, pretty r] + $ [pretty l, pretty $ fmap mkInfixName mc_fun, pretty r] ++ fmap pretty xs pretty m_grhss _ -> error "Not enough parameters are passed." @@ -732,10 +732,10 @@ prettyHsType (GHC.HsOpTy _ _ l op r) = do then do pretty l newline - pretty $ fmap mkInfixOperator op + pretty $ fmap mkInfixName op space pretty r - else spaced [pretty l, pretty $ fmap mkInfixOperator op, pretty r] + else spaced [pretty l, pretty $ fmap mkInfixName op, pretty r] #else prettyHsType (GHC.HsOpTy _ l op r) = do lineBreak <- gets (configLineBreaks . psConfig) @@ -743,10 +743,10 @@ prettyHsType (GHC.HsOpTy _ l op r) = do then do pretty l newline - pretty $ fmap mkInfixOperator op + pretty $ fmap mkInfixName op space pretty r - else spaced [pretty l, pretty $ fmap mkInfixOperator op, pretty r] + else spaced [pretty l, pretty $ fmap mkInfixName op, pretty r] #endif prettyHsType (GHC.HsParTy _ inside) = parens $ pretty inside prettyHsType (GHC.HsIParamTy _ x ty) = @@ -831,7 +831,7 @@ instance Pretty ParStmtBlockInsideVerticalList where vCommaSep $ fmap pretty xs instance Pretty GHC.RdrName where - pretty' = pretty . mkPrefixOperator + pretty' = pretty . mkPrefixName instance Pretty (GHC.GRHS @@ -928,7 +928,7 @@ instance Pretty (GHC.Pat GHC.GhcPs) where instance Pretty PatInsidePatDecl where pretty' (PatInsidePatDecl (GHC.ConPat {pat_args = (GHC.InfixCon l r), ..})) = - spaced [pretty l, pretty $ fmap mkInfixOperator pat_con, pretty r] + spaced [pretty l, pretty $ fmap mkInfixName pat_con, pretty r] pretty' (PatInsidePatDecl x) = pretty x prettyPat :: GHC.Pat GHC.GhcPs -> Printer () @@ -960,13 +960,13 @@ prettyPat (GHC.SumPat _ x position numElem) = do prettyPat GHC.ConPat {..} = case pat_args of GHC.PrefixCon _ as -> do - pretty $ fmap mkPrefixOperator pat_con + pretty $ fmap mkPrefixName pat_con spacePrefixed $ fmap pretty as GHC.RecCon rec -> (pretty pat_con >> space) |=> pretty (RecConPat rec) GHC.InfixCon a b -> do pretty a unlessSpecialOp (GHC.unLoc pat_con) space - pretty $ fmap mkInfixOperator pat_con + pretty $ fmap mkInfixName pat_con unlessSpecialOp (GHC.unLoc pat_con) space pretty b prettyPat (GHC.ViewPat _ l r) = spaced [pretty l, string "->", pretty r] @@ -1088,7 +1088,7 @@ instance Pretty a => Pretty (GHC.HsScaled GHC.GhcPs a) where instance Pretty InfixExpr where pretty' (InfixExpr (GHC.L _ (GHC.HsVar _ bind))) = - pretty $ fmap mkInfixOperator bind + pretty $ fmap mkInfixName bind pretty' (InfixExpr x) = pretty' x instance Pretty InfixApp where