@@ -9,9 +9,11 @@ module Progress (tests) where
9
9
import Control.Exception (throw )
10
10
import Control.Lens hiding ((.=) )
11
11
import Data.Aeson (decode , encode )
12
+ import Data.Functor (void )
12
13
import Data.List (delete )
13
14
import Data.Maybe (fromJust )
14
- import Data.Text (Text )
15
+ import Data.Text (Text , pack )
16
+ import Ide.Types
15
17
import Language.LSP.Protocol.Capabilities
16
18
import qualified Language.LSP.Protocol.Lens as L
17
19
import Test.Hls
@@ -23,7 +25,12 @@ tests :: TestTree
23
25
tests =
24
26
testGroup
25
27
" window/workDoneProgress"
26
- [ requiresEvalPlugin $ testCase " eval plugin sends progress reports" $
28
+ [ testCase " sends indefinite progress notifications" $
29
+ runSession hlsLspCommand progressCaps " test/testdata/diagnostics" $ do
30
+ let path = " Foo.hs"
31
+ _ <- openDoc path " haskell"
32
+ expectProgressMessages [pack (" Setting up diagnostics (for " ++ path ++ " )" ), " Processing" , " Indexing" ] [] []
33
+ , requiresEvalPlugin $ testCase " eval plugin sends progress reports" $
27
34
runSession hlsLspCommand progressCaps " plugins/hls-eval-plugin/test/testdata" $ do
28
35
doc <- openDoc " TIO.hs" " haskell"
29
36
lspId <- sendRequest SMethod_TextDocumentCodeLens (CodeLensParams Nothing Nothing doc)
@@ -48,8 +55,27 @@ tests =
48
55
49
56
expectProgressMessages [" Evaluating" ] createdProgressTokens activeProgressTokens
50
57
_ -> error $ " Unexpected response result: " ++ show response
58
+ , requiresOrmoluPlugin $ testCase " ormolu plugin sends progress notifications" $ do
59
+ runSessionWithConfig (def { ignoreConfigurationRequests = False }) hlsLspCommand progressCaps " test/testdata/format" $ do
60
+ void configurationRequest
61
+ setHlsConfig (formatLspConfig " ormolu" )
62
+ doc <- openDoc " Format.hs" " haskell"
63
+ expectProgressMessages [" Setting up format (for Format.hs)" , " Processing" , " Indexing" ] [] []
64
+ _ <- sendRequest SMethod_TextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing )
65
+ expectProgressMessages [" Formatting Format.hs" ] [] []
66
+ , requiresFourmoluPlugin $ testCase " fourmolu plugin sends progress notifications" $ do
67
+ runSessionWithConfig (def { ignoreConfigurationRequests = False }) hlsLspCommand progressCaps " test/testdata/format" $ do
68
+ void configurationRequest
69
+ setHlsConfig (formatLspConfig " fourmolu" )
70
+ doc <- openDoc " Format.hs" " haskell"
71
+ expectProgressMessages [" Setting up format (for Format.hs)" , " Processing" , " Indexing" ] [] []
72
+ _ <- sendRequest SMethod_TextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing )
73
+ expectProgressMessages [" Formatting Format.hs" ] [] []
51
74
]
52
75
76
+ formatLspConfig :: Text -> Config
77
+ formatLspConfig provider = def { formattingProvider = provider }
78
+
53
79
progressCaps :: ClientCapabilities
54
80
progressCaps = fullCaps{_window = Just (WindowClientCapabilities (Just True ) Nothing Nothing )}
55
81
0 commit comments