diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 51eee11e27..4f59b85c7a 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -201,7 +201,7 @@ extendImportCommand = PluginCommand (CommandId extendImportCommandId) "additional edits for a completion" extendImportHandler extendImportHandler :: CommandFunction IdeState ExtendImport -extendImportHandler ideState edit@ExtendImport {..} = do +extendImportHandler ideState _ edit@ExtendImport {..} = do res <- liftIO $ runMaybeT $ extendImportHandler' ideState edit whenJust res $ \(nfp, wedit@WorkspaceEdit {_changes}) -> do let (_, List (head -> TextEdit {_range})) = fromJust $ _changes >>= listToMaybe . toList diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 7c8c7cec68..09d7db2ade 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -33,9 +33,9 @@ import Ide.Plugin.Config import Ide.PluginUtils (getClientConfig) import Ide.Types as HLS import qualified Language.LSP.Server as LSP -import Language.LSP.VFS import Language.LSP.Types import qualified Language.LSP.Types as J +import Language.LSP.VFS import Text.Regex.TDFA.Text () import UnliftIO (MonadUnliftIO) import UnliftIO.Async (forConcurrently) @@ -149,7 +149,7 @@ executeCommandHandlers ecs = requestHandler SWorkspaceExecuteCommand execCmd ResponseError InvalidParams ("error while parsing args for " <> com' <> " in plugin " <> p' <> ": " <> T.pack err <> "\narg = " <> T.pack (show arg)) Nothing - J.Success a -> f ide a + J.Success a -> f ide p a -- --------------------------------------------------------------------- diff --git a/ghcide/src/Development/IDE/Plugin/Test.hs b/ghcide/src/Development/IDE/Plugin/Test.hs index 86df7807c2..c2b0e78468 100644 --- a/ghcide/src/Development/IDE/Plugin/Test.hs +++ b/ghcide/src/Development/IDE/Plugin/Test.hs @@ -25,10 +25,10 @@ import Data.Maybe (isJust) import Data.String import Data.Text (Text, pack) import Development.IDE.Core.OfInterest (getFilesOfInterest) +import Development.IDE.Core.Rules import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service import Development.IDE.Core.Shake -import Development.IDE.Core.Rules import Development.IDE.GHC.Compat import Development.IDE.Graph (Action) import qualified Development.IDE.Graph as Graph @@ -170,7 +170,7 @@ blockCommandDescriptor plId = (defaultPluginDescriptor plId) { } blockCommandHandler :: CommandFunction state ExecuteCommandParams -blockCommandHandler _ideState _params = do +blockCommandHandler _ideState _plId _params = do LSP.sendNotification (SCustomMethod "ghcide/blocking/command") Null liftIO $ threadDelay maxBound return (Right Null) diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index ecfdd35449..9baf5ffac1 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -29,9 +29,9 @@ import Development.IDE (GhcSession (..), RuleResult, Rules, define, srcSpanToRange) import Development.IDE.Core.Compile (TcModuleResult (..)) +import Development.IDE.Core.Rules (IdeState, runAction) import Development.IDE.Core.RuleTypes (GetBindings (GetBindings), TypeCheck (TypeCheck)) -import Development.IDE.Core.Rules (IdeState, runAction) import Development.IDE.Core.Service (getDiagnostics) import Development.IDE.Core.Shake (getHiddenDiagnostics, use) import qualified Development.IDE.Core.Shake as Shake @@ -146,7 +146,7 @@ generateLens pId _range title edit = in CodeLens _range (Just cId) Nothing commandHandler :: CommandFunction IdeState WorkspaceEdit -commandHandler _ideState wedit = do +commandHandler _ideState _plId wedit = do _ <- LSP.sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ()) return $ Right Null diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 8dc33fbdbe..345d5e15f9 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -246,13 +246,12 @@ allLspCmdIds pid commands = concatMap go commands -- --------------------------------------------------------------------- -getNormalizedFilePath :: Monad m => PluginId -> TextDocumentIdentifier -> ExceptT String m NormalizedFilePath -getNormalizedFilePath (PluginId plId) docId = handleMaybe errMsg +getNormalizedFilePath :: Monad m => PluginId -> Uri -> ExceptT String m NormalizedFilePath +getNormalizedFilePath (PluginId plId) uri = handleMaybe errMsg $ uriToNormalizedFilePath - $ toNormalizedUri uri' + $ toNormalizedUri uri where - errMsg = T.unpack $ "Error(" <> plId <> "): converting " <> getUri uri' <> " to NormalizedFilePath" - uri' = docId ^. uri + errMsg = T.unpack $ "Error(" <> plId <> "): converting " <> getUri uri <> " to NormalizedFilePath" -- --------------------------------------------------------------------- handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index bdedaf3d55..e35172d265 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -30,10 +30,10 @@ import System.Posix.Signals #endif import Control.Lens ((^.)) import Data.Aeson hiding (defaultOptions) -import qualified Data.DList as DList import qualified Data.Default import Data.Dependent.Map (DMap) import qualified Data.Dependent.Map as DMap +import qualified Data.DList as DList import Data.GADT.Compare import Data.List.NonEmpty (NonEmpty (..), toList) import qualified Data.Map as Map @@ -389,6 +389,7 @@ data PluginCommand ideState = forall a. (FromJSON a) => type CommandFunction ideState a = ideState + -> PluginId -> a -> LspM Config (Either ResponseError Value) diff --git a/plugins/default/src/Ide/Plugin/Example.hs b/plugins/default/src/Ide/Plugin/Example.hs index 0416cbe8d1..45cc6d7e11 100644 --- a/plugins/default/src/Ide/Plugin/Example.hs +++ b/plugins/default/src/Ide/Plugin/Example.hs @@ -22,8 +22,8 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Maybe import Data.Aeson import Data.Functor -import qualified Data.HashMap.Strict as Map import Data.Hashable +import qualified Data.HashMap.Strict as Map import qualified Data.Text as T import Data.Typeable import Development.IDE as D @@ -161,7 +161,7 @@ data AddTodoParams = AddTodoParams deriving (Show, Eq, Generic, ToJSON, FromJSON) addTodoCmd :: CommandFunction IdeState AddTodoParams -addTodoCmd _ide (AddTodoParams uri todoText) = do +addTodoCmd _ide _plId (AddTodoParams uri todoText) = do let pos = Position 3 0 textEdits = List diff --git a/plugins/default/src/Ide/Plugin/Example2.hs b/plugins/default/src/Ide/Plugin/Example2.hs index 6595ce58a6..dc2369157f 100644 --- a/plugins/default/src/Ide/Plugin/Example2.hs +++ b/plugins/default/src/Ide/Plugin/Example2.hs @@ -22,8 +22,8 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Maybe import Data.Aeson import Data.Functor -import qualified Data.HashMap.Strict as Map import Data.Hashable +import qualified Data.HashMap.Strict as Map import qualified Data.Text as T import Data.Typeable import Development.IDE as D @@ -145,7 +145,7 @@ data AddTodoParams = AddTodoParams deriving (Show, Eq, Generic, ToJSON, FromJSON) addTodoCmd :: CommandFunction IdeState AddTodoParams -addTodoCmd _ide (AddTodoParams uri todoText) = do +addTodoCmd _ide _plId (AddTodoParams uri todoText) = do let pos = Position 5 0 textEdits = List diff --git a/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal b/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal index c045e625e4..372fd8c3d2 100644 --- a/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal +++ b/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal @@ -29,7 +29,7 @@ library , ghcide ^>=1.6 || ^>=1.7 , ghc-boot-th , hls-graph - , hls-plugin-api ^>=1.3 || ^>=1.4 + , hls-plugin-api ^>=1.4 , hie-compat , lens , lsp 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 4491f96fb9..dcf8b3dd8a 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 @@ -14,9 +14,8 @@ import Development.IDE (GetParsedModule (GetParsedModu GhcSession (GhcSession), IdeState, RuleResult, Rules, define, getFileContents, - hscEnv, ideLogger, - realSrcSpanToRange, runAction, - use, useWithStale) + hscEnv, realSrcSpanToRange, + runAction, use, useWithStale) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat hiding (getSrcSpan) import Development.IDE.GHC.Compat.Util (toList) @@ -31,8 +30,8 @@ import Ide.Plugin.Conversion (AlternateFormat, ExtensionNeeded (NeedsExtension, NoExtension), alternateFormat) import Ide.Plugin.Literals -import Ide.PluginUtils (handleMaybe, handleMaybeM, - response) +import Ide.PluginUtils (getNormalizedFilePath, + handleMaybeM, response) import Ide.Types import Language.LSP.Types import Language.LSP.Types.Lens (uri) @@ -84,8 +83,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 _ (CodeActionParams _ _ docId currRange _) = response $ do - nfp <- getNormalizedFilePath docId +codeActionHandler state plId (CodeActionParams _ _ docId currRange _) = response $ do + nfp <- getNormalizedFilePath plId (docId ^. uri) CLR{..} <- requestLiterals state nfp pragma <- getFirstPragma state nfp -- remove any invalid literals (see validTarget comment) @@ -151,12 +150,6 @@ getFirstPragma state nfp = handleMaybeM "Error: Could not get NextPragmaInfo" $ Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents Nothing -> pure Nothing - -getNormalizedFilePath :: Monad m => TextDocumentIdentifier -> ExceptT String m NormalizedFilePath -getNormalizedFilePath docId = handleMaybe "Error: converting to NormalizedFilePath" - $ uriToNormalizedFilePath - $ toNormalizedUri (docId ^. uri) - requestLiterals :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m CollectLiteralsResult requestLiterals state = handleMaybeM "Error: Could not Collect Literals" . liftIO diff --git a/plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal b/plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal index ccd8c6238c..5f9812c30e 100644 --- a/plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal +++ b/plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal @@ -24,7 +24,7 @@ library build-depends: , base >=4.12 && < 5 , ghcide ^>=1.7 - , hls-plugin-api ^>=1.3 || ^>=1.4 + , hls-plugin-api ^>=1.4 , lsp-types , regex-tdfa , syb 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 3d833a9cd5..b0163bef59 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 @@ -35,7 +35,7 @@ descriptor plId = (defaultPluginDescriptor plId) { pluginHandlers = mkPluginHand codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction codeActionHandler ideState plId CodeActionParams {_textDocument = TextDocumentIdentifier uri, _context = CodeActionContext (List diags) _} = response $ do - nfp <- getNormalizedFilePath plId (TextDocumentIdentifier uri) + nfp <- getNormalizedFilePath plId 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.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs index bd7a95bbf6..bd4ce1887e 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs @@ -20,8 +20,8 @@ import Data.Char import Data.List import qualified Data.Map.Strict as Map import Data.Maybe -import qualified Data.Text as T import qualified Data.Set as Set +import qualified Data.Text as T import Development.IDE hiding (pluginHandlers) import Development.IDE.Core.PositionMapping (fromCurrentRange, toCurrentRange) @@ -40,7 +40,7 @@ import Language.LSP.Types import qualified Language.LSP.Types.Lens as J #if MIN_VERSION_ghc(9,2,0) -import GHC.Hs (AnnsModule(AnnsModule)) +import GHC.Hs (AnnsModule (AnnsModule)) import GHC.Parser.Annotation #endif @@ -64,7 +64,7 @@ data AddMinimalMethodsParams = AddMinimalMethodsParams deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON) addMethodPlaceholders :: CommandFunction IdeState AddMinimalMethodsParams -addMethodPlaceholders state AddMinimalMethodsParams{..} = do +addMethodPlaceholders state _ AddMinimalMethodsParams{..} = do caps <- getClientCapabilities medit <- liftIO $ runMaybeT $ do docPath <- MaybeT . pure . uriToNormalizedFilePath $ toNormalizedUri uri diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs index c00022fd13..703b50a7ce 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs @@ -36,7 +36,7 @@ descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeSta descriptor recorder plId = (defaultPluginDescriptor plId) { pluginHandlers = mkPluginHandler STextDocumentCodeLens CL.codeLens - , pluginCommands = [CL.evalCommand plId] + , pluginCommands = [CL.evalCommand] , pluginRules = rules (cmapWithPrio LogEvalRules recorder) , pluginConfigDescriptor = defaultConfigDescriptor { configCustomConfig = mkCustomConfig properties diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 70d7c7d130..8906535065 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -48,14 +48,13 @@ import Development.IDE (GetModSummary (..), GhcSessionIO (..), IdeState, ModSummaryResult (..), NeedsCompilation (NeedsCompilation), - evalGhcEnv, + VFSModified (..), evalGhcEnv, hscEnvWithImportPaths, printOutputable, runAction, textToStringBuffer, toNormalizedFilePath', uriToFilePath', useNoFile_, - useWithStale_, use_, - VFSModified(..)) + useWithStale_, use_) import Development.IDE.Core.Rules (GhcSessionDepsConfig (..), ghcSessionDepsDefinition) import Development.IDE.GHC.Compat hiding (typeKind, unitState) @@ -91,7 +90,8 @@ import Ide.Plugin.Eval.Code (Statement, asStatements, evalSetup, myExecStmt, propSetup, resultRange, testCheck, testRanges) -import Ide.Plugin.Eval.Config (getEvalConfig, EvalConfig(..)) +import Ide.Plugin.Eval.Config (EvalConfig (..), + getEvalConfig) import Ide.Plugin.Eval.GHC (addImport, addPackages, hasPackage, showDynFlags) import Ide.Plugin.Eval.Parse.Comments (commentsToSections) @@ -184,13 +184,13 @@ codeLens st plId CodeLensParams{_textDocument} = evalCommandName :: CommandId evalCommandName = "evalCommand" -evalCommand :: PluginId -> PluginCommand IdeState -evalCommand plId = PluginCommand evalCommandName "evaluate" (runEvalCmd plId) +evalCommand :: PluginCommand IdeState +evalCommand = PluginCommand evalCommandName "evaluate" runEvalCmd type EvalId = Int -runEvalCmd :: PluginId -> CommandFunction IdeState EvalParams -runEvalCmd plId st EvalParams{..} = +runEvalCmd :: CommandFunction IdeState EvalParams +runEvalCmd st plId EvalParams{..} = let dbg = logWith st perf = timed dbg cmd :: ExceptT String (LspM Config) WorkspaceEdit diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 09743f7e0c..0606a01a66 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -28,8 +28,8 @@ import Data.IORef (readIORef) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromMaybe, isJust) -import qualified Data.Text as T import Data.String (fromString) +import qualified Data.Text as T import Development.IDE hiding (pluginHandlers, pluginRules) import Development.IDE.Core.PositionMapping @@ -93,7 +93,7 @@ newtype ImportCommandParams = ImportCommandParams WorkspaceEdit -- | The actual command handler runImportCommand :: CommandFunction IdeState ImportCommandParams -runImportCommand _state (ImportCommandParams edit) = do +runImportCommand _state _ (ImportCommandParams edit) = do -- This command simply triggers a workspace edit! _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) return (Right Null) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 0919badef1..ec69a4b310 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -4,19 +4,19 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StrictData #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -44,8 +44,8 @@ import Data.Aeson.Types (FromJSON (. Value (..)) import qualified Data.ByteString as BS import Data.Default -import qualified Data.HashMap.Strict as Map import Data.Hashable +import qualified Data.HashMap.Strict as Map import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as T @@ -89,7 +89,8 @@ import System.IO (IOMode (Wri import System.IO.Temp #else import Development.IDE.GHC.Compat hiding - (setEnv, (<+>)) + (setEnv, + (<+>)) import GHC.Generics (Associativity (LeftAssociative, NotAssociative, RightAssociative)) #if MIN_GHC_API_VERSION(9,2,0) import Language.Haskell.GHC.ExactPrint.ExactPrint (deltaOptions) @@ -119,6 +120,7 @@ import Language.LSP.Types hiding import qualified Language.LSP.Types as LSP import qualified Language.LSP.Types.Lens as LSP +import Control.Monad.Trans.Class (lift) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.Spans.Pragmas (LineSplitTextEdits (LineSplitTextEdits), NextPragmaInfo (NextPragmaInfo), @@ -488,18 +490,16 @@ mkSuppressHintTextEdits dynFlags fileContents hint = -- --------------------------------------------------------------------- applyAllCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState Uri -applyAllCmd recorder ide uri = do - let file = maybe (error $ show uri ++ " is not a file.") - toNormalizedFilePath' - (uriToFilePath' uri) - withIndefiniteProgress "Applying all hints" Cancellable $ do +applyAllCmd recorder ide plId uri = do + withIndefiniteProgress "Applying all hints" Cancellable $ response $ do + file <- getNormalizedFilePath plId uri res <- liftIO $ applyHint recorder ide file Nothing logWith recorder Debug $ LogApplying file res case res of - Left err -> pure $ Left (responseError (T.pack $ "hlint:applyAll: " ++ show err)) + Left err -> throwE $ "hlint:applyAll: " ++ show err Right fs -> do - _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ()) - pure $ Right Null + _ <- lift $ sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ()) + pure Null -- --------------------------------------------------------------------- @@ -518,19 +518,18 @@ data OneHint = OneHint } deriving (Eq, Show) applyOneCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState ApplyOneParams -applyOneCmd recorder ide (AOP uri pos title) = do +applyOneCmd recorder ide plId (AOP uri pos title) = do let oneHint = OneHint pos title - let file = maybe (error $ show uri ++ " is not a file.") toNormalizedFilePath' - (uriToFilePath' uri) let progTitle = "Applying hint: " <> title - withIndefiniteProgress progTitle Cancellable $ do + withIndefiniteProgress progTitle Cancellable $ response $ do + file <- getNormalizedFilePath plId uri res <- liftIO $ applyHint recorder ide file (Just oneHint) logWith recorder Debug $ LogApplying file res case res of - Left err -> pure $ Left (responseError (T.pack $ "hlint:applyOne: " ++ show err)) + Left err -> throwE $ "hlint:applyOne: " ++ show err Right fs -> do - _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ()) - pure $ Right Null + _ <- lift $ sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ()) + pure Null applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> IO (Either String WorkspaceEdit) applyHint recorder ide nfp mhint = diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index 9e91b6348d..191330084b 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -35,8 +35,9 @@ import Development.IDE (GetParsedModule (GetParsedModule), uriToFilePath', use, use_) import Development.IDE.GHC.Compat (GenLocated (L), getSessionDynFlags, hsmodName, importPaths, locA, + moduleNameString, pattern RealSrcSpan, - pm_parsed_source, unLoc, moduleNameString) + pm_parsed_source, unLoc) import Ide.Types import Language.LSP.Server import Language.LSP.Types hiding @@ -71,7 +72,7 @@ codeLens state pluginId CodeLensParams{_textDocument=TextDocumentIdentifier uri} -- | (Quasi) Idempotent command execution: recalculate action to execute on command request command :: CommandFunction IdeState Uri -command state uri = do +command state _ uri = do actMaybe <- action state uri forM_ actMaybe $ \Replace{..} -> let diff --git a/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs b/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs index 582fba0a72..ef757ce582 100644 --- a/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs +++ b/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs @@ -86,7 +86,7 @@ refineImportCommand = -- | The actual command handler runRefineImportCommand :: CommandFunction IdeState RefineImportCommandParams -runRefineImportCommand _state (RefineImportCommandParams edit) = do +runRefineImportCommand _state _ (RefineImportCommandParams edit) = do -- This command simply triggers a workspace edit! _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) return (Right Null) diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index 8075282807..0b9f9cf53f 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -37,9 +37,9 @@ import Data.Bifunctor (Bifunctor (first), import qualified Data.ByteString as BS import Data.Coerce import Data.Either (partitionEithers) +import Data.Hashable (unhashed) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as Set -import Data.Hashable (unhashed) import Data.IORef.Extra (atomicModifyIORef'_, newIORef, readIORef) import Data.List.Extra (find, nubOrdOn) @@ -101,9 +101,9 @@ import qualified Retrie.GHC as GHC import Retrie.Monad (addImports, apply, getGroundTerms, runRetrie) +import qualified Retrie.Options as Retrie import Retrie.Options (defaultOptions, getTargetFiles) -import qualified Retrie.Options as Retrie import Retrie.Replace (Change (..), Replacement (..)) import Retrie.Rewrites @@ -133,11 +133,9 @@ data RunRetrieParams = RunRetrieParams restrictToOriginatingFile :: Bool } deriving (Eq, Show, Generic, FromJSON, ToJSON) -runRetrieCmd :: - IdeState -> - RunRetrieParams -> - LspM c (Either ResponseError Value) -runRetrieCmd state RunRetrieParams{originatingFile = uri, ..} = + +runRetrieCmd :: CommandFunction IdeState RunRetrieParams +runRetrieCmd state _ RunRetrieParams{originatingFile = uri, ..} = withIndefiniteProgress description Cancellable $ do runMaybeT $ do nfp <- MaybeT $ return $ uriToNormalizedFilePath $ toNormalizedUri uri diff --git a/plugins/hls-splice-plugin/hls-splice-plugin.cabal b/plugins/hls-splice-plugin/hls-splice-plugin.cabal index ae13452eaa..bc6fccc3a2 100644 --- a/plugins/hls-splice-plugin/hls-splice-plugin.cabal +++ b/plugins/hls-splice-plugin/hls-splice-plugin.cabal @@ -39,7 +39,7 @@ library , ghc , ghc-exactprint , ghcide ^>=1.6 || ^>=1.7 - , hls-plugin-api ^>=1.3 || ^>=1.4 + , hls-plugin-api ^>=1.4 , lens , lsp , retrie diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 14ce391783..d82dee4fbe 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -84,7 +84,7 @@ expandTHSplice :: -- | Inplace? ExpandStyle -> CommandFunction IdeState ExpandSpliceParams -expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do +expandTHSplice _eStyle ideState _ params@ExpandSpliceParams {..} = do clientCapabilities <- getClientCapabilities rio <- askRunInIO let reportEditor :: ReportEditor diff --git a/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP.hs b/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP.hs index dff5363719..4d8c25bdf3 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP.hs @@ -42,12 +42,10 @@ installInteractions :: [Interaction] -> PluginDescriptor IdeState -> PluginDescriptor IdeState -installInteractions is desc = - let plId = pluginId desc - in desc - { pluginCommands = pluginCommands desc <> fmap (buildCommand plId) is - , pluginHandlers = pluginHandlers desc <> buildHandlers is - } +installInteractions is desc = desc + { pluginCommands = pluginCommands desc <> fmap buildCommand is + , pluginHandlers = pluginHandlers desc <> buildHandlers is + } ------------------------------------------------------------------------------ @@ -67,14 +65,13 @@ buildHandlers cs = ------------------------------------------------------------------------------ -- | Extract a 'PluginCommand' from an 'Interaction'. buildCommand - :: PluginId - -> Interaction + :: Interaction -> PluginCommand IdeState -buildCommand plId (Interaction (c :: Continuation sort target b)) = +buildCommand (Interaction (c :: Continuation sort target b)) = PluginCommand { commandId = toCommandId $ c_sort c , commandDesc = T.pack "" - , commandFunc = runContinuation plId c + , commandFunc = runContinuation c } @@ -83,10 +80,9 @@ buildCommand plId (Interaction (c :: Continuation sort target b)) = runContinuation :: forall sort a b . IsTarget a - => PluginId - -> Continuation sort a b + => Continuation sort a b -> CommandFunction IdeState (FileContext, b) -runContinuation plId cont state (fc, b) = do +runContinuation cont state plId (fc, b) = do fromMaybeT (Left $ ResponseError { _code = InternalError