9.6 support (#54)

* 9.6 support

* Fixes

* Fixes for 9.4

---------

Co-authored-by: Pepe Iborra <pepeiborra@fb.com>

Retrie/CPP.hs

@@ -325,8 +325,13 @@ isPragma = Text.isPrefixOf "{-#"
 insertImports
   :: Monad m
   => [AnnotatedImports]   -- ^ imports and their annotations
+#if __GLASGOW_HASKELL__ < 906
   -> Located HsModule     -- ^ target module
   -> TransformT m (Located HsModule)
+#else
+  -> Located (HsModule GhcPs)     -- ^ target module
+  -> TransformT m (Located (HsModule GhcPs))
+#endif
 insertImports is (L l m) = do
   imps <- graftA $ filterAndFlatten (unLoc <$> hsmodName m) is
   let
@@ -346,7 +351,11 @@ eqImportDecl x y =
   ((==) `on` unLoc . ideclName) x y
   && ((==) `on` ideclQualified) x y
   && ((==) `on` ideclAs) x y
+#if __GLASGOW_HASKELL__ <= 904
   && ((==) `on` ideclHiding) x y
+#else
+  && ((==) `on` ideclImportList) x y
+#endif
 #if __GLASGOW_HASKELL__ < 904
   && ((==) `on` ideclPkgQual) x y
 #else

Retrie/Elaborate.hs

@@ -103,7 +103,7 @@ allMatches _ [] = return []
 allMatches ctxt matchResults = do
   results <-
     forM matchResults $ \(sub, RewriterResult{..}) -> do
-      result <- lift $ liftIO $ rrTransformer ctxt $ MatchResult sub rrTemplate
+      result <- TransformT $ lift $ liftIO $ rrTransformer ctxt $ MatchResult sub rrTemplate
       return (rrQuantifiers, result)
   return
     [ project <$> result

Retrie/ExactPrint.hs

@@ -49,6 +49,7 @@ module Retrie.ExactPrint
   ) where
 
 import Control.Exception
+import Control.Monad
 import Control.Monad.State.Lazy hiding (fix)
 -- import Data.Function (on)
 import Data.List (transpose)

Retrie/ExactPrint/Annotated.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE CPP #-}
 module Retrie.ExactPrint.Annotated
   ( -- * Annotated
     Annotated
@@ -37,6 +38,7 @@ module Retrie.ExactPrint.Annotated
 
 import Control.Monad.State.Lazy hiding (fix)
 import Data.Default as D
+
 import Data.Functor.Identity
 
 import Language.Haskell.GHC.ExactPrint hiding
@@ -59,7 +61,11 @@ type AnnotatedHsExpr = Annotated (LHsExpr GhcPs)
 type AnnotatedHsType = Annotated (LHsType GhcPs)
 type AnnotatedImport = Annotated (LImportDecl GhcPs)
 type AnnotatedImports = Annotated [LImportDecl GhcPs]
+#if __GLASGOW_HASKELL__ >= 906
+type AnnotatedModule = Annotated (Located (HsModule GhcPs))
+#else
 type AnnotatedModule = Annotated (Located HsModule)
+#endif
 type AnnotatedPat = Annotated (LPat GhcPs)
 type AnnotatedStmt = Annotated (LStmt GhcPs (LHsExpr GhcPs))
 

Retrie/Expr.hs

@@ -35,6 +35,7 @@ module Retrie.Expr
   , wildSupply
   ) where
 
+import Control.Monad
 import Control.Monad.State.Lazy
 import Data.Functor.Identity
 -- import qualified Data.Map as M

Retrie/GHC.hs

@@ -53,7 +53,11 @@ import GHC.Types.SrcLoc
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
+#if __GLASGOW_HASKELL__ >= 906
+import Language.Haskell.Syntax.Basic as GHC.Unit.Module.Name
+#else
 import GHC.Unit.Module.Name
+#endif
 import GHC.Utils.Outputable (Outputable (ppr))
 
 import Data.Bifunctor (second)
@@ -92,15 +96,23 @@ tyvarRdrName (HsTyVar _ _ n) = Just n
 tyvarRdrName _ = Nothing
 
 -- fixityDecls :: HsModule -> [(LIdP p, Fixity)]
+#if __GLASGOW_HASKELL__ >= 906
+fixityDecls :: HsModule GhcPs -> [(LocatedN RdrName, Fixity)]
+#else
 fixityDecls :: HsModule -> [(LocatedN RdrName, Fixity)]
+#endif
 fixityDecls m =
   [ (nm, fixity)
   | L _ (SigD _ (FixSig _ (FixitySig _ nms fixity))) <- hsmodDecls m
   , nm <- nms
   ]
 
 ruleInfo :: RuleDecl GhcPs -> [RuleInfo]
+#if __GLASGOW_HASKELL__ >= 906
+ruleInfo (HsRule _ (L _ riName) _ tyBs valBs riLHS riRHS) =
+#else
 ruleInfo (HsRule _ (L _ (_, riName)) _ tyBs valBs riLHS riRHS) =
+#endif
   let
     riQuantifiers =
       map unLoc (tyBindersToLocatedRdrNames (fromMaybe [] tyBs)) ++

Retrie/Monad.hs

@@ -28,6 +28,7 @@ module Retrie.Monad
   , runRetrie
   ) where
 
+import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.State.Strict
 import Control.Monad.RWS

Retrie/PatternMap/Instances.hs

@@ -422,8 +422,10 @@ instance PatternMap EMap where
 #else
       go HsTypedBracket{} = missingSyntax "HsTypedBracket"
       go HsUntypedBracket{} = missingSyntax "HsUntypedBracket"
+#if __GLASGOW_HASKELL__ < 906
       go HsSpliceE{} = missingSyntax "HsSpliceE"
 #endif
+#endif
 #if __GLASGOW_HASKELL__ < 810
       go HsArrApp{} = missingSyntax "HsArrApp"
       go HsArrForm{} = missingSyntax "HsArrForm"
@@ -676,11 +678,12 @@ emptyCDMapWrapper = CDMap mEmpty mEmpty
 instance PatternMap CDMap where
 #if __GLASGOW_HASKELL__ < 810
   type Key CDMap = HsConDetails (LPat GhcPs) (HsRecFields GhcPs (LPat GhcPs))
-#else
+#elif __GLASGOW_HASKELL__ < 906
   -- We must manually expand 'LPat' to avoid UndecidableInstances in GHC 8.10+
   type Key CDMap = HsConDetails (HsPatSigType GhcPs) (LocatedA (Pat GhcPs)) (HsRecFields GhcPs (LocatedA (Pat GhcPs)))
   -- type HsConPatDetails p = HsConDetails (HsPatSigType (NoGhcTc p)) (LPat p) (HsRecFields p (LPat p))
-
+#else
+  type Key CDMap = HsConDetails (HsConPatTyArg GhcPs) (LocatedA (Pat GhcPs)) (HsRecFields GhcPs (LocatedA (Pat GhcPs)))
 #endif
 
   mEmpty :: CDMap a
@@ -1035,10 +1038,10 @@ instance PatternMap BMap where
       go (FunBind _ _ mg _ _) = m { bmFunBind = mAlter env vs mg f (bmFunBind m) }
       go (VarBind _ _ e _) = m { bmVarBind = mAlter env vs e f (bmVarBind m) }
 #else
-      go (FunBind _ _ mg _) = m { bmFunBind = mAlter env vs mg f (bmFunBind m) }
+      go (FunBind{fun_matches = mg}) = m { bmFunBind = mAlter env vs mg f (bmFunBind m) }
       go (VarBind _ _ e) = m { bmVarBind = mAlter env vs e f (bmVarBind m) }
 #endif
-      go (PatBind _ lhs rhs _) =
+      go (PatBind{pat_lhs=lhs, pat_rhs=rhs}) =
         m { bmPatBind = mAlter env vs lhs
               (toA $ mAlter env vs rhs f) (bmPatBind m) }
 #if __GLASGOW_HASKELL__ < 904
@@ -1054,10 +1057,10 @@ instance PatternMap BMap where
       go (FunBind _ _ mg _ _) = mapFor bmFunBind >=> mMatch env mg
       go (VarBind _ _ e _) = mapFor bmVarBind >=> mMatch env e
 #else
-      go (FunBind _ _ mg _) = mapFor bmFunBind >=> mMatch env mg
+      go (FunBind{fun_matches = mg}) = mapFor bmFunBind >=> mMatch env mg
       go (VarBind _ _ e) = mapFor bmVarBind >=> mMatch env e
 #endif
-      go (PatBind _ lhs rhs _)
+      go (PatBind{pat_lhs=lhs, pat_rhs=rhs})
         = mapFor bmPatBind >=> mMatch env lhs >=> mMatch env rhs
       go _ = const [] -- TODO
 

Retrie/Rewrites/Function.hs

@@ -53,7 +53,7 @@ dfnsToRewrites libdir specs am = fmap astA $ transformA am $ \ (L _ m) -> do
 getImports
   :: LibDir -> Direction -> Maybe (LocatedA ModuleName) -> TransformT IO AnnotatedImports
 getImports libdir RightToLeft (Just (L _ mn)) = -- See Note [fold only]
-  lift $ liftIO $ parseImports libdir ["import " ++ moduleNameString mn]
+  TransformT $ lift $ liftIO $ parseImports libdir ["import " ++ moduleNameString mn]
 getImports _ _ _ = return mempty
 
 matchToRewrites
@@ -81,7 +81,11 @@ irrefutablePat = go . unLoc
     go WildPat{} = True
     go VarPat{} = True
     go (LazyPat _ p) = irrefutablePat p
+#if __GLASGOW_HASKELL__ <= 904
     go (AsPat _ _ p) = irrefutablePat p
+#else
+    go (AsPat _ _ _ p) = irrefutablePat p
+#endif
 #if __GLASGOW_HASKELL__ < 904
     go (ParPat _ p) = irrefutablePat p
 #else

Retrie/Rewrites/Patterns.hs

@@ -86,7 +86,11 @@ asPat patName params = do
   mkConPatIn patName params'
   where
 
+#if __GLASGOW_HASKELL__ <= 904
     convertTyVars :: (Monad m) => [Void] -> TransformT m [HsPatSigType GhcPs]
+#else
+    convertTyVars :: (Monad m) => [Void] -> TransformT m [HsConPatTyArg GhcPs]
+#endif
     convertTyVars _ = return []
 
     convertFields :: (Monad m) => [RecordPatSynField GhcPs]

Retrie/Run.hs

@@ -18,6 +18,7 @@ module Retrie.Run
   , writeExtract
   ) where
 
+import Control.Monad
 import Control.Monad.State.Strict
 import Data.Char
 import Data.List

Retrie/Types.hs

@@ -47,6 +47,7 @@ module Retrie.Types
   , Context(..)
   ) where
 
+import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.State
 import Data.Bifunctor
@@ -328,7 +329,7 @@ firstMatch _ [] = return NoMatch
 firstMatch ctxt ((sub, RewriterResult{..}):matchResults) = do
   -- 'firstMatch' is lazy in 'rrTransformer', only running it enough
   -- times to get the first valid MatchResult.
-  matchResult <- lift $ liftIO $ rrTransformer ctxt (MatchResult sub rrTemplate)
+  matchResult <- TransformT $ lift $ liftIO $ rrTransformer ctxt (MatchResult sub rrTemplate)
   case matchResult of
     MatchResult sub' _
       -- Check that all quantifiers from the original rewrite have mappings

retrie.cabal

@@ -77,14 +77,14 @@ library
   build-depends:
     ansi-terminal >= 0.10.3 && < 0.12,
     async >= 2.2.2 && < 2.3,
-    base >= 4.11 && < 4.18,
+    base >= 4.11 && < 4.19,
     bytestring >= 0.10.8 && < 0.12,
     containers >= 0.5.11 && < 0.7,
     data-default >= 0.7.1 && < 0.8,
     directory >= 1.3.1 && < 1.4,
     filepath >= 1.4.2 && < 1.5,
-    ghc >= 9.2 && < 9.5,
-    ghc-exactprint >= 1.5.0 && < 1.7,
+    ghc >= 9.2 && < 9.7,
+    ghc-exactprint >= 1.5.0 && < 1.8,
     list-t >= 1.0.4 && < 1.1,
     mtl >= 2.2.2 && < 2.3,
     optparse-applicative >= 0.15.1 && < 0.18,