diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 447e516771..ea30eb2c53 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -197,7 +197,7 @@ extensiblePlugins recorder xs = mempty { P.pluginHandlers = handlers } case nonEmpty fs of Nothing -> logAndReturnError recorder InvalidRequest (pluginNotEnabled m fs') Just fs -> do - let msg e pid = "Exception in plugin " <> T.pack (show pid) <> "while processing " <> T.pack (show m) <> ": " <> T.pack (show e) + let msg e pid = "Exception in plugin " <> T.pack (show pid) <> " while processing " <> T.pack (show m) <> ": " <> T.pack (show e) handlers = fmap (\(plid,_,handler) -> (plid,handler)) fs es <- runConcurrently msg (show m) handlers ide params let (errs,succs) = partitionEithers $ toList es diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index b194c429c9..209569a2bd 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -235,12 +235,12 @@ allLspCmdIds pid commands = concatMap go commands -- --------------------------------------------------------------------- -getNormalizedFilePath :: Monad m => PluginId -> Uri -> ExceptT String m NormalizedFilePath -getNormalizedFilePath (PluginId plId) uri = handleMaybe errMsg +getNormalizedFilePath :: Monad m => Uri -> ExceptT String m NormalizedFilePath +getNormalizedFilePath uri = handleMaybe errMsg $ uriToNormalizedFilePath $ toNormalizedUri uri where - errMsg = T.unpack $ "Error(" <> plId <> "): converting " <> getUri uri <> " to NormalizedFilePath" + errMsg = T.unpack $ "Failed converting " <> getUri uri <> " to NormalizedFilePath" -- --------------------------------------------------------------------- throwPluginError :: Monad m => String -> ExceptT String m b diff --git a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs index 530ced8f7a..c7ae1bae19 100644 --- a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs +++ b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs @@ -87,8 +87,8 @@ collectLiteralsRule recorder = define (cmapWithPrio LogShake recorder) $ \Collec getExtensions = map GhcExtension . toList . extensionFlags . ms_hspp_opts . pm_mod_summary codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction -codeActionHandler state plId (CodeActionParams _ _ docId currRange _) = pluginResponse $ do - nfp <- getNormalizedFilePath plId (docId ^. L.uri) +codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = pluginResponse $ do + nfp <- getNormalizedFilePath (docId ^. L.uri) CLR{..} <- requestLiterals state nfp pragma <- getFirstPragma state nfp -- remove any invalid literals (see validTarget comment) diff --git a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs index ed6ad5e534..8219862cc7 100644 --- a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs +++ b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs @@ -49,8 +49,8 @@ callHierarchyId = PluginId "callHierarchy" -- | Render prepare call hierarchy request. prepareCallHierarchy :: PluginMethodHandler IdeState TextDocumentPrepareCallHierarchy -prepareCallHierarchy state pluginId param = pluginResponse $ do - nfp <- getNormalizedFilePath pluginId (param ^. L.textDocument ^. L.uri) +prepareCallHierarchy state _ param = pluginResponse $ do + nfp <- getNormalizedFilePath (param ^. L.textDocument ^. L.uri) items <- liftIO (runAction "CallHierarchy.prepareHierarchy" state (prepareCallHierarchyItem nfp (param ^. L.position))) pure (List <$> items) diff --git a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs index 594543dd30..f3a39fd03c 100644 --- a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs +++ b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs @@ -38,8 +38,8 @@ descriptor :: PluginDescriptor IdeState descriptor = (defaultPluginDescriptor changeTypeSignatureId) { pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionHandler } codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction -codeActionHandler ideState plId CodeActionParams {_textDocument = TextDocumentIdentifier uri, _context = CodeActionContext (List diags) _} = pluginResponse $ do - nfp <- getNormalizedFilePath plId uri +codeActionHandler ideState _ CodeActionParams {_textDocument = TextDocumentIdentifier uri, _context = CodeActionContext (List diags) _} = pluginResponse $ do + nfp <- getNormalizedFilePath uri decls <- getDecls ideState nfp let actions = mapMaybe (generateAction uri decls) diags pure $ List actions diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs index 8c0d14f9d0..05c73beda8 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs @@ -37,10 +37,10 @@ import Language.LSP.Types import qualified Language.LSP.Types.Lens as J addMethodPlaceholders :: PluginId -> CommandFunction IdeState AddMinimalMethodsParams -addMethodPlaceholders plId state param@AddMinimalMethodsParams{..} = do +addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do caps <- getClientCapabilities pluginResponse $ do - nfp <- getNormalizedFilePath plId uri + nfp <- getNormalizedFilePath uri pm <- handleMaybeM "Unable to GetParsedModule" $ liftIO $ runAction "classplugin.addMethodPlaceholders.GetParsedModule" state @@ -81,7 +81,7 @@ addMethodPlaceholders plId state param@AddMinimalMethodsParams{..} = do -- sensitive to the format of diagnostic messages from GHC. codeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState TextDocumentCodeAction codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginResponse $ do - nfp <- getNormalizedFilePath plId uri + nfp <- getNormalizedFilePath uri actions <- join <$> mapM (mkActions nfp) methodDiags pure $ List actions where diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs index 042c46c52b..3f7facf668 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs @@ -24,7 +24,7 @@ import qualified Language.LSP.Types.Lens as J codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens codeLens state plId CodeLensParams{..} = pluginResponse $ do - nfp <- getNormalizedFilePath plId uri + nfp <- getNormalizedFilePath uri tmr <- handleMaybeM "Unable to typecheck" $ liftIO $ runAction "classplugin.TypeCheck" state diff --git a/plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs b/plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs index fa0985b17b..1fb1c5aa11 100644 --- a/plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs +++ b/plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs @@ -49,8 +49,8 @@ descriptor recorder = (defaultPluginDescriptor pluginId) } hover :: PluginMethodHandler IdeState TextDocumentHover -hover state plId (HoverParams (TextDocumentIdentifier uri) pos _) = pluginResponse $ do - nfp <- getNormalizedFilePath plId uri +hover state _ (HoverParams (TextDocumentIdentifier uri) pos _) = pluginResponse $ do + nfp <- getNormalizedFilePath uri fixityTrees <- handleMaybeM "ExplicitFixity: Unable to get fixity" $ liftIO $ runAction "ExplicitFixity.GetFixity" state diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs index f1c7d993d9..fe68a74be8 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs @@ -52,8 +52,8 @@ toGADTSyntaxCommandId = "GADT.toGADT" -- | A command replaces H98 data decl with GADT decl in place toGADTCommand :: PluginId -> CommandFunction IdeState ToGADTParams -toGADTCommand plId state ToGADTParams{..} = pluginResponse $ do - nfp <- getNormalizedFilePath plId uri +toGADTCommand _ state ToGADTParams{..} = pluginResponse $ do + nfp <- getNormalizedFilePath uri (decls, exts) <- getInRangeH98DeclsAndExts state range nfp (L ann decl) <- case decls of [d] -> pure d @@ -83,7 +83,7 @@ toGADTCommand plId state ToGADTParams{..} = pluginResponse $ do codeActionHandler :: PluginMethodHandler IdeState TextDocumentCodeAction codeActionHandler state plId (CodeActionParams _ _ doc range _) = pluginResponse $ do - nfp <- getNormalizedFilePath plId (doc ^. L.uri) + nfp <- getNormalizedFilePath (doc ^. L.uri) (inRangeH98Decls, _) <- getInRangeH98DeclsAndExts state range nfp let actions = map (mkAction . printOutputable . tcdLName . unLoc) inRangeH98Decls pure $ List actions