diff --git a/hindent.cabal b/hindent.cabal index 3afca70ea..b56580876 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -76,6 +76,9 @@ library HIndent.Ast.Declaration.StandAloneDeriving HIndent.Ast.Declaration.TypeSynonym HIndent.Ast.Declaration.TypeSynonym.Lhs + HIndent.Ast.Declaration.Warning + HIndent.Ast.Declaration.Warning.Collection + HIndent.Ast.Declaration.Warning.Kind HIndent.Ast.FileHeaderPragma HIndent.Ast.FileHeaderPragma.Collection HIndent.Ast.Import @@ -89,7 +92,6 @@ library HIndent.Ast.Module.Export.Entry HIndent.Ast.Module.Name HIndent.Ast.Module.Warning - HIndent.Ast.Module.Warning.Kind HIndent.Ast.NodeComments HIndent.Ast.Type HIndent.Ast.Type.Variable diff --git a/src/HIndent/Ast/Declaration.hs b/src/HIndent/Ast/Declaration.hs index 2fe560a20..f105c3b47 100644 --- a/src/HIndent/Ast/Declaration.hs +++ b/src/HIndent/Ast/Declaration.hs @@ -22,6 +22,7 @@ import HIndent.Ast.Declaration.Signature import HIndent.Ast.Declaration.Signature.StandaloneKind import HIndent.Ast.Declaration.StandAloneDeriving import HIndent.Ast.Declaration.TypeSynonym +import HIndent.Ast.Declaration.Warning.Collection import HIndent.Ast.NodeComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import {-# SOURCE #-} HIndent.Pretty @@ -42,7 +43,7 @@ data Declaration | StandaloneKindSignature StandaloneKind | Default DefaultDeclaration | Foreign ForeignDeclaration - | WarningDecl (GHC.WarnDecls GHC.GhcPs) + | Warnings WarningCollection | AnnDecl (GHC.AnnDecl GHC.GhcPs) | RuleDecl (GHC.RuleDecls GHC.GhcPs) | SpliceDecl (GHC.SpliceDecl GHC.GhcPs) @@ -63,7 +64,7 @@ instance CommentExtraction Declaration where nodeComments StandaloneKindSignature {} = NodeComments [] [] [] nodeComments Default {} = NodeComments [] [] [] nodeComments Foreign {} = NodeComments [] [] [] - nodeComments WarningDecl {} = NodeComments [] [] [] + nodeComments Warnings {} = NodeComments [] [] [] nodeComments AnnDecl {} = NodeComments [] [] [] nodeComments RuleDecl {} = NodeComments [] [] [] nodeComments SpliceDecl {} = NodeComments [] [] [] @@ -84,7 +85,7 @@ instance Pretty Declaration where pretty' (StandaloneKindSignature x) = pretty x pretty' (Default x) = pretty x pretty' (Foreign x) = pretty x - pretty' (WarningDecl x) = pretty x + pretty' (Warnings x) = pretty x pretty' (AnnDecl x) = pretty x pretty' (RuleDecl x) = pretty x pretty' (SpliceDecl x) = pretty x @@ -111,7 +112,7 @@ mkDeclaration (GHC.SigD _ x) = Signature $ mkSignature x mkDeclaration (GHC.KindSigD _ x) = StandaloneKindSignature $ mkStandaloneKind x mkDeclaration (GHC.DefD _ x) = Default $ mkDefaultDeclaration x mkDeclaration (GHC.ForD _ x) = Foreign $ mkForeignDeclaration x -mkDeclaration (GHC.WarningD _ x) = WarningDecl x +mkDeclaration (GHC.WarningD _ x) = Warnings $ mkWarningCollection x mkDeclaration (GHC.AnnD _ x) = AnnDecl x mkDeclaration (GHC.RuleD _ x) = RuleDecl x mkDeclaration (GHC.SpliceD _ x) = SpliceDecl x diff --git a/src/HIndent/Ast/Declaration/Warning.hs b/src/HIndent/Ast/Declaration/Warning.hs new file mode 100644 index 000000000..882abcef2 --- /dev/null +++ b/src/HIndent/Ast/Declaration/Warning.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} + +module HIndent.Ast.Declaration.Warning + ( WarningDeclaration + , mkWarningDeclaration + ) where + +import qualified GHC.Types.SourceText as GHC +import qualified GHC.Types.SrcLoc as GHC +import HIndent.Ast.Declaration.Warning.Kind +import HIndent.Ast.NodeComments +import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC +import qualified HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings as GHC +import {-# SOURCE #-} HIndent.Pretty +import HIndent.Pretty.Combinators +import HIndent.Pretty.NodeComments + +data WarningDeclaration = WarningDeclaration + { names :: [GHC.LIdP GHC.GhcPs] + , kind :: Kind + , reasons :: [GHC.Located GHC.StringLiteral] + } + +instance CommentExtraction WarningDeclaration where + nodeComments _ = NodeComments [] [] [] + +instance Pretty WarningDeclaration where + pretty' WarningDeclaration {..} = do + lined + [ string "{-# " >> pretty kind + , spaced [hCommaSep $ fmap pretty names, hCommaSep $ fmap pretty reasons] + , string " #-}" + ] + +mkWarningDeclaration :: GHC.WarnDecl GHC.GhcPs -> WarningDeclaration +#if MIN_VERSION_ghc_lib_parser(9, 8, 1) +mkWarningDeclaration (GHC.Warning _ names (GHC.DeprecatedTxt _ rs)) = + WarningDeclaration {kind = Deprecated, ..} + where + reasons = fmap (fmap GHC.hsDocString) rs +mkWarningDeclaration (GHC.Warning _ names (GHC.WarningTxt _ _ rs)) = + WarningDeclaration {kind = Warning, ..} + where + reasons = fmap (fmap GHC.hsDocString) rs +#else +mkWarningDeclaration (GHC.Warning _ names (GHC.DeprecatedTxt _ reasons)) = + WarningDeclaration {kind = Deprecated, ..} +mkWarningDeclaration (GHC.Warning _ names (GHC.WarningTxt _ reasons)) = + WarningDeclaration {kind = Warning, ..} +#endif diff --git a/src/HIndent/Ast/Declaration/Warning/Collection.hs b/src/HIndent/Ast/Declaration/Warning/Collection.hs new file mode 100644 index 000000000..36e2e6579 --- /dev/null +++ b/src/HIndent/Ast/Declaration/Warning/Collection.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE CPP #-} + +module HIndent.Ast.Declaration.Warning.Collection + ( WarningCollection + , mkWarningCollection + ) where + +import HIndent.Ast.Declaration.Warning +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 + +newtype WarningCollection = + WarningCollection [WithComments WarningDeclaration] + +instance CommentExtraction WarningCollection where + nodeComments WarningCollection {} = NodeComments [] [] [] + +instance Pretty WarningCollection where + pretty' (WarningCollection xs) = lined $ fmap pretty xs + +mkWarningCollection :: GHC.WarnDecls GHC.GhcPs -> WarningCollection +#if MIN_VERSION_ghc_lib_parser(9, 6, 1) +mkWarningCollection (GHC.Warnings _ xs) = + WarningCollection $ fmap (fmap mkWarningDeclaration . fromGenLocated) xs +#else +mkWarningCollection (GHC.Warnings _ _ xs) = + WarningCollection $ fmap (fmap mkWarningDeclaration . fromGenLocated) xs +#endif diff --git a/src/HIndent/Ast/Module/Warning/Kind.hs b/src/HIndent/Ast/Declaration/Warning/Kind.hs similarity index 81% rename from src/HIndent/Ast/Module/Warning/Kind.hs rename to src/HIndent/Ast/Declaration/Warning/Kind.hs index 48a780ad3..b1f69ef82 100644 --- a/src/HIndent/Ast/Module/Warning/Kind.hs +++ b/src/HIndent/Ast/Declaration/Warning/Kind.hs @@ -1,9 +1,9 @@ -module HIndent.Ast.Module.Warning.Kind +module HIndent.Ast.Declaration.Warning.Kind ( Kind(..) ) where import HIndent.Ast.NodeComments -import HIndent.Pretty +import {-# SOURCE #-} HIndent.Pretty import HIndent.Pretty.Combinators import HIndent.Pretty.NodeComments diff --git a/src/HIndent/Ast/Module/Warning.hs b/src/HIndent/Ast/Module/Warning.hs index 92b3cd519..7a0ec41f4 100644 --- a/src/HIndent/Ast/Module/Warning.hs +++ b/src/HIndent/Ast/Module/Warning.hs @@ -6,7 +6,7 @@ module HIndent.Ast.Module.Warning , mkModuleWarning ) where -import HIndent.Ast.Module.Warning.Kind +import HIndent.Ast.Declaration.Warning.Kind import HIndent.Ast.NodeComments import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs index 66b1a8ab9..cc8f7b1e6 100644 --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -36,7 +36,6 @@ 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 qualified GHC.Unit.Module.Warnings as GHC import HIndent.Applicative import HIndent.Ast.Declaration import HIndent.Ast.Declaration.Bind @@ -1425,42 +1424,6 @@ instance Pretty (GHC.HsQuote GHC.GhcPs) where pretty' (GHC.VarBr _ True x) = string "'" >> pretty x pretty' (GHC.VarBr _ False x) = string "''" >> pretty x #endif -#if MIN_VERSION_ghc_lib_parser(9,6,1) -instance Pretty (GHC.WarnDecls GHC.GhcPs) where - pretty' (GHC.Warnings _ x) = lined $ fmap pretty x -#else -instance Pretty (GHC.WarnDecls GHC.GhcPs) where - pretty' (GHC.Warnings _ _ x) = lined $ fmap pretty x -#endif -#if MIN_VERSION_ghc_lib_parser(9,8,1) -instance Pretty (GHC.WarnDecl GHC.GhcPs) where - pretty' (GHC.Warning _ names deprecatedOrWarning) = - case deprecatedOrWarning of - GHC.DeprecatedTxt _ reasons -> prettyWithTitleReasons "DEPRECATED" reasons - GHC.WarningTxt _ _ reasons -> prettyWithTitleReasons "WARNING" reasons - where - prettyWithTitleReasons title reasons = - lined - [ string $ "{-# " ++ title - , spaced - [hCommaSep $ fmap pretty names, hCommaSep $ fmap pretty reasons] - , string " #-}" - ] -#else -instance Pretty (GHC.WarnDecl GHC.GhcPs) where - pretty' (GHC.Warning _ names deprecatedOrWarning) = - case deprecatedOrWarning of - GHC.DeprecatedTxt _ reasons -> prettyWithTitleReasons "DEPRECATED" reasons - GHC.WarningTxt _ reasons -> prettyWithTitleReasons "WARNING" reasons - where - prettyWithTitleReasons title reasons = - lined - [ string $ "{-# " ++ title - , spaced - [hCommaSep $ fmap pretty names, hCommaSep $ fmap pretty reasons] - , string " #-}" - ] -#endif #if MIN_VERSION_ghc_lib_parser(9,4,1) instance Pretty (GHC.WithHsDocIdentifiers GHC.StringLiteral GHC.GhcPs) where pretty' GHC.WithHsDocIdentifiers {..} = pretty hsDocString diff --git a/src/HIndent/Pretty.hs-boot b/src/HIndent/Pretty.hs-boot index c5ebc0e3c..e7b56ba89 100644 --- a/src/HIndent/Pretty.hs-boot +++ b/src/HIndent/Pretty.hs-boot @@ -11,6 +11,7 @@ import Data.Void import qualified GHC.Core.Type as GHC import qualified GHC.Types.Basic 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 qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHc @@ -77,7 +78,7 @@ instance Pretty (GHC.HsPatSynDir GHC.GhcPs) instance Pretty PatInsidePatDecl -instance Pretty (GHC.WarnDecls GHC.GhcPs) +instance Pretty GHC.StringLiteral instance Pretty (GHC.AnnDecl GHC.GhcPs)