Support GHC 9.2 (#132)

mpickering · Dec 18, 2022 · 671b029 · 671b029
1 parent e467755
commit 671b029
Show file tree

Hide file tree

Showing 6 changed files with 75 additions and 9 deletions.
diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml
@@ -38,6 +38,11 @@ jobs:
             compilerVersion: 9.4.2
             setup-method: ghcup
             allow-failure: false
+          - compiler: ghc-9.2.5
+            compilerKind: ghc
+            compilerVersion: 9.2.5
+            setup-method: ghcup
+            allow-failure: false
       fail-fast: false
     steps:
       - name: apt

diff --git a/.github/workflows/hlint.yml b/.github/workflows/hlint.yml
@@ -12,10 +12,10 @@ jobs:
     runs-on: ubuntu-latest
     steps:
       - uses: actions/checkout@v2
-      - uses: rwe/actions-hlint-setup@v1
+      - uses: rwe/actions-hlint-setup@v1.0.3
         with:
           version: '3.5'
-      - uses: rwe/actions-hlint-run@v2
+      - uses: rwe/actions-hlint-run@v2.0.1
         with:
           path: '["src/"]'
           fail-on: status
diff --git a/README.md b/README.md
@@ -2,7 +2,7 @@
 [`refact`](https://hackage.haskell.org/package/refact) package. It is currently
 integrated into [HLint](https://github.com/ndmitchell/hlint) to enable the automatic application of suggestions.
 
-apply-refact 0.11.x supports GHC 9.4, and 0.9.x supports GHC 8.6 through 9.0, 0.10.x supports GHC 9.2.
+apply-refact 0.11.x supports GHC 9.4 and 9.2, 0.10.x supports GHC 9.2 and 0.9.x supports GHC 8.6 through 9.0.
 
 # Install
 

diff --git a/apply-refact.cabal b/apply-refact.cabal
@@ -32,11 +32,10 @@ library
                    , Refact.Internal
                    , Refact.Compat
   GHC-Options: -Wall
-  build-depends: base >=4.16 && < 5
+  build-depends: base >=4.15 && < 5
                , refact >= 0.2
-               , ghc-exactprint >= 1.6.0
-               , ghc >= 9.4
                , ghc-boot-th
+               , ghc-exactprint ^>= 1.6.0 || ^>= 1.5.0
                , ghc-paths
                , containers >= 0.6.0.1 && < 0.7
                , extra >= 1.7.3
@@ -47,6 +46,11 @@ library
                , uniplate >= 1.6.13
                , unix-compat >= 0.5.2
                , directory >= 1.3
+  if (impl(ghc >= 9.4) && impl(ghc < 9.5))
+    build-depends: ghc ^>= 9.4
+  if (impl(ghc >= 9.2) && impl(ghc < 9.3))
+    build-depends: ghc ^>= 9.2
+
   default-extensions:  FlexibleContexts
                      , FlexibleInstances
                      , FunctionalDependencies

diff --git a/src/Refact/Compat.hs b/src/Refact/Compat.hs
@@ -94,36 +94,51 @@ module Refact.Compat (
   srcSpanToAnnSpan,
   AnnSpan,
 
+#if MIN_VERSION_ghc(9,4,0)
   -- * GHC 9.4 stuff
   initParserOpts,
+#endif
 ) where
 
 import Control.Monad.Trans.State.Strict (StateT)
 import Data.Data (Data)
 import qualified GHC
 import GHC.Data.Bag (unitBag, bagToList)
 import GHC.Data.FastString (FastString, mkFastString)
+#if MIN_VERSION_ghc(9,4,0)
 import qualified GHC.Data.Strict as Strict
+#endif
 import GHC.Data.StringBuffer (stringToStringBuffer)
+#if MIN_VERSION_ghc(9,4,0)
+import GHC.Driver.Config.Parser
 import GHC.Driver.Errors.Types (ErrorMessages, ghcUnknownMessage)
+#endif
 import GHC.Driver.Session hiding (initDynFlags)
 import GHC.Hs hiding (Pat, Stmt)
 import GHC.Parser.Header (getOptions)
+#if MIN_VERSION_ghc(9,4,0)
 import GHC.Types.Error (getMessages)
+#endif
 import GHC.Types.Fixity  ( Fixity(..) )
 import GHC.Types.Name (nameOccName, occName, occNameString)
 import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc)
 import GHC.Types.SrcLoc hiding (spans)
 import GHC.Types.SourceText
+#if MIN_VERSION_ghc(9,4,0)
 import GHC.Utils.Error
+#else
+import GHC.Utils.Error hiding (mkErr)
+#endif
 import GHC.Utils.Outputable
   ( ppr,
     showSDocUnsafe,
     text,
     vcat,
   )
-import GHC.Utils.Panic (handleGhcException, pprPanic)
-import GHC.Driver.Config.Parser
+import GHC.Utils.Panic
+  ( handleGhcException
+  , pprPanic
+  )
 import Language.Haskell.GHC.ExactPrint.Parsers (Parser)
 import Language.Haskell.GHC.ExactPrint.Utils
 import Refact.Types (Refactoring)
@@ -133,21 +148,35 @@ type MonadFail' = MonadFail
 type Module = Located HsModule
 
 type Errors = ErrorMessages
+
 onError :: String -> Errors -> a
 onError s = pprPanic s . vcat . ppp
+
 ppp :: Errors -> [SDoc]
+#if MIN_VERSION_ghc(9,4,0)
 ppp pst = concatMap unDecorated $ fmap (diagnosticMessage . errMsgDiagnostic) $ bagToList $ getMessages pst
+#else
+ppp pst = concatMap unDecorated (errMsgDiagnostic <$> bagToList pst)
+#endif
 
 type FunBind = HsMatchContext GhcPs
 
 pattern RealSrcLoc' :: RealSrcLoc -> SrcLoc
 pattern RealSrcLoc' r <- RealSrcLoc r _ where
+#if MIN_VERSION_ghc(9,4,0)
   RealSrcLoc' r = RealSrcLoc r Strict.Nothing
+#else
+  RealSrcLoc' r = RealSrcLoc r Nothing
+#endif
 {-# COMPLETE RealSrcLoc', UnhelpfulLoc #-}
 
 pattern RealSrcSpan' :: RealSrcSpan -> SrcSpan
 pattern RealSrcSpan' r <- RealSrcSpan r _ where
+#if MIN_VERSION_ghc(9,4,0)
   RealSrcSpan' r = RealSrcSpan r Strict.Nothing
+#else
+  RealSrcSpan' r = RealSrcSpan r Nothing
+#endif
 {-# COMPLETE RealSrcSpan', UnhelpfulSpan #-}
 
 composeSrcSpan :: a -> a
@@ -169,7 +198,11 @@ srcSpanToAnnSpan =
 
 annSpanToSrcSpan :: AnnSpan -> SrcSpan
 annSpanToSrcSpan =
+#if MIN_VERSION_ghc(9,4,0)
   flip RealSrcSpan Strict.Nothing
+#else
+  flip RealSrcSpan Nothing
+#endif
 
 setSrcSpanFile :: FastString -> SrcSpan -> SrcSpan
 setSrcSpanFile file s
@@ -193,7 +226,13 @@ setAnnSpanFile =
   setRealSrcSpanFile
 
 mkErr :: DynFlags -> SrcSpan -> String -> Errors
-mkErr _df l s = mkMessages $ unitBag (mkPlainErrorMsgEnvelope l (ghcUnknownMessage $ mkDecoratedError [] [text s]))
+#if MIN_VERSION_ghc(9,4,0)
+mkErr _df l s =
+  mkMessages $
+    unitBag (mkPlainErrorMsgEnvelope l (ghcUnknownMessage $ mkDecoratedError [] [text s]))
+#else
+mkErr _df l s = unitBag (mkPlainMsgEnvelope l (text s))
+#endif
 
 parseModuleName :: SrcSpan -> Parser (LocatedA GHC.ModuleName)
 parseModuleName ss _ _ s =

diff --git a/src/Refact/Internal.hs b/src/Refact/Internal.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ExplicitNamespaces #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -88,8 +89,10 @@ import Refact.Compat
     xopt_set,
     xopt_unset,
     pattern RealSrcSpan',
+#if MIN_VERSION_ghc(9,4,0)
     mkGeneratedHsDocString,
     initParserOpts
+#endif
   )
 import Refact.Types hiding (SrcSpan)
 import qualified Refact.Types as R
@@ -331,12 +334,23 @@ runRefactoring m = \case
 modifyComment :: (Data a) => GHC.SrcSpan -> String -> a -> a
 modifyComment pos newComment = transformBi go
   where
+#if MIN_VERSION_ghc(9,4,0)
     newTok :: GHC.EpaCommentTok -> GHC.EpaCommentTok
     newTok (GHC.EpaDocComment _) = GHC.EpaDocComment $ mkGeneratedHsDocString newComment
     newTok (GHC.EpaDocOptions _) = GHC.EpaDocOptions newComment
     newTok (GHC.EpaLineComment _) = GHC.EpaLineComment newComment
     newTok (GHC.EpaBlockComment _) = GHC.EpaBlockComment newComment
     newTok GHC.EpaEofComment = GHC.EpaEofComment
+#else
+    newTok (GHC.EpaDocCommentNext _) = GHC.EpaDocCommentNext newComment
+    newTok (GHC.EpaDocCommentPrev _) = GHC.EpaDocCommentPrev newComment
+    newTok (GHC.EpaDocCommentNamed _) = GHC.EpaDocCommentNamed newComment
+    newTok (GHC.EpaDocSection i _) = GHC.EpaDocSection i newComment
+    newTok (GHC.EpaDocOptions _) = GHC.EpaDocOptions newComment
+    newTok (GHC.EpaLineComment _) = GHC.EpaLineComment newComment
+    newTok (GHC.EpaBlockComment _) = GHC.EpaBlockComment newComment
+    newTok GHC.EpaEofComment = GHC.EpaEofComment
+#endif
 
     go :: GHC.LEpaComment -> GHC.LEpaComment
     go old@(GHC.L (GHC.Anchor l o) (GHC.EpaComment t r)) =
@@ -681,7 +695,11 @@ addExtensionsToFlags ::
   IO (Either String GHC.DynFlags)
 addExtensionsToFlags es ds fp flags = catchErrors $ do
   (stringToStringBuffer -> buf) <- readFileUTF8' fp
+#if MIN_VERSION_ghc(9,4,0)
   let (_, opts) = getOptions (initParserOpts flags) buf fp
+#else
+  let opts = getOptions flags buf fp
+#endif
       withExts =
         flip (foldl' xopt_unset) ds
           . flip (foldl' xopt_set) es