diff --git a/hindent.cabal b/hindent.cabal index ba80384ee..ca8b052e1 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -88,6 +88,7 @@ library HIndent.Ast.Declaration.Warning HIndent.Ast.Declaration.Warning.Collection HIndent.Ast.Declaration.Warning.Kind + HIndent.Ast.Expression.Bracket HIndent.Ast.Expression.Splice HIndent.Ast.FileHeaderPragma HIndent.Ast.FileHeaderPragma.Collection diff --git a/src/HIndent/Ast/Expression/Bracket.hs b/src/HIndent/Ast/Expression/Bracket.hs new file mode 100644 index 000000000..45b2fcba3 --- /dev/null +++ b/src/HIndent/Ast/Expression/Bracket.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE CPP #-} + +module HIndent.Ast.Expression.Bracket + ( Bracket + , mkBracket + ) where + +import HIndent.Ast.Declaration +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 Bracket + = TypedExpression (GHC.LHsExpr GHC.GhcPs) + | UntypedExpression (GHC.LHsExpr GHC.GhcPs) + | Pattern (GHC.LPat GHC.GhcPs) + | Declaration [WithComments Declaration] + | Type (GHC.LHsType GHC.GhcPs) + | Variable Bool (GHC.LIdP GHC.GhcPs) + +instance CommentExtraction Bracket where + nodeComments TypedExpression {} = NodeComments [] [] [] + nodeComments UntypedExpression {} = NodeComments [] [] [] + nodeComments Pattern {} = NodeComments [] [] [] + nodeComments Declaration {} = NodeComments [] [] [] + nodeComments Type {} = NodeComments [] [] [] + nodeComments Variable {} = NodeComments [] [] [] + +instance Pretty Bracket where + pretty' (TypedExpression x) = typedBrackets $ pretty x + pretty' (UntypedExpression x) = brackets $ wrapWithBars $ pretty x + pretty' (Pattern x) = brackets $ string "p" >> wrapWithBars (pretty x) + pretty' (Declaration decls) = + brackets $ string "d| " |=> lined (fmap pretty decls) >> string " |" + pretty' (Type x) = brackets $ string "t" >> wrapWithBars (pretty x) + pretty' (Variable True var) = string "'" >> pretty var + pretty' (Variable False var) = string "''" >> pretty var +#if MIN_VERSION_ghc_lib_parser(9, 4, 1) +mkBracket :: GHC.HsQuote GHC.GhcPs -> Bracket +#else +mkBracket :: GHC.HsBracket GHC.GhcPs -> Bracket +#endif +mkBracket (GHC.ExpBr _ x) = UntypedExpression x +mkBracket (GHC.PatBr _ x) = Pattern x +mkBracket (GHC.DecBrL _ x) = + Declaration $ fmap (fmap mkDeclaration . fromGenLocated) x +mkBracket (GHC.TypBr _ x) = Type x +mkBracket (GHC.VarBr _ b x) = Variable b x +mkBracket (GHC.DecBrG {}) = error "This AST node should never appear." +#if !MIN_VERSION_ghc_lib_parser(9, 4, 1) +mkBracket (GHC.TExpBr _ x) = TypedExpression x +#endif diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs index 1d6f5d0ed..4855b01cd 100644 --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -35,12 +35,12 @@ import qualified GHC.Types.Name as GHC import qualified GHC.Types.Name.Reader as GHC import qualified GHC.Types.SourceText as GHC import qualified GHC.Types.SrcLoc as GHC -import HIndent.Ast.Declaration import HIndent.Ast.Declaration.Bind import HIndent.Ast.Declaration.Data.Body import HIndent.Ast.Declaration.Data.Record.Field import HIndent.Ast.Declaration.Family.Type import HIndent.Ast.Declaration.Signature +import HIndent.Ast.Expression.Bracket import HIndent.Ast.Expression.Splice import HIndent.Ast.NodeComments import HIndent.Ast.Operator.Infix @@ -429,7 +429,7 @@ prettyHsExpr (GHC.HsPragE _ p x) = spaced [pretty p, pretty x] #if MIN_VERSION_ghc_lib_parser(9,4,1) prettyHsExpr GHC.HsRecSel {} = notGeneratedByParser prettyHsExpr (GHC.HsTypedBracket _ inner) = typedBrackets $ pretty inner -prettyHsExpr (GHC.HsUntypedBracket _ inner) = pretty inner +prettyHsExpr (GHC.HsUntypedBracket _ inner) = pretty $ mkBracket inner #else prettyHsExpr GHC.HsConLikeOut {} = notGeneratedByParser prettyHsExpr GHC.HsRecFld {} = notGeneratedByParser @@ -439,7 +439,7 @@ prettyHsExpr (GHC.HsDo _ GHC.ParStmtCtxt {} _) = notGeneratedByParser prettyHsExpr (GHC.HsDo _ GHC.TransStmtCtxt {} _) = notGeneratedByParser prettyHsExpr GHC.HsTick {} = forHpc prettyHsExpr GHC.HsBinTick {} = forHpc -prettyHsExpr (GHC.HsBracket _ inner) = pretty inner +prettyHsExpr (GHC.HsBracket _ inner) = pretty $ mkBracket inner prettyHsExpr GHC.HsRnBracketOut {} = notGeneratedByParser prettyHsExpr GHC.HsTcBracketOut {} = notGeneratedByParser #endif @@ -986,23 +986,7 @@ instance Pretty RecConPat where fieldPrinters = fmap (pretty . fmap RecConField) rec_flds ++ maybeToList (fmap (const (string "..")) rec_dotdot) -#if !MIN_VERSION_ghc_lib_parser(9,4,1) -instance Pretty (GHC.HsBracket GHC.GhcPs) where - pretty' (GHC.ExpBr _ expr) = brackets $ wrapWithBars $ pretty expr - pretty' (GHC.PatBr _ expr) = - brackets $ string "p" >> wrapWithBars (pretty expr) - pretty' (GHC.DecBrL _ decls) = - brackets - $ string "d| " - |=> lined (fmap (pretty . fmap mkDeclaration . fromGenLocated) decls) - >> string " |" - pretty' GHC.DecBrG {} = notGeneratedByParser - pretty' (GHC.TypBr _ expr) = - brackets $ string "t" >> wrapWithBars (pretty expr) - pretty' (GHC.VarBr _ True var) = string "'" >> pretty var - pretty' (GHC.VarBr _ False var) = string "''" >> pretty var - pretty' (GHC.TExpBr _ x) = typedBrackets $ pretty x -#endif + instance Pretty SBF.SigBindFamily where pretty' (SBF.Sig x) = pretty $ mkSignature x pretty' (SBF.Bind x) = pretty $ mkBind x @@ -1329,20 +1313,6 @@ instance Pretty pretty' GHC.HsArgPar {} = notUsedInParsedStage #endif #if MIN_VERSION_ghc_lib_parser(9,4,1) -instance Pretty (GHC.HsQuote GHC.GhcPs) where - pretty' (GHC.ExpBr _ x) = brackets $ wrapWithBars $ pretty x - pretty' (GHC.PatBr _ x) = brackets $ string "p" >> wrapWithBars (pretty x) - pretty' (GHC.DecBrL _ decls) = - brackets - $ string "d| " - |=> lined (fmap (pretty . fmap mkDeclaration . fromGenLocated) decls) - >> string " |" - pretty' GHC.DecBrG {} = notUsedInParsedStage - pretty' (GHC.TypBr _ x) = brackets $ string "t" >> wrapWithBars (pretty x) - pretty' (GHC.VarBr _ True x) = string "'" >> pretty x - pretty' (GHC.VarBr _ False x) = string "''" >> pretty x -#endif -#if MIN_VERSION_ghc_lib_parser(9,4,1) instance Pretty (GHC.WithHsDocIdentifiers GHC.StringLiteral GHC.GhcPs) where pretty' GHC.WithHsDocIdentifiers {..} = pretty hsDocString #endif