fix ghc 9 incompatibilities

graph-trace/src/Graph/Trace.hs

@@ -32,14 +32,6 @@ import           Graph.Trace.Internal.Types
 import qualified Graph.Trace.Internal.Types as DT
 import           Graph.Trace.Internal.Trace as Trace
 
--- import qualified Debug.Trace as D
-
--- TODO If more than one application is running at once, will need to use
--- different names for log files. There may be a way to query what the name of
--- the running application is, otherwise it could be a plugin argument. Looks
--- like you can get the package name from the CallStack, so maybe that will
--- work? Probably not since the MVar is defined in the plugin package.
-
 plugin :: Ghc.Plugin
 plugin =
   Ghc.defaultPlugin
@@ -185,8 +177,7 @@ modifyClsInstDecl debugNames nameMap
       = do
   newBinds <- modifyBinds nameMap (entryName debugNames) binds
   pure inst { Ghc.cid_binds = newBinds }
-#if MIN_VERSION_ghc(9,0,0)
-#else
+#if !(MIN_VERSION_ghc(9,0,0))
 modifyClsInstDecl _ _ x = pure x
 #endif
 
@@ -286,7 +277,7 @@ modifyBinding
   -> Ghc.HsBindLR Ghc.GhcRn Ghc.GhcRn
   -> StateT (S.Set Ghc.Name) Ghc.TcM (Ghc.HsBindLR Ghc.GhcRn Ghc.GhcRn)
 modifyBinding nameMap entryName
-  bnd@Ghc.FunBind { Ghc.fun_id = Ghc.L loc name
+  bnd@Ghc.FunBind { Ghc.fun_id = Ghc.L' loc name
                   , Ghc.fun_matches = mg@(Ghc.MG _ alts _) }
     | Just (mUserKey, prop) <- M.lookup name nameMap
     = do
@@ -439,14 +430,11 @@ updateDebugIpInFunBind whereVarName
       = mtch{Ghc.m_grhss =
                g{Ghc.grhssGRHSs = fmap (updateDebugIPInGRHS whereVarName) <$> grhss }
             }
-#if MIN_VERSION_ghc(9,0,0)
-#else
+#if !(MIN_VERSION_ghc(9,0,0))
     updateMatch x = x
 #endif
 updateDebugIpInFunBind _ b = b
 
--- TODO have some warning when optimizations are turned on.
-
 -- | Produce the contents of the where binding that contains the new debug IP
 -- value, generated by creating a new ID and pairing it with the old one.
 -- The ID is randomly generated. Could instead have a global ID sequence but
@@ -459,7 +447,7 @@ mkNewIpExpr
   -> Ghc.TcM (Ghc.LHsExpr Ghc.GhcRn)
 mkNewIpExpr srcSpan newKey newProp = do
   let mDefSite = case Ghc.srcSpanStart srcSpan of
-                   Ghc.RealSrcLoc loc ->
+                   Ghc.RealSrcLoc' loc ->
                      Just SrcCodeLoc
                        { srcModule = Ghc.unpackFS $ Ghc.srcLocFile loc
                        , srcLine = Ghc.srcLocLine loc
@@ -527,8 +515,7 @@ emitEntryEvent emitEntryName (Ghc.GRHS x guards body) =
           (Ghc.noLocA' . Ghc.HsVar Ghc.NoExtField $ Ghc.noLocA' emitEntryName)
       )
       body
-#if MIN_VERSION_ghc(9,0,0)
-#else
+#if !(MIN_VERSION_ghc(9,0,0))
 emitEntryEvent _ x = x
 #endif
 
@@ -554,8 +541,7 @@ updateDebugIPInGRHS whereBindName (Ghc.GRHS x guards body)
                       $ Ghc.noLocA' whereBindName
                     )
                 ]
-#if MIN_VERSION_ghc(9,0,0)
-#else
+#if !(MIN_VERSION_ghc(9,0,0))
 updateDebugIPInGRHS _ x = x
 #endif
 
@@ -582,8 +568,6 @@ isDebuggerIpCt ct@Ghc.CDictCan{}
   = True
 isDebuggerIpCt _ = False
 
--- TODO can the solver be replaced by a global IP instance?
-
 tcPluginSolver :: Ghc.TcPluginSolver
 tcPluginSolver _ [] wanted = do
   case filter isDebuggerIpCt wanted of

graph-trace/src/Graph/Trace/Internal/GhcFacade.hs

@@ -15,6 +15,8 @@ module Graph.Trace.Internal.GhcFacade
   , noLoc'
   , emptyComments'
   , pattern HsQualTy'
+  , pattern RealSrcLoc'
+  , pattern L'
   ) where
 
 #if MIN_VERSION_ghc(9,2,0)
@@ -209,3 +211,19 @@ pattern HsQualTy' x lctx body
       HsQualTy' x Nothing body = HsQualTy x (noLoc []) body
       HsQualTy' x (Just lctx) body = HsQualTy x lctx body
 #endif
+
+pattern RealSrcLoc' :: RealSrcLoc -> SrcLoc
+#if MIN_VERSION_ghc(9,0,0)
+pattern RealSrcLoc' loc = RealSrcLoc loc Nothing
+#else
+pattern RealSrcLoc' loc = RealSrcLoc loc
+#endif
+
+pattern L' :: SrcSpan -> a
+#if MIN_VERSION_ghc(9,2,0)
+           -> GenLocated (SrcSpanAnn' ann) a
+pattern L' ss a <- L (SrcSpanAnn _ ss) a
+#else
+           -> Located a
+pattern L' ss a <- L ss a
+#endif

shell.nix

@@ -4,7 +4,7 @@ with import <nixpkgs> { inherit system; };
 
 mkShell {
   buildInputs = [
-    haskell.compiler.ghc8107
+    haskell.compiler.ghc921
     cabal-install
     graphviz
   ];