Bump class plugin to work with GHC 9.0.1

Author: Ailrun

.github/workflows/test.yml

@@ -179,7 +179,7 @@ jobs:
         name: Test hls-brittany-plugin
         run: cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="$TEST_OPTS"
 
-      - if: matrix.test && matrix.ghc != '9.0.1'
+      - if: matrix.test
         name: Test hls-class-plugin
         run: cabal test hls-class-plugin --test-options="$TEST_OPTS" || cabal test hls-class-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="$TEST_OPTS"
 

cabal-ghc901.project

@@ -41,7 +41,7 @@ index-state: 2021-11-29T08:11:07Z
 
 constraints:
   -- These plugins don't work on GHC9 yet
-  haskell-language-server +ignore-plugins-ghc-bounds -brittany -class -stylishhaskell -tactic,
+  haskell-language-server +ignore-plugins-ghc-bounds -brittany -stylishhaskell -tactic,
   ghc-lib-parser ^>= 9.0
 
 -- although we are not building all plugins cabal solver phase is run for all packages

configuration-ghc-901.nix

@@ -7,7 +7,6 @@ let
     "hls-brittany-plugin"
     "hls-stylish-haskell-plugin"
     "hls-fourmolu-plugin"
-    "hls-class-plugin"
   ];
 
   hpkgsOverride = hself: hsuper:
@@ -27,7 +26,6 @@ let
         hself.callCabal2nixWithOptions "haskell-language-server" ./.
         (pkgs.lib.concatStringsSep " " [
           "-f-brittany"
-          "-f-class"
           "-f-fourmolu"
           "-f-stylishhaskell"
           "-f-tactic"

plugins/hls-class-plugin/src/Ide/Plugin/Class.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP               #-}
 {-# LANGUAGE DeriveAnyClass    #-}
 {-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -32,6 +33,7 @@ import           Ide.Types
 import           Language.Haskell.GHC.ExactPrint
 import           Language.Haskell.GHC.ExactPrint.Parsers (parseDecl)
 import           Language.Haskell.GHC.ExactPrint.Types   hiding (GhcPs, Parens)
+import           Language.Haskell.GHC.ExactPrint.Utils   (rs)
 import           Language.LSP.Server
 import           Language.LSP.Types
 import qualified Language.LSP.Types.Lens                 as J
@@ -85,20 +87,20 @@ addMethodPlaceholders state AddMinimalMethodsParams{..} = do
         Right (ann, d) -> Just (setPrecedingLines d 1 indent ann, d)
         Left _         -> Nothing
 
-    addMethodDecls :: ParsedSource -> [LHsDecl GhcPs] -> Transform (Located (HsModule GhcPs))
+    -- addMethodDecls :: ParsedSource -> [LHsDecl GhcPs] -> Transform (Located (HsModule GhcPs))
     addMethodDecls ps mDecls = do
       d <- findInstDecl ps
       newSpan <- uniqueSrcSpanT
       let
         annKey = mkAnnKey d
-        newAnnKey = AnnKey newSpan (CN "HsValBinds")
+        newAnnKey = AnnKey (rs newSpan) (CN "HsValBinds")
         addWhere mkds@(Map.lookup annKey -> Just ann)
           = Map.insert newAnnKey ann2 mkds2
           where
             ann1 = ann
                    { annsDP = annsDP ann ++ [(G AnnWhere, DP (0, 1))]
                    , annCapturedSpan = Just newAnnKey
-                   , annSortKey = Just (fmap getLoc mDecls)
+                   , annSortKey = Just (fmap (rs . getLoc) mDecls)
                    }
             mkds2 = Map.insert annKey ann1 mkds
             ann2 = annNone
@@ -168,9 +170,15 @@ codeAction state plId (CodeActionParams _ _ docId _ context) = liftIO $ fmap (fr
           pure
             $ head . head
             $ pointCommand hf (fromJust (fromCurrentRange pmap range) ^. J.start & J.character -~ 1)
+#if !MIN_VERSION_ghc(9,0,0)
               ( (Map.keys . Map.filter isClassNodeIdentifier . nodeIdentifiers . nodeInfo)
                 <=< nodeChildren
               )
+#else
+              ( (Map.keys . Map.filter isClassNodeIdentifier . sourcedNodeIdents . sourcedNodeInfo)
+                <=< nodeChildren
+              )
+#endif
 
     findClassFromIdentifier docPath (Right name) = do
       (hscEnv -> hscenv, _) <- MaybeT . runAction "classplugin" state $ useWithStale GhcSessionDeps docPath

stack-9.0.1.yaml

@@ -9,7 +9,7 @@ packages:
   - ./hls-test-utils
   - ./shake-bench
   - ./plugins/hls-call-hierarchy-plugin
-  # - ./plugins/hls-class-plugin
+  - ./plugins/hls-class-plugin
   - ./plugins/hls-haddock-comments-plugin
   - ./plugins/hls-eval-plugin
   - ./plugins/hls-explicit-imports-plugin