1
+ {-# LANGUAGE DataKinds #-}
1
2
{-# LANGUAGE GADTs #-}
2
3
{-# LANGUAGE LambdaCase #-}
3
4
{-# LANGUAGE NamedFieldPuns #-}
4
5
{-# LANGUAGE OverloadedStrings #-}
5
6
{-# LANGUAGE RecordWildCards #-}
7
+ {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
6
8
module Test.Hls
7
9
( module Test.Tasty.HUnit ,
8
10
module Test.Tasty ,
@@ -28,20 +30,24 @@ module Test.Hls
28
30
waitForTypecheck ,
29
31
waitForAction ,
30
32
sendConfigurationChanged ,
31
- getLastBuildKeys )
33
+ getLastBuildKeys ,
34
+ executeCommand'
35
+ )
32
36
where
33
37
34
38
import Control.Applicative.Combinators
35
39
import Control.Concurrent.Async (async , cancel , wait )
36
40
import Control.Concurrent.Extra
37
41
import Control.Exception.Base
42
+ import Control.Lens ((^.) )
38
43
import Control.Monad (unless , void )
39
44
import Control.Monad.IO.Class
40
- import Data.Aeson (Value (Null ), toJSON )
45
+ import Data.Aeson (Value (Null ), decode , encode ,
46
+ toJSON )
41
47
import qualified Data.Aeson as A
42
48
import Data.ByteString.Lazy (ByteString )
43
49
import Data.Default (def )
44
- import Data.Maybe (fromMaybe )
50
+ import Data.Maybe (fromJust , fromMaybe )
45
51
import qualified Data.Text as T
46
52
import qualified Data.Text.Lazy as TL
47
53
import qualified Data.Text.Lazy.Encoding as TL
@@ -57,12 +63,58 @@ import Ide.Plugin.Config (Config, formattingProvider)
57
63
import Ide.PluginUtils (idePluginsToPluginDesc ,
58
64
pluginDescToIdePlugins )
59
65
import Ide.Types
60
- import Language.LSP.Test
66
+ import Language.LSP.Test (Session , SessionConfig (.. ),
67
+ SessionException (.. ),
68
+ anyMessage , anyNotification ,
69
+ anyRequest , anyResponse ,
70
+ anySessionException ,
71
+ applyEdit , changeDoc ,
72
+ closeDoc , createDoc ,
73
+ customNotification ,
74
+ customRequest , defaultConfig ,
75
+ documentContents ,
76
+ executeCodeAction , formatDoc ,
77
+ formatRange , fullCaps ,
78
+ getAllCodeActions ,
79
+ getCodeActions , getCodeLenses ,
80
+ getCompletions ,
81
+ getCurrentDiagnostics ,
82
+ getDeclarations ,
83
+ getDefinitions , getDocUri ,
84
+ getDocumentEdit ,
85
+ getDocumentSymbols ,
86
+ getHighlights , getHover ,
87
+ getImplementations ,
88
+ getIncompleteProgressSessions ,
89
+ getReferences ,
90
+ getRegisteredCapabilities ,
91
+ getSemanticTokens ,
92
+ getTypeDefinitions ,
93
+ getVersionedDoc ,
94
+ incomingCalls ,
95
+ initializeResponse ,
96
+ loggingNotification , message ,
97
+ noDiagnostics , openDoc ,
98
+ outgoingCalls ,
99
+ prepareCallHierarchy ,
100
+ publishDiagnosticsNotification ,
101
+ rename , request , request_ ,
102
+ response , responseForId ,
103
+ runSession ,
104
+ runSessionWithConfig ,
105
+ runSessionWithHandles ,
106
+ satisfy , satisfyMaybe ,
107
+ sendNotification , sendRequest ,
108
+ sendResponse ,
109
+ waitForDiagnostics ,
110
+ waitForDiagnosticsSource ,
111
+ withTimeout )
61
112
import Language.LSP.Types hiding
62
113
(SemanticTokenAbsolute (length , line ),
63
114
SemanticTokenRelative (length ),
64
115
SemanticTokensEdit (_start ))
65
116
import Language.LSP.Types.Capabilities (ClientCapabilities )
117
+ import Language.LSP.Types.Lens (arguments , command )
66
118
import System.Directory (getCurrentDirectory ,
67
119
setCurrentDirectory )
68
120
import System.Environment (lookupEnv )
@@ -253,3 +305,10 @@ getLastBuildKeys = callTestPlugin GetLastBuildKeys
253
305
sendConfigurationChanged :: Value -> Session ()
254
306
sendConfigurationChanged config =
255
307
sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams config)
308
+
309
+ -- | Executes a command and waits for the response
310
+ executeCommand' :: Language.LSP.Types. Command -> Session (ResponseMessage WorkspaceExecuteCommand )
311
+ executeCommand' cmd = do
312
+ let args = decode $ encode $ fromJust $ cmd ^. arguments
313
+ execParams = ExecuteCommandParams Nothing (cmd ^. command) args
314
+ request SWorkspaceExecuteCommand execParams
0 commit comments