Don't show lenses for TH generated instances (#3531)

Author: July541

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

@@ -90,7 +90,14 @@ codeLens state plId CodeLensParams{..} = pluginResponse $ do
         getBindSpanWithoutSig ClsInstDecl{..} =
             let bindNames = mapMaybe go (bagToList cid_binds)
                 go (L l bind) = case bind of
-                    FunBind{..} -> Just $ L l fun_id
+                    FunBind{..}
+                        -- `Generated` tagged for Template Haskell,
+                        -- here we filter out nonsence generated bindings
+                        -- that are nonsense for displaying code lenses.
+                        --
+                        -- See https://github.com/haskell/haskell-language-server/issues/3319
+                        | not $ isGenerated (mg_origin fun_matches)
+                                -> Just $ L l fun_id
                     _           -> Nothing
                 -- Existed signatures' name
                 sigNames = concat $ mapMaybe (\(L _ r) -> getSigName r) cid_sigs

plugins/hls-class-plugin/test/Main.hs

@@ -88,6 +88,11 @@ codeLensTests = testGroup
                 [ "(==) :: B -> B -> Bool"
                 , "(==) :: A -> A -> Bool"
                 ]
+    , testCase "No lens for TH" $ do
+        runSessionWithServer classPlugin testDataDir $ do
+            doc <- openDoc "TH.hs" "haskell"
+            lens <- getCodeLenses doc
+            liftIO $ length lens @?= 0
     , goldenCodeLens "Apply code lens" "CodeLensSimple" 1
     , goldenCodeLens "Apply code lens for local class" "LocalClassDefine" 0
     , goldenCodeLens "Apply code lens on the same line" "Inline" 0

plugins/hls-class-plugin/test/testdata/TH.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module TH where
+
+import THDef
+
+gen ''Bool True
+gen ''Char 'a'

plugins/hls-class-plugin/test/testdata/THDef.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module THDef where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+class F a where
+    f :: a
+
+gen :: Lift t => Name -> t -> Q [Dec]
+gen ty v = [d| instance F $(conT ty) where f = v |]

plugins/hls-class-plugin/test/testdata/hie.yaml

@@ -1,3 +1,3 @@
 cradle:
   direct:
-    arguments: [-XHaskell2010, QualifiedA]
+    arguments: [-XHaskell2010, QualifiedA, THDef]