Fix all gadt plugin and most class plugin tests, enable 2 tests for g…

…hc 9.4+
haskell · May 28, 2024 · 7a8b116 · 7a8b116
1 parent ebf876e
commit 7a8b116
Show file tree

Hide file tree

Showing 6 changed files with 47 additions and 42 deletions.
diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
@@ -87,7 +87,6 @@ import           Development.IDE                    (IdeState,
                                                      LoggingColumn (ThreadIdColumn),
                                                      defaultLayoutOptions,
                                                      layoutPretty, renderStrict)
-import qualified Development.IDE.LSP.Notifications  as Notifications
 import           Development.IDE.Main               hiding (Log)
 import qualified Development.IDE.Main               as IDEMain
 import           Development.IDE.Plugin.Test        (TestRequest (GetBuildKeysBuilt, WaitForIdeRule, WaitForShakeQueue),
@@ -105,7 +104,6 @@ import           Ide.Logger                         (Pretty (pretty),
                                                      makeDefaultStderrRecorder,
                                                      (<+>))
 import qualified Ide.Logger                         as Logger
-import           Ide.Plugin.Properties              ((&))
 import           Ide.PluginUtils                    (idePluginsToPluginDesc,
                                                      pluginDescToIdePlugins)
 import           Ide.Types

diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs
@@ -20,7 +20,12 @@ import           Language.LSP.Protocol.Types             (Range)
 makeEditText :: Monad m => ParsedModule -> DynFlags -> AddMinimalMethodsParams -> MaybeT m (T.Text, T.Text)
 makeEditText pm df AddMinimalMethodsParams{..} = do
     mDecls <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup
-    let ps = makeDeltaAst $ pm_parsed_source pm
+    let ps =
+#if !MIN_VERSION_ghc(9,9,0)
+            makeDeltaAst $
+#endif
+                pm_parsed_source pm
+
         old = T.pack $ exactPrint ps
         (ps', _, _) = runTransform (addMethodDecls ps mDecls range withSig)
         new = T.pack $ exactPrint ps'
@@ -44,8 +49,10 @@ addMethodDecls ps mDecls range withSig
     go inserting = do
         allDecls <- hsDecls ps
         case break (inRange range . getLoc) allDecls of
-            (before, L l inst : after) -> replaceDecls ps (before ++ L l (addWhere inst):(map newLine inserting ++ after))
-            (before, []) -> replaceDecls ps before
+            (before, L l inst : after) ->
+                replaceDecls ps (before ++ L l (addWhere inst):(map newLine inserting ++ after))
+            (before, []) ->
+                replaceDecls ps before
 
     -- Add `where` keyword for `instance X where` if `where` is missing.
     --
@@ -57,33 +64,39 @@ addMethodDecls ps mDecls range withSig
     -- See the link for the original definition:
     --   https://hackage.haskell.org/package/ghc-9.2.1/docs/Language-Haskell-Syntax-Extension.html#t:XCClsInstDecl
     addWhere :: HsDecl GhcPs -> HsDecl GhcPs
-    addWhere _instd@(InstD xInstD (ClsInstD ext decl@ClsInstDecl{..})) =
+    addWhere instd@(InstD xInstD (ClsInstD ext decl@ClsInstDecl{..})) =
         case cid_ext of
 #if MIN_VERSION_ghc(9,9,0)
-            (warnings, anns, key) ->
+            (warnings, anns, key)
+                | any (\(AddEpAnn kw _ )-> kw == AnnWhere) anns -> instd
+                | otherwise ->
                     InstD xInstD (ClsInstD ext decl {
                     cid_ext = ( warnings
-                              , AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) : anns
-                              , key)
+                              , AddEpAnn AnnWhere d1 : anns
+                              , key
+                              )
                     })
 #else
             (EpAnn entry anns comments, key) ->
-                    InstD xInstD (ClsInstD ext decl {
-                    cid_ext = (EpAnn
-                                entry
-                                (AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) : anns)
-                                comments
-                                , key)
-                    })
-            _ -> _instd
+                InstD xInstD (ClsInstD ext decl {
+                cid_ext = (EpAnn
+                            entry
+                            (AddEpAnn AnnWhere d1 : anns)
+                            comments
+                          , key
+                          )
+                })
+            _ -> instd
 #endif
     addWhere decl = decl
 
-    newLine (L l e) =
-        let dp = deltaPos 1 defaultIndent
+
 #if MIN_VERSION_ghc(9,9,0)
-        in L (noAnnSrcSpanDP dp <> l) e
+    newLine (L _ e) =
+        let dp = deltaPos 1 (defaultIndent + 1) {- TODO why is this +1 needed? -}
+        in L (noAnnSrcSpanDP dp) e
 #else
+    newLine (L l e) =
+        let dp = deltaPos 1 defaultIndent
         in L (noAnnSrcSpanDP (getLoc l) dp <> l) e
 #endif
-
diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs
@@ -63,9 +63,8 @@ codeActionTests = testGroup
       getActionByTitle "Add placeholders for 'g'"
   , goldenWithClass "Creates a placeholder for other two methods" "T6" "2" $
       getActionByTitle "Add placeholders for 'g','h'"
-  , onlyRunForGhcVersions [GHC92, GHC94] "Only ghc-9.2+ enabled GHC2021 implicitly" $
-      goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $
-        getActionByTitle "Add placeholders for '==' with signature(s)"
+  ,goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $
+      getActionByTitle "Add placeholders for '==' with signature(s)"
   , goldenWithClass "Insert pragma if not exist" "InsertWithoutPragma" "" $
       getActionByTitle "Add placeholders for '==' with signature(s)"
   , goldenWithClass "Don't insert pragma if exist" "InsertWithPragma" "" $
@@ -132,8 +131,7 @@ codeLensTests = testGroup
     , goldenCodeLens "Apply code lens for local class" "LocalClassDefine" 0
     , goldenCodeLens "Apply code lens on the same line" "Inline" 0
     , goldenCodeLens "Don't insert pragma while existing" "CodeLensWithPragma" 0
-    , onlyRunForGhcVersions [GHC92, GHC94] "Only ghc-9.2+ enabled GHC2021 implicitly" $
-        goldenCodeLens "Don't insert pragma while GHC2021 enabled" "CodeLensWithGHC2021" 0
+    , goldenCodeLens "Don't insert pragma while GHC2021 enabled" "CodeLensWithGHC2021" 0
     , goldenCodeLens "Qualified name" "Qualified" 0
     , goldenCodeLens "Type family" "TypeFamily" 0
     , testCase "keep stale lens" $ do

diff --git a/plugins/hls-class-plugin/test/testdata/T5.expected.hs b/plugins/hls-class-plugin/test/testdata/T5.expected.hs
@@ -1,4 +1,4 @@
-module T1 where
+module T5 where
 
 data X = X
 

diff --git a/plugins/hls-class-plugin/test/testdata/T5.hs b/plugins/hls-class-plugin/test/testdata/T5.hs
@@ -1,4 +1,4 @@
-module T1 where
+module T5 where
 
 data X = X
 

diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs
@@ -16,9 +16,9 @@ import           Development.IDE.GHC.Compat.ExactPrint
 import           GHC.Parser.Annotation                   (AddEpAnn (..),
                                                           DeltaPos (..),
                                                           EpAnn (..),
-                                                          EpAnnComments (EpaComments),
-                                                          spanAsAnchor)
+                                                          EpAnnComments (EpaComments))
 import           Ide.PluginUtils                         (subRange)
+import           Language.Haskell.GHC.ExactPrint         (d1)
 import           Language.Haskell.GHC.ExactPrint.Parsers (parseDecl)
 
 -- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
@@ -34,8 +34,8 @@ import           GHC.Parser.Annotation                   (TokenLocation (..))
 #if !MIN_VERSION_ghc(9,9,0)
 import           GHC.Parser.Annotation                   (Anchor (Anchor),
                                                           AnchorOperation (MovedAnchor),
-                                                          EpaLocation (EpaDelta),
-                                                          SrcSpanAnn' (SrcSpanAnn))
+                                                          SrcSpanAnn' (SrcSpanAnn),
+                                                          spanAsAnchor)
 import           Language.Haskell.GHC.ExactPrint         (showAst)
 #endif
 
@@ -227,17 +227,13 @@ prettyGADTDecl df decl =
         -- Make every data constructor start with a new line and 2 spaces
         adjustCon :: LConDecl GP -> LConDecl GP
 #if MIN_VERSION_ghc(9,9,0)
-        adjustCon (L ann r) =
-            L (EpAnn (go (spanAsAnchor (getLoc ann))) (AnnListItem []) (EpaComments [])) r
+        adjustCon (L _ r) =
+            let delta = EpaDelta (DifferentLine 1 3) []
+            in L (EpAnn delta (AnnListItem []) (EpaComments [])) r
 #else
         adjustCon (L (SrcSpanAnn _ loc) r) =
-            L (SrcSpanAnn (EpAnn (go (spanAsAnchor loc)) (AnnListItem []) (EpaComments [])) loc) r
-#endif
-            where
-#if MIN_VERSION_ghc(9,9,0)
-                go _            = EpaDelta (DifferentLine 1 2) []
-#else
-                go (Anchor a _) = Anchor a (MovedAnchor (DifferentLine 1 2))
+            let go (Anchor a _) = Anchor a (MovedAnchor (DifferentLine 1 2))
+            in L (SrcSpanAnn (EpAnn (go (spanAsAnchor loc)) (AnnListItem []) (EpaComments [])) loc) r
 #endif
 
         -- Adjust where annotation to the same line of the type constructor
@@ -247,7 +243,7 @@ prettyGADTDecl df decl =
 #endif
             (\(AddEpAnn ann l) ->
             if ann == AnnWhere
-                then AddEpAnn AnnWhere (EpaDelta (SameLine 1) [])
+                then AddEpAnn AnnWhere d1
                 else AddEpAnn ann l
             )