Support GHC 9.10

mihaimaruseac · Sep 3, 2024 · ef709c7 · ef709c7
1 parent 0d2bd1f
commit ef709c7
Show file tree

Hide file tree

Showing 24 changed files with 1,325 additions and 148 deletions.
diff --git a/.github/workflows/presubmit-cabal.yaml b/.github/workflows/presubmit-cabal.yaml
@@ -20,7 +20,7 @@ jobs:
         # `haskell-actions/setup`.
         # See https://github.com/haskell-actions/setup/issues/77.
         os: [ubuntu-latest, macos-13, windows-latest]
-        ghc: [8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.4, 9.8.1]
+        ghc: [8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.4, 9.8.1, 9.10.1]
     defaults:
       run:
         # The default shell on Windows is `pwsh`. However, it doesn't expand

diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -4,7 +4,7 @@
 
 ### Added
 
-- Support for GHC 9.8 ([#775]).
+- Support for GHC 9.8 ([#775]) and GHC 9.10([#904]).
 - Support for `ImportPostQualified` ([#875]).
 - HIndent now formats multiple files in parallel ([#914]).
 
@@ -13,6 +13,7 @@
 - The formatting style of import declarations with constructors ([#829]).
 - HIndent no longer inserts an empty line after a standalone kind signature ([#873]).
 - Bumped Stack LTS to 22.26 ([#918]).
+- HIndent re-assumes the default extensions are enabled ([#904]).
 
 ### Fixed
 
@@ -381,6 +382,7 @@ This version is accidentally pushlished, and is the same as 5.3.3.
 
 [#918]: https://github.com/mihaimaruseac/hindent/pull/918
 [#914]: https://github.com/mihaimaruseac/hindent/pull/914
+[#904]: https://github.com/mihaimaruseac/hindent/pull/904
 [#875]: https://github.com/mihaimaruseac/hindent/pull/875
 [#873]: https://github.com/mihaimaruseac/hindent/pull/873
 [#868]: https://github.com/mihaimaruseac/hindent/pull/868

diff --git a/README.md b/README.md
@@ -58,7 +58,10 @@ line-length: 80
 force-trailing-newline: true
 sort-imports: true
 line-breaks: []
-extensions: []
+extensions: [
+    "GHC2021",
+    "ListTuplePuns",
+]
 ```
 
 By default, hindent preserves the newline or lack of newline in your input. With `force-trailing-newline`, it will make sure there is always a trailing newline.

diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs
@@ -32,7 +32,7 @@ toCriterion = go
                (UTF8.toString desc)
                (nf
                   (either (error . show) id
-                     . reformat HIndent.defaultConfig [] Nothing)
+                     . reformat HIndent.defaultConfig defaultExtensions Nothing)
                   code)
                : go next
         else go next

diff --git a/hindent.cabal b/hindent.cabal
@@ -160,7 +160,7 @@ library
     , directory
     , exceptions
     , filepath
-    , ghc-lib-parser >=9.2 && <9.9
+    , ghc-lib-parser >=9.2 && <9.11
     , ghc-lib-parser-ex
     , monad-loops
     , mtl
@@ -196,7 +196,7 @@ library hindent-internal
     , directory
     , exceptions
     , filepath
-    , ghc-lib-parser >=9.2 && <9.9
+    , ghc-lib-parser >=9.2 && <9.11
     , ghc-lib-parser-ex
     , monad-loops
     , mtl
@@ -230,7 +230,7 @@ executable hindent
     , directory
     , exceptions
     , filepath
-    , ghc-lib-parser >=9.2 && <9.9
+    , ghc-lib-parser >=9.2 && <9.11
     , ghc-lib-parser-ex
     , hindent
     , monad-loops
@@ -267,7 +267,7 @@ test-suite hindent-test
     , directory
     , exceptions
     , filepath
-    , ghc-lib-parser >=9.2 && <9.9
+    , ghc-lib-parser >=9.2 && <9.11
     , ghc-lib-parser-ex
     , hindent
     , hindent-internal
@@ -307,7 +307,7 @@ benchmark hindent-bench
     , directory
     , exceptions
     , filepath
-    , ghc-lib-parser >=9.2 && <9.9
+    , ghc-lib-parser >=9.2 && <9.11
     , ghc-lib-parser-ex
     , hindent
     , hindent-internal

diff --git a/package.yaml b/package.yaml
@@ -35,7 +35,7 @@ dependencies:
   - directory
   - exceptions
   - filepath
-  - ghc-lib-parser >= 9.2 && < 9.9
+  - ghc-lib-parser >= 9.2 && < 9.11
   - ghc-lib-parser-ex
   - monad-loops
   - mtl

diff --git a/src/HIndent.hs b/src/HIndent.hs
@@ -15,6 +15,7 @@ module HIndent
   , getConfig
   , -- * Extension
     Extension(..)
+  , defaultExtensions
   , -- * Error
     ParseError(..)
   , prettyParseError

diff --git a/src/HIndent/Ast/Declaration/Data/GADT/Constructor/Signature.hs b/src/HIndent/Ast/Declaration/Data/GADT/Constructor/Signature.hs
@@ -49,14 +49,33 @@ prettyVertically Record {..} =
     [prettyWith fields (vFields' . fmap pretty), pretty result]
 
 mkConstructorSignature :: GHC.ConDecl GHC.GhcPs -> Maybe ConstructorSignature
+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
+mkConstructorSignature GHC.ConDeclGADT {con_g_args = GHC.PrefixConGADT _ xs, ..} =
+  Just
+    $ ByArrows
+        { parameters =
+            fmap (fmap mkType . fromGenLocated . GHC.hsScaledThing) xs
+        , result = mkType <$> fromGenLocated con_res_ty
+        }
+#else
 mkConstructorSignature GHC.ConDeclGADT {con_g_args = GHC.PrefixConGADT xs, ..} =
   Just
     $ ByArrows
         { parameters =
             fmap (fmap mkType . fromGenLocated . GHC.hsScaledThing) xs
         , result = mkType <$> fromGenLocated con_res_ty
         }
-#if MIN_VERSION_ghc_lib_parser(9, 4, 0)
+#endif
+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
+mkConstructorSignature GHC.ConDeclGADT {con_g_args = GHC.RecConGADT _ xs, ..} =
+  Just
+    $ Record
+        { fields =
+            fromGenLocated
+              $ fmap (fmap (fmap mkRecordField . fromGenLocated)) xs
+        , result = mkType <$> fromGenLocated con_res_ty
+        }
+#elif MIN_VERSION_ghc_lib_parser(9, 4, 0)
 mkConstructorSignature GHC.ConDeclGADT {con_g_args = GHC.RecConGADT xs _, ..} =
   Just
     $ Record

diff --git a/src/HIndent/Ast/Declaration/Instance/Family/Data.hs b/src/HIndent/Ast/Declaration/Instance/Family/Data.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards, CPP #-}
 
 module HIndent.Ast.Declaration.Instance.Family.Data
   ( DataFamilyInstance
@@ -15,14 +15,21 @@ import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
 import {-# SOURCE #-} HIndent.Pretty
 import HIndent.Pretty.Combinators
 import HIndent.Pretty.NodeComments
-
+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
+data DataFamilyInstance = DataFamilyInstance
+  { newOrData :: NewOrData
+  , name :: WithComments PrefixName
+  , types :: GHC.HsFamEqnPats GHC.GhcPs
+  , body :: DataBody
+  }
+#else
 data DataFamilyInstance = DataFamilyInstance
   { newOrData :: NewOrData
   , name :: WithComments PrefixName
   , types :: GHC.HsTyPats GHC.GhcPs
   , body :: DataBody
   }
-
+#endif
 instance CommentExtraction DataFamilyInstance where
   nodeComments DataFamilyInstance {} = NodeComments [] [] []
 

diff --git a/src/HIndent/Ast/Declaration/Instance/Family/Type.hs b/src/HIndent/Ast/Declaration/Instance/Family/Type.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards, CPP #-}
 
 module HIndent.Ast.Declaration.Instance.Family.Type
   ( TypeFamilyInstance
@@ -12,13 +12,19 @@ import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
 import {-# SOURCE #-} HIndent.Pretty
 import HIndent.Pretty.Combinators
 import HIndent.Pretty.NodeComments
-
+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
+data TypeFamilyInstance = TypeFamilyInstance
+  { name :: WithComments PrefixName
+  , types :: GHC.HsFamEqnPats GHC.GhcPs
+  , bind :: GHC.LHsType GHC.GhcPs
+  }
+#else
 data TypeFamilyInstance = TypeFamilyInstance
   { name :: WithComments PrefixName
   , types :: GHC.HsTyPats GHC.GhcPs
   , bind :: GHC.LHsType GHC.GhcPs
   }
-
+#endif
 instance CommentExtraction TypeFamilyInstance where
   nodeComments TypeFamilyInstance {} = NodeComments [] [] []
 

diff --git a/src/HIndent/Ast/Declaration/Signature.hs b/src/HIndent/Ast/Declaration/Signature.hs
@@ -177,7 +177,14 @@ mkSignature (GHC.InlineSig _ n GHC.InlinePragma {..}) = Inline {..}
 mkSignature (GHC.SpecSig _ n sigs _) = Specialise {..}
   where
     name = fromGenLocated $ fmap mkPrefixName n
-#if MIN_VERSION_ghc_lib_parser(9, 6, 0)
+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
+mkSignature (GHC.SCCFunSig _ n _) = Scc name
+  where
+    name = fromGenLocated $ fmap mkPrefixName n
+mkSignature (GHC.CompleteMatchSig _ ns _) = Complete names
+  where
+    names = mkWithComments $ fmap (fromGenLocated . fmap mkPrefixName) ns
+#elif MIN_VERSION_ghc_lib_parser(9, 6, 0)
 mkSignature (GHC.SCCFunSig _ n _) = Scc name
   where
     name = fromGenLocated $ fmap mkPrefixName n

diff --git a/src/HIndent/Ast/Declaration/Warning.hs b/src/HIndent/Ast/Declaration/Warning.hs
@@ -7,7 +7,6 @@ module HIndent.Ast.Declaration.Warning
   ) where
 
 import qualified GHC.Types.SourceText as GHC
-import qualified GHC.Types.SrcLoc as GHC
 import HIndent.Ast.Declaration.Warning.Kind
 import HIndent.Ast.Name.Prefix
 import HIndent.Ast.NodeComments
@@ -21,7 +20,7 @@ import HIndent.Pretty.NodeComments
 data WarningDeclaration = WarningDeclaration
   { names :: [WithComments PrefixName]
   , kind :: Kind
-  , reasons :: [GHC.Located GHC.StringLiteral]
+  , reasons :: [WithComments GHC.StringLiteral]
   }
 
 instance CommentExtraction WarningDeclaration where
@@ -36,35 +35,48 @@ instance Pretty WarningDeclaration where
       ]
 
 mkWarningDeclaration :: GHC.WarnDecl GHC.GhcPs -> WarningDeclaration
-#if MIN_VERSION_ghc_lib_parser(9, 8, 1)
+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
 mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ rs)) =
   WarningDeclaration {kind = Deprecated, ..}
   where
     names = fmap (fromGenLocated . fmap mkPrefixName) ns
-    reasons = fmap (fmap GHC.hsDocString) rs
+    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs
 mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ _ rs)) =
   WarningDeclaration {kind = Warning, ..}
   where
     names = fmap (fromGenLocated . fmap mkPrefixName) ns
-    reasons = fmap (fmap GHC.hsDocString) rs
+    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs
+#elif MIN_VERSION_ghc_lib_parser(9, 8, 1)
+mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ rs)) =
+  WarningDeclaration {kind = Deprecated, ..}
+  where
+    names = fmap (fromGenLocated . fmap mkPrefixName) ns
+    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs
+mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ _ rs)) =
+  WarningDeclaration {kind = Warning, ..}
+  where
+    names = fmap (fromGenLocated . fmap mkPrefixName) ns
+    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs
 #elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
 mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ rs)) =
   WarningDeclaration {kind = Deprecated, ..}
   where
     names = fmap (fromGenLocated . fmap mkPrefixName) ns
-    reasons = fmap (fmap GHC.hsDocString) rs
+    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs
 mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ rs)) =
   WarningDeclaration {kind = Warning, ..}
   where
     names = fmap (fromGenLocated . fmap mkPrefixName) ns
-    reasons = fmap (fmap GHC.hsDocString) rs
+    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs
 #else
-mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ reasons)) =
+mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ rs)) =
   WarningDeclaration {kind = Deprecated, ..}
   where
     names = fmap (fromGenLocated . fmap mkPrefixName) ns
-mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ reasons)) =
+    reasons = fmap fromGenLocated rs
+mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ rs)) =
   WarningDeclaration {kind = Warning, ..}
   where
     names = fmap (fromGenLocated . fmap mkPrefixName) ns
+    reasons = fmap fromGenLocated rs
 #endif
diff --git a/src/HIndent/Ast/Import/Entry.hs b/src/HIndent/Ast/Import/Entry.hs
@@ -43,11 +43,19 @@ instance Pretty ImportEntry where
     pretty name >> hFillingTuple (fmap pretty constructors)
 
 mkImportEntry :: GHC.IE GHC.GhcPs -> ImportEntry
+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
+mkImportEntry (GHC.IEVar _ name _) = SingleIdentifier name
+mkImportEntry (GHC.IEThingAbs _ name _) = SingleIdentifier name
+mkImportEntry (GHC.IEThingAll _ name _) = WithAllConstructors name
+mkImportEntry (GHC.IEThingWith _ name _ constructors _) =
+  WithSpecificConstructors {..}
+#else
 mkImportEntry (GHC.IEVar _ name) = SingleIdentifier name
 mkImportEntry (GHC.IEThingAbs _ name) = SingleIdentifier name
 mkImportEntry (GHC.IEThingAll _ name) = WithAllConstructors name
 mkImportEntry (GHC.IEThingWith _ name _ constructors) =
   WithSpecificConstructors {..}
+#endif
 mkImportEntry _ = undefined
 
 sortVariantsAndExplicitImports ::

diff --git a/src/HIndent/Ast/Module/Export/Entry.hs b/src/HIndent/Ast/Module/Export/Entry.hs
@@ -43,11 +43,19 @@ instance Pretty ExportEntry where
   pretty' (ByModule s) = string "module " >> pretty s
 
 mkExportEntry :: GHC.IE GHC.GhcPs -> ExportEntry
+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
+mkExportEntry (GHC.IEVar _ name _) = SingleIdentifier name
+mkExportEntry (GHC.IEThingAbs _ name _) = SingleIdentifier name
+mkExportEntry (GHC.IEThingAll _ name _) = WithAllConstructors name
+mkExportEntry (GHC.IEThingWith _ name _ constructors _) =
+  WithSpecificConstructors name constructors
+#else
 mkExportEntry (GHC.IEVar _ name) = SingleIdentifier name
 mkExportEntry (GHC.IEThingAbs _ name) = SingleIdentifier name
 mkExportEntry (GHC.IEThingAll _ name) = WithAllConstructors name
 mkExportEntry (GHC.IEThingWith _ name _ constructors) =
   WithSpecificConstructors name constructors
+#endif
 mkExportEntry (GHC.IEModuleContents _ name) = ByModule name
 mkExportEntry GHC.IEGroup {} = neverAppears
 mkExportEntry GHC.IEDoc {} = neverAppears

diff --git a/src/HIndent/Ast/Module/Warning.hs b/src/HIndent/Ast/Module/Warning.hs
@@ -16,7 +16,13 @@ import qualified HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings as GHC
 import HIndent.Pretty
 import HIndent.Pretty.Combinators
 import HIndent.Pretty.NodeComments
-#if MIN_VERSION_ghc_lib_parser(9, 4, 1)
+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
+data ModuleWarning = ModuleWarning
+  { messages :: [GHC.LocatedE
+                   (GHC.WithHsDocIdentifiers GHC.StringLiteral GHC.GhcPs)]
+  , kind :: Kind
+  }
+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
 data ModuleWarning = ModuleWarning
   { messages :: [GHC.Located
                    (GHC.WithHsDocIdentifiers GHC.StringLiteral GHC.GhcPs)]
@@ -54,6 +60,12 @@ fromWarningTxt (GHC.WarningTxt _ messages) = ModuleWarning {..}
   where
     kind = Warning
 #endif
+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
 fromWarningTxt (GHC.DeprecatedTxt _ messages) = ModuleWarning {..}
   where
     kind = Deprecated
+#else
+fromWarningTxt (GHC.DeprecatedTxt _ messages) = ModuleWarning {..}
+  where
+    kind = Deprecated
+#endif
diff --git a/src/HIndent/Ast/NodeComments.hs b/src/HIndent/Ast/NodeComments.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module HIndent.Ast.NodeComments
@@ -43,13 +44,15 @@ fromEpAnn' GHC.EpAnn {..} = NodeComments {..}
     isCommentOnSameLine (GHC.L comAnn _) =
       GHC.srcSpanEndLine (GHC.anchor entry)
         == GHC.srcSpanStartLine (GHC.anchor comAnn)
+#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)
 fromEpAnn' GHC.EpAnnNotUsed = NodeComments [] [] []
-
+#endif
 filterOutEofAndPragmasFromAnn :: GHC.EpAnn ann -> GHC.EpAnn ann
 filterOutEofAndPragmasFromAnn GHC.EpAnn {..} =
   GHC.EpAnn {comments = filterOutEofAndPragmasFromComments comments, ..}
+#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)
 filterOutEofAndPragmasFromAnn GHC.EpAnnNotUsed = GHC.EpAnnNotUsed
-
+#endif
 filterOutEofAndPragmasFromComments :: GHC.EpAnnComments -> GHC.EpAnnComments
 filterOutEofAndPragmasFromComments comments =
   GHC.EpaCommentsBalanced
@@ -63,7 +66,9 @@ filterOutEofAndPragmas ::
 filterOutEofAndPragmas = filter isNeitherEofNorPragmaComment
 
 isNeitherEofNorPragmaComment :: GHC.GenLocated l GHC.EpaComment -> Bool
+#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)
 isNeitherEofNorPragmaComment (GHC.L _ (GHC.EpaComment GHC.EpaEofComment _)) =
   False
+#endif
 isNeitherEofNorPragmaComment (GHC.L _ (GHC.EpaComment tok _)) =
   not $ isPragma tok