Merge branch 'master' into 4049-optimization-to-semantic-tokens-extracting-logic

Author: soulomoon

ghcide/ghcide.cabal

@@ -42,7 +42,10 @@ flag pedantic
 
 common warnings
   ghc-options:
-    -Wall -Wincomplete-uni-patterns -Wunused-packages
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wunused-packages
+    -Wno-name-shadowing
     -Wno-unticked-promoted-constructors
     -fno-ignore-asserts
 
@@ -216,12 +219,7 @@ library
     -- finished purging the warnings, so some are set to not be errors
     -- for now
     ghc-options:
-      -Werror -Wwarn=unused-packages -Wwarn=unrecognised-pragmas
-      -Wwarn=dodgy-imports -Wwarn=missing-signatures
-      -Wwarn=duplicate-exports -Wwarn=dodgy-exports
-      -Wwarn=incomplete-patterns -Wwarn=overlapping-patterns
-      -Wwarn=incomplete-record-updates
-      -Wwarn=ambiguous-fields
+      -Werror -Wwarn=unused-packages
 
   if flag(ekg)
     build-depends:
@@ -238,7 +236,6 @@ executable ghcide-test-preprocessor
   import: warnings
   default-language:   GHC2021
   hs-source-dirs:   test/preprocessor
-  ghc-options:      -Wno-name-shadowing
   main-is:          Main.hs
   build-depends:    base >=4 && <5
 
@@ -253,7 +250,7 @@ executable ghcide
   import: warnings
   default-language:   GHC2021
   hs-source-dirs:     exe
-  ghc-options:        -threaded -rtsopts "-with-rtsopts=-I0 -A128M -T" -Wno-name-shadowing
+  ghc-options:        -threaded -rtsopts "-with-rtsopts=-I0 -A128M -T"
 
 
   -- allow user RTS overrides
@@ -352,7 +349,7 @@ test-suite ghcide-tests
     build-depends: ghc-typelits-knownnat
 
   hs-source-dirs:     test/cabal test/exe test/src
-  ghc-options:        -threaded -O0 -Wno-name-shadowing
+  ghc-options:        -threaded -O0
 
   main-is:            Main.hs
   other-modules:

ghcide/src/Development/IDE/Core/Rules.hs

@@ -1270,7 +1270,7 @@ mainRule recorder RulesConfig{..} = do
     reportImportCyclesRule recorder
     typeCheckRule recorder
     getDocMapRule recorder
-    loadGhcSession recorder def{fullModuleGraph}
+    loadGhcSession recorder GhcSessionDepsConfig{fullModuleGraph}
     getModIfaceFromDiskRule recorder
     getModIfaceFromDiskAndIndexRule recorder
     getModIfaceRule recorder

ghcide/src/Development/IDE/GHC/Compat/Parser.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE CPP             #-}
 {-# LANGUAGE PatternSynonyms #-}
-{-# HLINT ignore "Unused LANGUAGE pragma" #-}
 
 -- | Parser compatibility module.
 module Development.IDE.GHC.Compat.Parser (

ghcide/src/Development/IDE/LSP/Outline.hs

@@ -190,12 +190,10 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (ForD _ x)) = Just
     { _name   = case x of
                   ForeignImport{} -> name
                   ForeignExport{} -> name
-                  XForeignDecl{}  -> "?"
     , _kind   = SymbolKind_Object
     , _detail = case x of
                   ForeignImport{} -> Just "import"
                   ForeignExport{} -> Just "export"
-                  XForeignDecl{}  -> Nothing
     }
   where name = printOutputable $ unLoc $ fd_name x
 

ghcide/src/Development/IDE/Spans/AtPoint.hs

@@ -439,10 +439,10 @@ defRowToSymbolInfo _ = Nothing
 
 pointCommand :: HieASTs t -> Position -> (HieAST t -> a) -> [a]
 pointCommand hf pos k =
-    catMaybes $ M.elems $ flip M.mapWithKey (getAsts hf) $ \fs ast ->
+    M.elems $ flip M.mapMaybeWithKey (getAsts hf) $ \fs ast ->
       -- Since GHC 9.2:
       -- getAsts :: Map HiePath (HieAst a)
-      -- type HiePath = LexialFastString
+      -- type HiePath = LexicalFastString
       --
       -- but before:
       -- getAsts :: Map HiePath (HieAst a)

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

@@ -159,7 +159,7 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = do
                 $ listToMaybe
                 $ mapMaybe listToMaybe
                 $ pointCommand hf instancePosition
-                    ( (Map.keys . Map.filter isClassNodeIdentifier . getNodeIds)
+                    ( (Map.keys . Map.filterWithKey isClassNodeIdentifier . getNodeIds)
                         <=< nodeChildren
                     )
 
@@ -198,8 +198,10 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = do
                         _ -> fail "Ide.Plugin.Class.findClassFromIdentifier"
         findClassFromIdentifier _ (Left _) = throwError (PluginInternalError "Ide.Plugin.Class.findClassIdentifier")
 
-isClassNodeIdentifier :: IdentifierDetails a -> Bool
-isClassNodeIdentifier ident = (isNothing . identType) ident && Use `Set.member` identInfo ident
+-- see https://hackage.haskell.org/package/ghc-9.8.1/docs/src/GHC.Types.Name.Occurrence.html#mkClassDataConOcc
+isClassNodeIdentifier :: Identifier -> IdentifierDetails a -> Bool
+isClassNodeIdentifier (Right i) ident  | 'C':':':_ <- unpackFS $ occNameFS $ occName i = (isNothing . identType) ident && Use `Set.member` identInfo ident
+isClassNodeIdentifier _ _ = False
 
 isClassMethodWarning :: T.Text -> Bool
 isClassMethodWarning = T.isPrefixOf "• No explicit implementation for"

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

@@ -9,6 +9,7 @@ module Main
   ( main
   ) where
 
+import           Control.Exception             (catch)
 import           Control.Lens                  (Prism', prism', view, (^.),
                                                 (^..), (^?))
 import           Control.Monad                 (void)
@@ -120,6 +121,17 @@ codeLensTests = testGroup
             doc <- openDoc "TH.hs" "haskell"
             lens <- getAndResolveCodeLenses doc
             liftIO $ length lens @?= 0
+    , testCase "Do not construct error action!, Ticket3942one" $ do
+        runSessionWithServer def classPlugin testDataDir $ do
+            doc <- openDoc "Ticket3942one.hs" "haskell"
+            _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck)
+            lens <- getAllCodeActions doc
+            -- should switch to `liftIO $ length lens @?= 2, when Ticket3942 is entirely fixed`
+            -- current fix is just to make sure the code does not throw an exception that would mess up
+            -- the client UI.
+            liftIO $ length lens > 0 @?= True
+        `catch` \(e :: SessionException) -> do
+          liftIO $ assertFailure $ "classPluginTestError: "++ show e
     , 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/Ticket3942one.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+module Ticket3942one where
+
+class C a where
+  foo :: a -> Int
+
+newtype Foo = MkFoo Int deriving (C)
+instance Show Foo where
+
+
+main :: IO ()
+main = return ()