fix mkPrintUnqualifiedDefault

Author: pepeiborra

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

@@ -31,6 +31,7 @@ module Development.IDE.GHC.Compat.Outputable (
 
 
 #if MIN_VERSION_ghc(9,2,0)
+import           GHC.Driver.Env
 import           GHC.Driver.Ppr
 import           GHC.Driver.Session
 import           GHC.Parser.Errors
@@ -153,14 +154,14 @@ type PsWarning = ErrMsg
 type PsError = ErrMsg
 #endif
 
-mkPrintUnqualifiedDefault :: GlobalRdrEnv -> PrintUnqualified
-mkPrintUnqualifiedDefault =
+mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified
+mkPrintUnqualifiedDefault env =
 #if MIN_VERSION_ghc(9,2,0)
   -- GHC 9.2.1 version
   -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified
-  mkPrintUnqualified unsafeGlobalDynFlags
+  mkPrintUnqualified (hsc_unit_env env)
 #else
-  HscTypes.mkPrintUnqualified unsafeGlobalDynFlags
+  HscTypes.mkPrintUnqualified (hsc_dflags env)
 #endif
 
 mkWarnMsg :: DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc

ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs

@@ -54,9 +54,10 @@ runGhcideCodeAction :: LSP.MonadLsp Config m => IdeState -> MessageParams TextDo
 runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext {_diagnostics = List diags}) codeAction = do
   let mbFile = toNormalizedFilePath' <$> uriToFilePath uri
       runRule key = runAction ("GhcideCodeActions." <> show key) state $ runMaybeT $ MaybeT (pure mbFile) >>= MaybeT . use key
+  caaGhcSession <- onceIO $ runRule GhcSession
   caaExportsMap <-
     onceIO $
-      runRule GhcSession >>= \case
+      caaGhcSession >>= \case
         Just env -> do
           pkgExports <- envPackageExports env
           localExports <- readTVarIO (exportsMap $ shakeExtras state)
@@ -134,6 +135,7 @@ instance (ToTextEdit a, ToTextEdit b) => ToTextEdit (Either a b) where
 
 data CodeActionArgs = CodeActionArgs
   { caaExportsMap   :: IO ExportsMap,
+    caaGhcSession   :: IO (Maybe HscEnvEq),
     caaIdeOptions   :: IO IdeOptions,
     caaParsedModule :: IO (Maybe ParsedModule),
     caaContents     :: IO (Maybe T.Text),
@@ -267,3 +269,9 @@ instance ToCodeAction r => ToCodeAction (Maybe GlobalBindingTypeSigsResult -> r)
 
 instance ToCodeAction r => ToCodeAction (GlobalBindingTypeSigsResult -> r) where
   toCodeAction = toCodeAction2 caaGblSigs
+
+instance ToCodeAction r => ToCodeAction (Maybe HscEnvEq -> r) where
+  toCodeAction = toCodeAction1 caaGhcSession
+
+instance ToCodeAction r => ToCodeAction (Maybe HscEnv -> r) where
+  toCodeAction = toCodeAction1 ((fmap.fmap.fmap) hscEnv caaGhcSession)

ghcide/src/Development/IDE/Plugin/TypeLenses.hs

@@ -26,7 +26,8 @@ import qualified Data.Text                           as T
 import           Development.IDE                     (GhcSession (..),
                                                       HscEnvEq (hscEnv),
                                                       RuleResult, Rules, define,
-                                                      srcSpanToRange)
+                                                      srcSpanToRange,
+                                                      tmrModSummary)
 import           Development.IDE.Core.Compile        (TcModuleResult (..))
 import           Development.IDE.Core.RuleTypes      (GetBindings (GetBindings),
                                                       TypeCheck (TypeCheck))
@@ -97,6 +98,7 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif
   mode <- usePropertyLsp #mode pId properties
   fmap (Right . List) $ case uriToFilePath' uri of
     Just (toNormalizedFilePath' -> filePath) -> liftIO $ do
+      env <- fmap hscEnv <$> runAction "codeLens.GhcSession" ideState (use GhcSession filePath)
       tmr <- runAction "codeLens.TypeCheck" ideState (use TypeCheck filePath)
       bindings <- runAction "codeLens.GetBindings" ideState (use GetBindings filePath)
       gblSigs <- runAction "codeLens.GetGlobalBindingTypeSigs" ideState (use GetGlobalBindingTypeSigs filePath)
@@ -123,9 +125,9 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif
       case mode of
         Always ->
           pure (catMaybes $ generateLensForGlobal <$> gblSigs')
-            <> generateLensFromDiags (suggestLocalSignature False tmr bindings) -- we still need diagnostics for local bindings
+            <> generateLensFromDiags (suggestLocalSignature False env tmr bindings) -- we still need diagnostics for local bindings
         Exported -> pure $ catMaybes $ generateLensForGlobal <$> filter gbExported gblSigs'
-        Diagnostics -> generateLensFromDiags $ suggestSignature False gblSigs tmr bindings
+        Diagnostics -> generateLensFromDiags $ suggestSignature False env gblSigs tmr bindings
     Nothing -> pure []
 
 generateLens :: PluginId -> Range -> T.Text -> WorkspaceEdit -> CodeLens
@@ -140,9 +142,9 @@ commandHandler _ideState wedit = do
 
 --------------------------------------------------------------------------------
 
-suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Maybe TcModuleResult -> Maybe Bindings -> Diagnostic -> [(T.Text, [TextEdit])]
-suggestSignature isQuickFix mGblSigs mTmr mBindings diag =
-  suggestGlobalSignature isQuickFix mGblSigs diag <> suggestLocalSignature isQuickFix mTmr mBindings diag
+suggestSignature :: Bool -> Maybe HscEnv -> Maybe GlobalBindingTypeSigsResult -> Maybe TcModuleResult -> Maybe Bindings -> Diagnostic -> [(T.Text, [TextEdit])]
+suggestSignature isQuickFix env mGblSigs mTmr mBindings diag =
+  suggestGlobalSignature isQuickFix mGblSigs diag <> suggestLocalSignature isQuickFix env mTmr mBindings diag
 
 suggestGlobalSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> [(T.Text, [TextEdit])]
 suggestGlobalSignature isQuickFix mGblSigs Diagnostic{_message, _range}
@@ -156,19 +158,20 @@ suggestGlobalSignature isQuickFix mGblSigs Diagnostic{_message, _range}
     [(title, [action])]
   | otherwise = []
 
-suggestLocalSignature :: Bool -> Maybe TcModuleResult -> Maybe Bindings -> Diagnostic -> [(T.Text, [TextEdit])]
-suggestLocalSignature isQuickFix mTmr mBindings Diagnostic{_message, _range = _range@Range{..}}
+suggestLocalSignature :: Bool -> Maybe HscEnv -> Maybe TcModuleResult -> Maybe Bindings -> Diagnostic -> [(T.Text, [TextEdit])]
+suggestLocalSignature isQuickFix mEnv mTmr mBindings Diagnostic{_message, _range = _range@Range{..}}
   | Just (_ :: T.Text, _ :: T.Text, _ :: T.Text, [identifier]) <-
       (T.unwords . T.words $ _message)
         =~~ ("Polymorphic local binding with no type signature: (.*) ::" :: T.Text)
     , Just bindings <- mBindings
+    , Just env <- mEnv
     , localScope <- getFuzzyScope bindings _start _end
     , -- we can't use srcspan to lookup scoped bindings, because the error message reported by GHC includes the entire binding, instead of simply the name
       Just (name, ty) <- find (\(x, _) -> printName x == T.unpack identifier) localScope >>= \(name, mTy) -> (name,) <$> mTy
     , Just TcModuleResult{tmrTypechecked = TcGblEnv{tcg_rdr_env, tcg_sigs}} <- mTmr
     , -- not a top-level thing, to avoid duplication
       not $ name `elemNameSet` tcg_sigs
-    , tyMsg <- printSDocQualifiedUnsafe (mkPrintUnqualifiedDefault tcg_rdr_env) $ pprSigmaType ty
+    , tyMsg <- printSDocQualifiedUnsafe (mkPrintUnqualifiedDefault env tcg_rdr_env) $ pprSigmaType ty
     , signature <- T.pack $ printName name <> " :: " <> tyMsg
     , startCharacter <- _character _start
     , startOfLine <- Position (_line _start) startCharacter