Skip to content

Commit bae0528

Browse files
pepeiborrapepeiborra
committed
Fix hls-splice tests
1 parent fec7e96 commit bae0528

File tree

3 files changed

+69
-9
lines changed

3 files changed

+69
-9
lines changed

‎hls-test-utils/src/Test/Hls.hs

Lines changed: 63 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,10 @@
1+
{-# LANGUAGE DataKinds #-}
12
{-# LANGUAGE GADTs #-}
23
{-# LANGUAGE LambdaCase #-}
34
{-# LANGUAGE NamedFieldPuns #-}
45
{-# LANGUAGE OverloadedStrings #-}
56
{-# LANGUAGE RecordWildCards #-}
7+
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
68
module Test.Hls
79
( module Test.Tasty.HUnit,
810
module Test.Tasty,
@@ -28,20 +30,24 @@ module Test.Hls
2830
waitForTypecheck,
2931
waitForAction,
3032
sendConfigurationChanged,
31-
getLastBuildKeys)
33+
getLastBuildKeys,
34+
executeCommand'
35+
)
3236
where
3337

3438
import Control.Applicative.Combinators
3539
import Control.Concurrent.Async (async, cancel, wait)
3640
import Control.Concurrent.Extra
3741
import Control.Exception.Base
42+
import Control.Lens ((^.))
3843
import Control.Monad (unless, void)
3944
import Control.Monad.IO.Class
40-
import Data.Aeson (Value (Null), toJSON)
45+
import Data.Aeson (Value (Null), decode, encode,
46+
toJSON)
4147
import qualified Data.Aeson as A
4248
import Data.ByteString.Lazy (ByteString)
4349
import Data.Default (def)
44-
import Data.Maybe (fromMaybe)
50+
import Data.Maybe (fromJust, fromMaybe)
4551
import qualified Data.Text as T
4652
import qualified Data.Text.Lazy as TL
4753
import qualified Data.Text.Lazy.Encoding as TL
@@ -57,12 +63,58 @@ import Ide.Plugin.Config (Config, formattingProvider)
5763
import Ide.PluginUtils (idePluginsToPluginDesc,
5864
pluginDescToIdePlugins)
5965
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)
61112
import Language.LSP.Types hiding
62113
(SemanticTokenAbsolute (length, line),
63114
SemanticTokenRelative (length),
64115
SemanticTokensEdit (_start))
65116
import Language.LSP.Types.Capabilities (ClientCapabilities)
117+
import Language.LSP.Types.Lens (arguments, command)
66118
import System.Directory (getCurrentDirectory,
67119
setCurrentDirectory)
68120
import System.Environment (lookupEnv)
@@ -253,3 +305,10 @@ getLastBuildKeys = callTestPlugin GetLastBuildKeys
253305
sendConfigurationChanged :: Value -> Session ()
254306
sendConfigurationChanged config =
255307
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

‎plugins/hls-splice-plugin/hls-splice-plugin.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -61,6 +61,7 @@ test-suite tests
6161
main-is: Main.hs
6262
ghc-options: -threaded -rtsopts -with-rtsopts=-N
6363
build-depends:
64+
, aeson
6465
, base
6566
, filepath
6667
, hls-splice-plugin

‎plugins/hls-splice-plugin/test/Main.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ module Main
99
) where
1010

1111
import Control.Monad (void)
12+
import Data.Aeson (Value (Null))
1213
import Data.List (find)
1314
import Data.Text (Text)
1415
import qualified Data.Text as T
@@ -64,15 +65,14 @@ tests = testGroup "splice"
6465
goldenTest :: FilePath -> ExpandStyle -> Int -> Int -> TestTree
6566
goldenTest fp tc line col =
6667
goldenWithHaskellDoc splicePlugin (fp <> " (golden)") testDataDir fp "expected" "hs" $ \doc -> do
67-
_ <- waitForDiagnostics
6868
-- wait for the entire build to finish, so that code actions that
6969
-- use stale data will get uptodate stuff
7070
void waitForBuildQueue
7171
actions <- getCodeActions doc $ pointRange line col
7272
case find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions of
7373
Just (InR CodeAction {_command = Just c}) -> do
74-
executeCommand c
75-
void $ skipManyTill anyMessage (message SWorkspaceApplyEdit)
74+
res <- executeCommand' c
75+
liftIO $ _result res @?= Right Null
7676
_ -> liftIO $ assertFailure "No CodeAction detected"
7777

7878
goldenTestWithEdit :: FilePath -> ExpandStyle -> Int -> Int -> TestTree
@@ -97,8 +97,8 @@ goldenTestWithEdit fp tc line col =
9797
actions <- getCodeActions doc $ pointRange line col
9898
case find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions of
9999
Just (InR CodeAction {_command = Just c}) -> do
100-
executeCommand c
101-
void $ skipManyTill anyMessage (message SWorkspaceApplyEdit)
100+
res <- executeCommand' c
101+
liftIO $ _result res @?= Right Null
102102
_ -> liftIO $ assertFailure "No CodeAction detected"
103103

104104
testDataDir :: FilePath

0 commit comments

Comments
 (0)