Skip to content

Commit c8428f9

Browse files
July541July541
committed
Add PluginId to CommandFunction
1 parent b1bf549 commit c8428f9

File tree

22 files changed

+78
-84
lines changed

22 files changed

+78
-84
lines changed

‎ghcide/src/Development/IDE/Plugin/Completions.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -201,7 +201,7 @@ extendImportCommand =
201201
PluginCommand (CommandId extendImportCommandId) "additional edits for a completion" extendImportHandler
202202

203203
extendImportHandler :: CommandFunction IdeState ExtendImport
204-
extendImportHandler ideState edit@ExtendImport {..} = do
204+
extendImportHandler ideState _ edit@ExtendImport {..} = do
205205
res <- liftIO $ runMaybeT $ extendImportHandler' ideState edit
206206
whenJust res $ \(nfp, wedit@WorkspaceEdit {_changes}) -> do
207207
let (_, List (head -> TextEdit {_range})) = fromJust $ _changes >>= listToMaybe . toList

‎ghcide/src/Development/IDE/Plugin/HLS.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -33,9 +33,9 @@ import Ide.Plugin.Config
3333
import Ide.PluginUtils (getClientConfig)
3434
import Ide.Types as HLS
3535
import qualified Language.LSP.Server as LSP
36-
import Language.LSP.VFS
3736
import Language.LSP.Types
3837
import qualified Language.LSP.Types as J
38+
import Language.LSP.VFS
3939
import Text.Regex.TDFA.Text ()
4040
import UnliftIO (MonadUnliftIO)
4141
import UnliftIO.Async (forConcurrently)
@@ -149,7 +149,7 @@ executeCommandHandlers ecs = requestHandler SWorkspaceExecuteCommand execCmd
149149
ResponseError InvalidParams ("error while parsing args for " <> com' <> " in plugin " <> p'
150150
<> ": " <> T.pack err
151151
<> "\narg = " <> T.pack (show arg)) Nothing
152-
J.Success a -> f ide a
152+
J.Success a -> f ide p a
153153

154154
-- ---------------------------------------------------------------------
155155

‎ghcide/src/Development/IDE/Plugin/Test.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -25,10 +25,10 @@ import Data.Maybe (isJust)
2525
import Data.String
2626
import Data.Text (Text, pack)
2727
import Development.IDE.Core.OfInterest (getFilesOfInterest)
28+
import Development.IDE.Core.Rules
2829
import Development.IDE.Core.RuleTypes
2930
import Development.IDE.Core.Service
3031
import Development.IDE.Core.Shake
31-
import Development.IDE.Core.Rules
3232
import Development.IDE.GHC.Compat
3333
import Development.IDE.Graph (Action)
3434
import qualified Development.IDE.Graph as Graph
@@ -170,7 +170,7 @@ blockCommandDescriptor plId = (defaultPluginDescriptor plId) {
170170
}
171171

172172
blockCommandHandler :: CommandFunction state ExecuteCommandParams
173-
blockCommandHandler _ideState _params = do
173+
blockCommandHandler _ideState _plId _params = do
174174
LSP.sendNotification (SCustomMethod "ghcide/blocking/command") Null
175175
liftIO $ threadDelay maxBound
176176
return (Right Null)

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -29,9 +29,9 @@ import Development.IDE (GhcSession (..),
2929
RuleResult, Rules, define,
3030
srcSpanToRange)
3131
import Development.IDE.Core.Compile (TcModuleResult (..))
32+
import Development.IDE.Core.Rules (IdeState, runAction)
3233
import Development.IDE.Core.RuleTypes (GetBindings (GetBindings),
3334
TypeCheck (TypeCheck))
34-
import Development.IDE.Core.Rules (IdeState, runAction)
3535
import Development.IDE.Core.Service (getDiagnostics)
3636
import Development.IDE.Core.Shake (getHiddenDiagnostics, use)
3737
import qualified Development.IDE.Core.Shake as Shake
@@ -146,7 +146,7 @@ generateLens pId _range title edit =
146146
in CodeLens _range (Just cId) Nothing
147147

148148
commandHandler :: CommandFunction IdeState WorkspaceEdit
149-
commandHandler _ideState wedit = do
149+
commandHandler _ideState _plId wedit = do
150150
_ <- LSP.sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ())
151151
return $ Right Null
152152

‎hls-plugin-api/src/Ide/PluginUtils.hs

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -246,13 +246,12 @@ allLspCmdIds pid commands = concatMap go commands
246246

247247
-- ---------------------------------------------------------------------
248248

249-
getNormalizedFilePath :: Monad m => PluginId -> TextDocumentIdentifier -> ExceptT String m NormalizedFilePath
250-
getNormalizedFilePath (PluginId plId) docId = handleMaybe errMsg
249+
getNormalizedFilePath :: Monad m => PluginId -> Uri -> ExceptT String m NormalizedFilePath
250+
getNormalizedFilePath (PluginId plId) uri = handleMaybe errMsg
251251
$ uriToNormalizedFilePath
252-
$ toNormalizedUri uri'
252+
$ toNormalizedUri uri
253253
where
254-
errMsg = T.unpack $ "Error(" <> plId <> "): converting " <> getUri uri' <> " to NormalizedFilePath"
255-
uri' = docId ^. uri
254+
errMsg = T.unpack $ "Error(" <> plId <> "): converting " <> getUri uri <> " to NormalizedFilePath"
256255

257256
-- ---------------------------------------------------------------------
258257
handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b

‎hls-plugin-api/src/Ide/Types.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -30,10 +30,10 @@ import System.Posix.Signals
3030
#endif
3131
import Control.Lens ((^.))
3232
import Data.Aeson hiding (defaultOptions)
33-
import qualified Data.DList as DList
3433
import qualified Data.Default
3534
import Data.Dependent.Map (DMap)
3635
import qualified Data.Dependent.Map as DMap
36+
import qualified Data.DList as DList
3737
import Data.GADT.Compare
3838
import Data.List.NonEmpty (NonEmpty (..), toList)
3939
import qualified Data.Map as Map
@@ -389,6 +389,7 @@ data PluginCommand ideState = forall a. (FromJSON a) =>
389389

390390
type CommandFunction ideState a
391391
= ideState
392+
-> PluginId
392393
-> a
393394
-> LspM Config (Either ResponseError Value)
394395

‎plugins/default/src/Ide/Plugin/Example.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -22,8 +22,8 @@ import Control.Monad.IO.Class
2222
import Control.Monad.Trans.Maybe
2323
import Data.Aeson
2424
import Data.Functor
25-
import qualified Data.HashMap.Strict as Map
2625
import Data.Hashable
26+
import qualified Data.HashMap.Strict as Map
2727
import qualified Data.Text as T
2828
import Data.Typeable
2929
import Development.IDE as D
@@ -161,7 +161,7 @@ data AddTodoParams = AddTodoParams
161161
deriving (Show, Eq, Generic, ToJSON, FromJSON)
162162

163163
addTodoCmd :: CommandFunction IdeState AddTodoParams
164-
addTodoCmd _ide (AddTodoParams uri todoText) = do
164+
addTodoCmd _ide _plId (AddTodoParams uri todoText) = do
165165
let
166166
pos = Position 3 0
167167
textEdits = List

‎plugins/default/src/Ide/Plugin/Example2.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -22,8 +22,8 @@ import Control.Monad.IO.Class
2222
import Control.Monad.Trans.Maybe
2323
import Data.Aeson
2424
import Data.Functor
25-
import qualified Data.HashMap.Strict as Map
2625
import Data.Hashable
26+
import qualified Data.HashMap.Strict as Map
2727
import qualified Data.Text as T
2828
import Data.Typeable
2929
import Development.IDE as D
@@ -145,7 +145,7 @@ data AddTodoParams = AddTodoParams
145145
deriving (Show, Eq, Generic, ToJSON, FromJSON)
146146

147147
addTodoCmd :: CommandFunction IdeState AddTodoParams
148-
addTodoCmd _ide (AddTodoParams uri todoText) = do
148+
addTodoCmd _ide _plId (AddTodoParams uri todoText) = do
149149
let
150150
pos = Position 5 0
151151
textEdits = List

‎plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -14,9 +14,8 @@ import Development.IDE (GetParsedModule (GetParsedModu
1414
GhcSession (GhcSession),
1515
IdeState, RuleResult, Rules,
1616
define, getFileContents,
17-
hscEnv, ideLogger,
18-
realSrcSpanToRange, runAction,
19-
use, useWithStale)
17+
hscEnv, realSrcSpanToRange,
18+
runAction, use, useWithStale)
2019
import qualified Development.IDE.Core.Shake as Shake
2120
import Development.IDE.GHC.Compat hiding (getSrcSpan)
2221
import Development.IDE.GHC.Compat.Util (toList)

‎plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ library
2424
build-depends:
2525
, base >=4.12 && < 5
2626
, ghcide ^>=1.7
27-
, hls-plugin-api ^>=1.3 || ^>=1.4
27+
, hls-plugin-api ^>=1.4
2828
, lsp-types
2929
, regex-tdfa
3030
, syb

‎plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ descriptor plId = (defaultPluginDescriptor plId) { pluginHandlers = mkPluginHand
3535

3636
codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction
3737
codeActionHandler ideState plId CodeActionParams {_textDocument = TextDocumentIdentifier uri, _context = CodeActionContext (List diags) _} = response $ do
38-
nfp <- getNormalizedFilePath plId (TextDocumentIdentifier uri)
38+
nfp <- getNormalizedFilePath plId uri
3939
decls <- getDecls ideState nfp
4040
let actions = mapMaybe (generateAction uri decls) diags
4141
pure $ List actions

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,8 +20,8 @@ import Data.Char
2020
import Data.List
2121
import qualified Data.Map.Strict as Map
2222
import Data.Maybe
23-
import qualified Data.Text as T
2423
import qualified Data.Set as Set
24+
import qualified Data.Text as T
2525
import Development.IDE hiding (pluginHandlers)
2626
import Development.IDE.Core.PositionMapping (fromCurrentRange,
2727
toCurrentRange)
@@ -40,7 +40,7 @@ import Language.LSP.Types
4040
import qualified Language.LSP.Types.Lens as J
4141

4242
#if MIN_VERSION_ghc(9,2,0)
43-
import GHC.Hs (AnnsModule(AnnsModule))
43+
import GHC.Hs (AnnsModule (AnnsModule))
4444
import GHC.Parser.Annotation
4545
#endif
4646

@@ -64,7 +64,7 @@ data AddMinimalMethodsParams = AddMinimalMethodsParams
6464
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
6565

6666
addMethodPlaceholders :: CommandFunction IdeState AddMinimalMethodsParams
67-
addMethodPlaceholders state AddMinimalMethodsParams{..} = do
67+
addMethodPlaceholders state _ AddMinimalMethodsParams{..} = do
6868
caps <- getClientCapabilities
6969
medit <- liftIO $ runMaybeT $ do
7070
docPath <- MaybeT . pure . uriToNormalizedFilePath $ toNormalizedUri uri

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeSta
3636
descriptor recorder plId =
3737
(defaultPluginDescriptor plId)
3838
{ pluginHandlers = mkPluginHandler STextDocumentCodeLens CL.codeLens
39-
, pluginCommands = [CL.evalCommand plId]
39+
, pluginCommands = [CL.evalCommand]
4040
, pluginRules = rules (cmapWithPrio LogEvalRules recorder)
4141
, pluginConfigDescriptor = defaultConfigDescriptor
4242
{ configCustomConfig = mkCustomConfig properties

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -48,14 +48,13 @@ import Development.IDE (GetModSummary (..),
4848
GhcSessionIO (..), IdeState,
4949
ModSummaryResult (..),
5050
NeedsCompilation (NeedsCompilation),
51-
evalGhcEnv,
51+
VFSModified (..), evalGhcEnv,
5252
hscEnvWithImportPaths,
5353
printOutputable, runAction,
5454
textToStringBuffer,
5555
toNormalizedFilePath',
5656
uriToFilePath', useNoFile_,
57-
useWithStale_, use_,
58-
VFSModified(..))
57+
useWithStale_, use_)
5958
import Development.IDE.Core.Rules (GhcSessionDepsConfig (..),
6059
ghcSessionDepsDefinition)
6160
import Development.IDE.GHC.Compat hiding (typeKind, unitState)
@@ -91,7 +90,8 @@ import Ide.Plugin.Eval.Code (Statement, asStatements,
9190
evalSetup, myExecStmt,
9291
propSetup, resultRange,
9392
testCheck, testRanges)
94-
import Ide.Plugin.Eval.Config (getEvalConfig, EvalConfig(..))
93+
import Ide.Plugin.Eval.Config (EvalConfig (..),
94+
getEvalConfig)
9595
import Ide.Plugin.Eval.GHC (addImport, addPackages,
9696
hasPackage, showDynFlags)
9797
import Ide.Plugin.Eval.Parse.Comments (commentsToSections)
@@ -184,13 +184,13 @@ codeLens st plId CodeLensParams{_textDocument} =
184184
evalCommandName :: CommandId
185185
evalCommandName = "evalCommand"
186186

187-
evalCommand :: PluginId -> PluginCommand IdeState
188-
evalCommand plId = PluginCommand evalCommandName "evaluate" (runEvalCmd plId)
187+
evalCommand :: PluginCommand IdeState
188+
evalCommand = PluginCommand evalCommandName "evaluate" runEvalCmd
189189

190190
type EvalId = Int
191191

192-
runEvalCmd :: PluginId -> CommandFunction IdeState EvalParams
193-
runEvalCmd plId st EvalParams{..} =
192+
runEvalCmd :: CommandFunction IdeState EvalParams
193+
runEvalCmd st plId EvalParams{..} =
194194
let dbg = logWith st
195195
perf = timed dbg
196196
cmd :: ExceptT String (LspM Config) WorkspaceEdit

‎plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -28,8 +28,8 @@ import Data.IORef (readIORef)
2828
import qualified Data.Map.Strict as Map
2929
import Data.Maybe (catMaybes, fromMaybe,
3030
isJust)
31-
import qualified Data.Text as T
3231
import Data.String (fromString)
32+
import qualified Data.Text as T
3333
import Development.IDE hiding (pluginHandlers,
3434
pluginRules)
3535
import Development.IDE.Core.PositionMapping
@@ -93,7 +93,7 @@ newtype ImportCommandParams = ImportCommandParams WorkspaceEdit
9393

9494
-- | The actual command handler
9595
runImportCommand :: CommandFunction IdeState ImportCommandParams
96-
runImportCommand _state (ImportCommandParams edit) = do
96+
runImportCommand _state _ (ImportCommandParams edit) = do
9797
-- This command simply triggers a workspace edit!
9898
_ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ())
9999
return (Right Null)

‎plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs

Lines changed: 21 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -4,19 +4,19 @@
44
{-# LANGUAGE DuplicateRecordFields #-}
55
{-# LANGUAGE FlexibleContexts #-}
66
{-# LANGUAGE FlexibleInstances #-}
7+
{-# LANGUAGE LambdaCase #-}
8+
{-# LANGUAGE MultiWayIf #-}
9+
{-# LANGUAGE NamedFieldPuns #-}
710
{-# LANGUAGE OverloadedLabels #-}
811
{-# LANGUAGE OverloadedStrings #-}
912
{-# LANGUAGE PackageImports #-}
1013
{-# LANGUAGE PatternSynonyms #-}
14+
{-# LANGUAGE RecordWildCards #-}
1115
{-# LANGUAGE ScopedTypeVariables #-}
16+
{-# LANGUAGE StrictData #-}
1217
{-# LANGUAGE TupleSections #-}
1318
{-# LANGUAGE TypeFamilies #-}
1419
{-# LANGUAGE ViewPatterns #-}
15-
{-# LANGUAGE LambdaCase #-}
16-
{-# LANGUAGE MultiWayIf #-}
17-
{-# LANGUAGE NamedFieldPuns #-}
18-
{-# LANGUAGE RecordWildCards #-}
19-
{-# LANGUAGE StrictData #-}
2020

2121
{-# OPTIONS_GHC -Wno-orphans #-}
2222

@@ -44,8 +44,8 @@ import Data.Aeson.Types (FromJSON (.
4444
Value (..))
4545
import qualified Data.ByteString as BS
4646
import Data.Default
47-
import qualified Data.HashMap.Strict as Map
4847
import Data.Hashable
48+
import qualified Data.HashMap.Strict as Map
4949
import Data.Maybe
5050
import qualified Data.Text as T
5151
import qualified Data.Text.Encoding as T
@@ -89,7 +89,8 @@ import System.IO (IOMode (Wri
8989
import System.IO.Temp
9090
#else
9191
import Development.IDE.GHC.Compat hiding
92-
(setEnv, (<+>))
92+
(setEnv,
93+
(<+>))
9394
import GHC.Generics (Associativity (LeftAssociative, NotAssociative, RightAssociative))
9495
#if MIN_GHC_API_VERSION(9,2,0)
9596
import Language.Haskell.GHC.ExactPrint.ExactPrint (deltaOptions)
@@ -119,6 +120,7 @@ import Language.LSP.Types hiding
119120
import qualified Language.LSP.Types as LSP
120121
import qualified Language.LSP.Types.Lens as LSP
121122

123+
import Control.Monad.Trans.Class (lift)
122124
import qualified Development.IDE.Core.Shake as Shake
123125
import Development.IDE.Spans.Pragmas (LineSplitTextEdits (LineSplitTextEdits),
124126
NextPragmaInfo (NextPragmaInfo),
@@ -488,18 +490,16 @@ mkSuppressHintTextEdits dynFlags fileContents hint =
488490
-- ---------------------------------------------------------------------
489491

490492
applyAllCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState Uri
491-
applyAllCmd recorder ide uri = do
492-
let file = maybe (error $ show uri ++ " is not a file.")
493-
toNormalizedFilePath'
494-
(uriToFilePath' uri)
495-
withIndefiniteProgress "Applying all hints" Cancellable $ do
493+
applyAllCmd recorder ide plId uri = do
494+
withIndefiniteProgress "Applying all hints" Cancellable $ response $ do
495+
file <- getNormalizedFilePath plId uri
496496
res <- liftIO $ applyHint recorder ide file Nothing
497497
logWith recorder Debug $ LogApplying file res
498498
case res of
499-
Left err -> pure $ Left (responseError (T.pack $ "hlint:applyAll: " ++ show err))
499+
Left err -> throwE $ "hlint:applyAll: " ++ show err
500500
Right fs -> do
501-
_ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ())
502-
pure $ Right Null
501+
_ <- lift $ sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ())
502+
pure Null
503503

504504
-- ---------------------------------------------------------------------
505505

@@ -518,19 +518,18 @@ data OneHint = OneHint
518518
} deriving (Eq, Show)
519519

520520
applyOneCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState ApplyOneParams
521-
applyOneCmd recorder ide (AOP uri pos title) = do
521+
applyOneCmd recorder ide plId (AOP uri pos title) = do
522522
let oneHint = OneHint pos title
523-
let file = maybe (error $ show uri ++ " is not a file.") toNormalizedFilePath'
524-
(uriToFilePath' uri)
525523
let progTitle = "Applying hint: " <> title
526-
withIndefiniteProgress progTitle Cancellable $ do
524+
withIndefiniteProgress progTitle Cancellable $ response $ do
525+
file <- getNormalizedFilePath plId uri
527526
res <- liftIO $ applyHint recorder ide file (Just oneHint)
528527
logWith recorder Debug $ LogApplying file res
529528
case res of
530-
Left err -> pure $ Left (responseError (T.pack $ "hlint:applyOne: " ++ show err))
529+
Left err -> throwE $ "hlint:applyOne: " ++ show err
531530
Right fs -> do
532-
_ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ())
533-
pure $ Right Null
531+
_ <- lift $ sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ())
532+
pure Null
534533

535534
applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> IO (Either String WorkspaceEdit)
536535
applyHint recorder ide nfp mhint =

0 commit comments

Comments
 (0)