Add support for GHC 9.8.1 (#61)

* Add support for GHC 9.8.1

- Bump major bounds of base, text, bytestring, containers,
  optparse-applicative, filepath, ghc, ghc-exactprint,
  ansi-terminal

* Add CI for ghc 9.8.1 and 9.6.3

* Use cabal: 3.10.2.0 in CI

.github/workflows/test.yml

@@ -9,13 +9,14 @@ jobs:
       fail-fast: false
       matrix:
         os: [ubuntu-latest]
-        ghc: ['9.4.1', '9.2.4']
+        ghc: ['9.8.1', '9.6.3', '9.4.1', '9.2.4']
 
     steps:
     - uses: actions/checkout@v2
     - uses: haskell/actions/[email protected]
       with:
         ghc-version: ${{ matrix.ghc }}
+        cabal-version: "3.10.2.0"
 
     - name: Cache Cabal
       uses: actions/cache@v2

CHANGELOG.md

@@ -1,7 +1,10 @@
+Unreleased
+
+* Support for GHC 9.8.1
 
 1.2.0.0 (December 12, 2021)
 
-* Early support for GHC 9.2.1 (thanks to Alan Zimmerman) 
+* Early support for GHC 9.2.1 (thanks to Alan Zimmerman)
 * Dropped support for GHC <9.2 (might readd it later)
 
 1.1.0.0 (November 13, 2021)

Retrie/Context.hs

@@ -56,7 +56,11 @@ updateContext c i =
 
     updExp :: HsExpr GhcPs -> Context
     updExp HsApp{} =
+#if __GLASGOW_HASKELL__ < 908
       c { ctxtParentPrec = HasPrec $ Fixity (SourceText "HsApp") (10 + i - firstChild) InfixL }
+#else
+      c { ctxtParentPrec = HasPrec $ Fixity (SourceText (fsLit "HsApp")) (10 + i - firstChild) InfixL }
+#endif
     -- Reason for 10 + i: (i is index of child, 0 = left, 1 = right)
     -- In left child, prec is 10, so HsApp child will NOT get paren'd
     -- In right child, prec is 11, so every child gets paren'd (unless atomic)

Retrie/Expr.hs

@@ -134,7 +134,11 @@ mkLams vs e = do
   matches <- mkLocA (SameLine 0) [L l (Match anm ctxt pats (GRHSs cs grhs' binds))]
   let
     mg =
+#if __GLASGOW_HASKELL__ < 908
       mkMatchGroup Generated matches
+#else
+      mkMatchGroup (Generated SkipPmc) matches
+#endif
   mkLocA (SameLine 1) $ HsLam noExtField mg
 
 mkLet :: Monad m => HsLocalBinds GhcPs -> LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
@@ -320,7 +324,11 @@ grhsToExpr _ = error "grhsToExpr"
 -------------------------------------------------------------------------------
 
 precedence :: FixityEnv -> HsExpr GhcPs -> Maybe Fixity
+#if __GLASGOW_HASKELL__ < 908
 precedence _        (HsApp {})       = Just $ Fixity (SourceText "HsApp") 10 InfixL
+#else
+precedence _        (HsApp {})       = Just $ Fixity (SourceText (fsLit "HsApp")) 10 InfixL
+#endif
 precedence fixities (OpApp _ _ op _) = Just $ lookupOp op fixities
 precedence _        _                = Nothing
 

Retrie/PatternMap/Instances.hs

@@ -1331,7 +1331,11 @@ class RecordFieldToRdrName f where
   recordFieldToRdrName :: f -> RdrName
 
 instance RecordFieldToRdrName (AmbiguousFieldOcc GhcPs) where
+#if __GLASGOW_HASKELL__ < 908
   recordFieldToRdrName = rdrNameAmbiguousFieldOcc
+#else
+  recordFieldToRdrName = ambiguousFieldOccRdrName
+#endif
 
 #if __GLASGOW_HASKELL__ < 904
 instance RecordFieldToRdrName (FieldOcc p) where
@@ -1357,7 +1361,7 @@ fieldsToRdrNamesUpd (Right fs) = map go fs
   where
     go (L l (HsRecField a (L l2 f) arg pun)) =
       L l (HsRecField a (L l2 (recordFieldToRdrName f)) arg pun)
-#else
+#elif __GLASGOW_HASKELL__ < 908
 fieldsToRdrNamesUpd :: Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
   -> [LHsRecField GhcPs (LHsExpr GhcPs)]
 fieldsToRdrNamesUpd (Left xs) = map go xs
@@ -1375,6 +1379,24 @@ fieldsToRdrNamesUpd (Right xs) = map go xs
       let lrdrName = error "TBD" -- same as GHC 9.2
           f' = FieldOcc NoExtField lrdrName
        in L l (HsFieldBind a (L l2 f') arg pun)
+#else
+fieldsToRdrNamesUpd :: LHsRecUpdFields GhcPs
+  -> [LHsRecField GhcPs (LHsExpr GhcPs)]
+fieldsToRdrNamesUpd (RegularRecUpdFields _ xs) = map go xs
+  where
+    go (L l (HsFieldBind a (L l2 f) arg pun)) =
+      let lrdrName = case f of
+            Unambiguous _ n -> n
+            Ambiguous _ n -> n
+            XAmbiguousFieldOcc{} -> error "XAmbiguousFieldOcc"
+          f' = FieldOcc NoExtField lrdrName
+       in L l (HsFieldBind a (L l2 f') arg pun)
+fieldsToRdrNamesUpd (OverloadedRecUpdFields _ xs) = map go xs
+  where
+    go (L l (HsFieldBind a (L l2 _f) arg pun)) =
+      let lrdrName = error "TBD" -- same as GHC 9.2
+          f' = FieldOcc NoExtField lrdrName
+       in L l (HsFieldBind a (L l2 f') arg pun)
 #endif
 
 #if __GLASGOW_HASKELL__ < 904

Retrie/Rewrites/Types.hs

@@ -44,7 +44,11 @@ typeSynonymsToRewrites specs am = fmap astA $ transformA am $ \ m -> do
 -- | Compile a list of RULES into a list of rewrites.
 mkTypeRewrite
   :: Direction
+#if __GLASGOW_HASKELL__ < 908
   -> (LocatedN RdrName, [LHsTyVarBndr () GhcPs], LHsType GhcPs)
+#else
+  -> (LocatedN RdrName, [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs], LHsType GhcPs)
+#endif
   -> TransformT IO (Rewrite (LHsType GhcPs))
 mkTypeRewrite d (lhsName, vars, rhs) = do
   let lhsName' = setEntryDP lhsName (SameLine 0)

Retrie/Substitution.hs

@@ -55,4 +55,8 @@ deleteSubst (Substitution m) ks = Substitution (delListFromUFM m ks)
 
 -- | Fold over the substitution.
 foldSubst :: ((FastString, HoleVal) -> a -> a) -> a -> Substitution -> a
+#if __GLASGOW_HASKELL__ < 908
 foldSubst f x (Substitution m) = foldUFM f x m
+#else
+foldSubst f x (Substitution m) = nonDetFoldUFM f x m
+#endif

hse/Fixity.hs

@@ -3,6 +3,7 @@
 -- This source code is licensed under the MIT license found in the
 -- LICENSE file in the root directory of this source tree.
 --
+{-# LANGUAGE CPP #-}
 module Fixity
   ( defaultFixityEnv
   , hseToGHC
@@ -30,7 +31,12 @@ defaultFixityEnv = mkFixityEnv $ map hseToGHC HSE.baseFixities
 
 hseToGHC :: HSE.Fixity -> (FastString, (FastString, Fixity))
 hseToGHC (HSE.Fixity assoc p nm) =
+#if __GLASGOW_HASKELL__ < 908
   (fs, (fs, Fixity (SourceText nm') p (dir assoc)))
+#else
+  (fs, (fs, Fixity (SourceText (fsLit nm')) p (dir assoc)))
+#endif
+
   where
     dir (HSE.AssocNone _)  = InfixN
     dir (HSE.AssocLeft _)  = InfixL

retrie.cabal

@@ -4,7 +4,7 @@
 -- LICENSE file in the root directory of this source tree.
 --
 name: retrie
-version: 1.2.2
+version: 1.2.3
 synopsis: A powerful, easy-to-use codemodding tool for Haskell.
 homepage: https://github.com/facebookincubator/retrie
 bug-reports: https://github.com/facebookincubator/retrie/issues
@@ -23,7 +23,7 @@ extra-source-files:
   README.md
   tests/inputs/*.custom
   tests/inputs/*.test
-tested-with: GHC ==9.2.1, GHC ==9.4.1, GHC ==9.6.1
+tested-with: GHC ==9.2.1, GHC ==9.4.1, GHC ==9.6.1, GHC ==9.8.1
 
 description:
   Retrie is a tool for codemodding Haskell. Key goals include:
@@ -75,23 +75,23 @@ library
     Retrie.Util
   GHC-Options: -Wall
   build-depends:
-    ansi-terminal >= 0.10.3 && < 0.12,
+    ansi-terminal >= 0.10.3 && < 1.1,
     async >= 2.2.2 && < 2.3,
-    base >= 4.11 && < 4.19,
-    bytestring >= 0.10.8 && < 0.12,
-    containers >= 0.5.11 && < 0.7,
+    base >= 4.11 && < 4.20,
+    bytestring >= 0.10.8 && < 0.13,
+    containers >= 0.5.11 && < 0.8,
     data-default >= 0.7.1 && < 0.8,
     directory >= 1.3.1 && < 1.4,
-    filepath >= 1.4.2 && < 1.5,
-    ghc >= 9.2 && < 9.7,
-    ghc-exactprint >= 1.5.0 && < 1.8,
+    filepath >= 1.4.2 && < 1.6,
+    ghc >= 9.2 && < 9.9,
+    ghc-exactprint >= 1.5.0 && < 1.9,
     list-t >= 1.0.4 && < 1.1,
     mtl >= 2.2.2 && < 2.4,
-    optparse-applicative >= 0.15.1 && < 0.18,
+    optparse-applicative >= 0.15.1 && < 0.19,
     process >= 1.6.3 && < 1.7,
     random-shuffle >= 0.0.4 && < 0.1,
     syb >= 0.7.1 && < 0.8,
-    text >= 1.2.3 && < 2.1,
+    text >= 1.2.3 && < 2.2,
     transformers >= 0.5.5 && < 0.7,
     unordered-containers >= 0.2.10 && < 0.3
   default-language: Haskell2010
@@ -112,7 +112,7 @@ executable retrie
   GHC-Options: -Wall
   build-depends:
     retrie,
-    base >= 4.11 && < 4.18,
+    base >= 4.11 && < 4.20,
     haskell-src-exts >= 1.23.0 && < 1.24,
     ghc-paths
   default-language: Haskell2010
@@ -129,7 +129,7 @@ executable demo-retrie
   GHC-Options: -Wall
   build-depends:
     retrie,
-    base >= 4.11 && < 4.18,
+    base >= 4.11 && < 4.20,
     haskell-src-exts >= 1.23.0 && < 1.24,
     ghc-paths
   default-language: Haskell2010

tests/Annotated.hs

@@ -16,6 +16,9 @@ import Data.Generics
 -- import Data.Maybe
 import qualified GHC.Paths as GHC.Paths
 import Test.HUnit
+#if MIN_VERSION_mtl(2, 3, 0)
+import Control.Monad ((>=>))
+#endif
 
 import Retrie.ExactPrint
 import Retrie.GHC