Skip to content

Commit

Permalink
Add tests for initialize response (haskell/ghcide#147)
Browse files Browse the repository at this point in the history
These tests document and monitor the evolution of the capabilities
announced by the server in the initialize response.

Currently the server advertises almost no capabilities. Out of 23
top-level categories, the only 3 which are announced are

+ text document sync
+ hover
+ goto definition

At the very least code actions are known to be provided, but are not
announced in the initialize response.
  • Loading branch information
jacg authored and cocreature committed Oct 1, 2019
1 parent f0bf04a commit 4f41452
Showing 1 changed file with 63 additions and 0 deletions.
63 changes: 63 additions & 0 deletions ghcide/test/exe/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -30,11 +30,74 @@ main = defaultMain $ testGroup "HIE"
void (message :: Session ProgressStartNotification)
closeDoc doc
void (message :: Session ProgressDoneNotification)
, initializeResponseTests
, diagnosticTests
, codeActionTests
, findDefinitionTests
]

initializeResponseTests :: TestTree
initializeResponseTests = withResource acquire release tests where

-- these tests document and monitor the evolution of the
-- capabilities announced by the server in the initialize
-- response. Currently the server advertises almost no capabilities
-- at all, in some cases failing to announce capabilities that it
-- actually does provide! Hopefully this will change ...
tests :: IO InitializeResponse -> TestTree
tests getInitializeResponse =
testGroup "initialize response capabilities"
[ chk " text doc sync" _textDocumentSync tds
, chk " hover" _hoverProvider (Just True)
, chk "NO completion" _completionProvider Nothing
, chk "NO signature help" _signatureHelpProvider Nothing
, chk " goto definition" _definitionProvider (Just True)
, chk "NO goto type definition" _typeDefinitionProvider Nothing
, chk "NO goto implementation" _implementationProvider Nothing
, chk "NO find references" _referencesProvider Nothing
, chk "NO doc highlight" _documentHighlightProvider Nothing
, chk "NO doc symbol" _documentSymbolProvider Nothing
, chk "NO workspace symbol" _workspaceSymbolProvider Nothing
, chk "NO code action" _codeActionProvider Nothing -- available but not declared !
, chk "NO code lens" _codeLensProvider Nothing
, chk "NO doc formatting" _documentFormattingProvider Nothing
, chk "NO doc range formatting"
_documentRangeFormattingProvider Nothing
, chk "NO doc formatting on typing"
_documentOnTypeFormattingProvider Nothing
, chk "NO renaming" _renameProvider Nothing
, chk "NO doc link" _documentLinkProvider Nothing
, chk "NO color" _colorProvider Nothing
, chk "NO folding range" _foldingRangeProvider Nothing
, chk "NO execute command" _executeCommandProvider Nothing
, chk "NO workspace" _workspace nothingWorkspace
, chk "NO experimental" _experimental Nothing
] where

tds = Just (TDSOptions (TextDocumentSyncOptions
{ _openClose = Just True
, _change = Just TdSyncIncremental
, _willSave = Nothing
, _willSaveWaitUntil = Nothing
, _save = Just (SaveOptions {_includeText = Nothing})}))

nothingWorkspace = Just (WorkspaceOptions {_workspaceFolders = Nothing})

chk :: (Eq a, Show a) => TestName -> (InitializeResponseCapabilitiesInner -> a) -> a -> TestTree
chk title getActual expected =
testCase title $ getInitializeResponse >>= \ir -> expected @=? (getActual . innerCaps) ir

innerCaps :: InitializeResponse -> InitializeResponseCapabilitiesInner
innerCaps (ResponseMessage _ _ (Just (InitializeResponseCapabilities c)) _) = c
innerCaps _ = error "this test only expects inner capabilities"

acquire :: IO InitializeResponse
acquire = run initializeResponse

release :: InitializeResponse -> IO ()
release = const $ pure ()


diagnosticTests :: TestTree
diagnosticTests = testGroup "diagnostics"
[ testSession "fix syntax error" $ do
Expand Down

0 comments on commit 4f41452

Please sign in to comment.