From 1620de5bb767304060e79f41e9b090a6c0d7bf23 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Mon, 22 Jul 2024 19:49:48 +0900 Subject: [PATCH] Fix --- .../Ast/Declaration/Data/GADT/Constructor.hs | 2 +- src/HIndent/Ast/Declaration/Signature.hs | 20 ++++++++++++++----- src/HIndent/Ast/Declaration/Warning.hs | 8 ++++++-- src/HIndent/Pretty.hs | 20 ++++++++++++++----- 4 files changed, 37 insertions(+), 13 deletions(-) diff --git a/src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs b/src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs index 4bddf8a4a..5936ea2bd 100644 --- 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 @@ -19,7 +20,6 @@ import HIndent.Pretty.Combinators import HIndent.Pretty.NodeComments #if MIN_VERSION_ghc_lib_parser(9, 6, 0) import qualified Data.List.NonEmpty as NE -import HIndent.Ast.Name.Prefix #endif data GADTConstructor = GADTConstructor { names :: [WithComments PrefixName] diff --git a/src/HIndent/Ast/Declaration/Signature.hs b/src/HIndent/Ast/Declaration/Signature.hs index 1e2847213..4847e8a37 100644 --- a/src/HIndent/Ast/Declaration/Signature.hs +++ b/src/HIndent/Ast/Declaration/Signature.hs @@ -178,21 +178,31 @@ mkSignature (GHC.SpecSig _ n sigs _) = Specialise {..} where name = fromGenLocated $ fmap mkPrefixName n #if MIN_VERSION_ghc_lib_parser(9, 6, 0) -mkSignature (GHC.SpecInstSig _ sig) = SpecialiseInstance sig -mkSignature (GHC.MinimalSig _ xs) = - Minimal $ mkBooleanFormula <$> fromGenLocated xs mkSignature (GHC.SCCFunSig _ n _) = Scc name where name = fromGenLocated $ fmap mkPrefixName n mkSignature (GHC.CompleteMatchSig _ ns _) = Complete names where names = fromGenLocated $ fmap (fmap (fromGenLocated . fmap mkPrefixName)) ns +#elif MIN_VERSION_ghc_lib_parser(9, 4, 0) +mkSignature (GHC.SCCFunSig _ _ name _) = Scc name +mkSignature (GHC.CompleteMatchSig _ _ names _) = Complete names +#else +mkSignature (GHC.SCCFunSig _ _ ns _) = + Scc $ fromGenLocated $ fmap mkPrefixName ns +mkSignature (GHC.CompleteMatchSig _ _ names _) = + Complete + $ fromGenLocated + $ fmap (fmap (fromGenLocated . fmap mkPrefixName)) names +#endif +#if MIN_VERSION_ghc_lib_parser(9, 6, 0) +mkSignature (GHC.SpecInstSig _ sig) = SpecialiseInstance sig +mkSignature (GHC.MinimalSig _ xs) = + Minimal $ mkBooleanFormula <$> fromGenLocated xs #else mkSignature (GHC.SpecInstSig _ _ sig) = SpecialiseInstance sig mkSignature (GHC.MinimalSig _ _ xs) = Minimal $ mkBooleanFormula <$> fromGenLocated xs -mkSignature (GHC.SCCFunSig _ _ name _) = Scc name -mkSignature (GHC.CompleteMatchSig _ _ names _) = Complete names mkSignature GHC.IdSig {} = error "`ghc-lib-parser` never generates this AST node." #endif diff --git a/src/HIndent/Ast/Declaration/Warning.hs b/src/HIndent/Ast/Declaration/Warning.hs index 899f67d6f..afcf72c63 100644 --- a/src/HIndent/Ast/Declaration/Warning.hs +++ b/src/HIndent/Ast/Declaration/Warning.hs @@ -59,8 +59,12 @@ mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ rs)) = names = fmap (fromGenLocated . fmap mkPrefixName) ns reasons = fmap (fmap GHC.hsDocString) rs #else -mkWarningDeclaration (GHC.Warning _ names (GHC.DeprecatedTxt _ reasons)) = +mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ reasons)) = WarningDeclaration {kind = Deprecated, ..} -mkWarningDeclaration (GHC.Warning _ names (GHC.WarningTxt _ reasons)) = + where + names = fmap (fromGenLocated . fmap mkPrefixName) ns +mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ reasons)) = WarningDeclaration {kind = Warning, ..} + where + names = fmap (fromGenLocated . fmap mkPrefixName) ns #endif diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs index aeb9e8259..9027f08b0 100644 --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -154,7 +154,11 @@ instance Pretty (GHC.HsExpr GHC.GhcPs) where prettyHsExpr :: GHC.HsExpr GHC.GhcPs -> Printer () prettyHsExpr (GHC.HsVar _ bind) = pretty $ fmap mkPrefixName bind +#if MIN_VERSION_ghc_lib_parser(9, 4, 0) prettyHsExpr (GHC.HsUnboundVar _ x) = pretty $ mkPrefixName x +#else +prettyHsExpr (GHC.HsUnboundVar _ x) = pretty x +#endif #if MIN_VERSION_ghc_lib_parser(9,6,1) prettyHsExpr (GHC.HsOverLabel _ _ l) = string "#" >> string (GHC.unpackFS l) #else @@ -947,7 +951,8 @@ prettyPat (GHC.LazyPat _ x) = string "~" >> pretty x prettyPat (GHC.AsPat _ a _ b) = pretty (fmap mkPrefixName a) >> string "@" >> pretty b #else -prettyPat (GHC.AsPat _ a b) = pretty a >> string "@" >> pretty b +prettyPat (GHC.AsPat _ a b) = + pretty (fmap mkPrefixName a) >> string "@" >> pretty b #endif #if MIN_VERSION_ghc_lib_parser(9,4,1) prettyPat (GHC.ParPat _ _ inner _) = parens $ pretty inner @@ -1297,7 +1302,10 @@ instance Pretty FamEqn' where #else instance Pretty FamEqn' where pretty' FamEqn' {famEqn = GHC.FamEqn {..}, ..} = do - spaced $ string prefix : pretty feqn_tycon : fmap pretty feqn_pats + spaced + $ string prefix + : pretty (fmap mkPrefixName feqn_tycon) + : fmap pretty feqn_pats pretty (mkDataBody feqn_rhs) where prefix = @@ -1342,9 +1350,11 @@ instance Pretty (GHC.IEWrappedName GHC.GhcPs) where #else -- | 'Pretty' for 'LIEWrappedName (IdP GhcPs)' instance Pretty (GHC.IEWrappedName GHC.RdrName) where - pretty' (GHC.IEName name) = pretty name - pretty' (GHC.IEPattern _ name) = spaced [string "pattern", pretty name] - pretty' (GHC.IEType _ name) = string "type " >> pretty name + pretty' (GHC.IEName name) = pretty $ fmap mkPrefixName name + pretty' (GHC.IEPattern _ name) = + spaced [string "pattern", pretty $ fmap mkPrefixName name] + pretty' (GHC.IEType _ name) = + string "type " >> pretty (fmap mkPrefixName name) #endif #if MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty (GHC.DotFieldOcc GHC.GhcPs) where