Skip to content

Commit 5a755ec

Browse files
BinderDavidBinderDavid
authored
Update dependency on lsp-types and lsp packages (#261)
Newer versions of the lsp packages are generated automatically from the LSP metamodel. As a consequence the API of the lsp library changed considerably with version 2.x.
1 parent 602cc2f commit 5a755ec

File tree

2 files changed

+48
-34
lines changed

2 files changed

+48
-34
lines changed

‎server/app/Language/Granule/Server.hs‎

Lines changed: 44 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
{-# LANGUAGE OverloadedStrings #-}
55
{-# LANGUAGE ScopedTypeVariables #-}
66
{-# LANGUAGE TypeSynonymInstances #-}
7+
{-# LANGUAGE TypeOperators #-}
78

89
module Language.Granule.Server where
910

@@ -29,9 +30,10 @@ import qualified Data.Text.IO as T
2930

3031
import Language.LSP.Diagnostics
3132
import Language.LSP.Server
32-
import Language.LSP.Types
33+
import Language.LSP.Protocol.Types
34+
import Language.LSP.Protocol.Message
3335
import Language.LSP.VFS
34-
import qualified Language.LSP.Types.Lens as L
36+
import qualified Language.LSP.Protocol.Lens as L
3537

3638
import Language.Granule.Checker.Monad
3739
import Language.Granule.Syntax.Def
@@ -43,6 +45,8 @@ import qualified Language.Granule.Checker.Checker as Checker
4345
import qualified Language.Granule.Interpreter as Interpreter
4446
import qualified Language.Granule.Syntax.Parser as Parser
4547

48+
type TextDocumentVersion = Int32 |? Null
49+
4650
data LsState = LsState { currentDefns :: M.Map String (Def () ()),
4751
currentADTs :: M.Map String DataDecl }
4852

@@ -171,19 +175,21 @@ parserDiagnostic doc version message = do
171175
let diags =
172176
[ Diagnostic
173177
(getParseErrorRange message)
174-
(Just DsError)
178+
(Just DiagnosticSeverity_Error)
179+
Nothing
175180
Nothing
176181
(Just "grls")
177182
(T.pack $ message ++ "\n")
178183
Nothing
179-
(Just (List []))
184+
Nothing
185+
Nothing
180186
]
181-
publishDiagnostics 1 doc version (partitionBySource diags)
187+
publishDiagnostics 1 doc (nullToMaybe version) (partitionBySource diags)
182188

183189
checkerDiagnostics :: (?globals :: Globals) => NormalizedUri -> TextDocumentVersion -> NonEmpty CheckerError -> LspS ()
184190
checkerDiagnostics doc version l = do
185191
let diags = toList $ checkerErrorToDiagnostic doc version <$> l
186-
publishDiagnostics (Prelude.length diags) doc version (partitionBySource diags)
192+
publishDiagnostics (Prelude.length diags) doc (nullToMaybe version) (partitionBySource diags)
187193

188194
checkerErrorToDiagnostic :: (?globals :: Globals) => NormalizedUri -> TextDocumentVersion -> CheckerError -> Diagnostic
189195
checkerErrorToDiagnostic doc version e =
@@ -193,25 +199,27 @@ checkerErrorToDiagnostic doc version e =
193199
message = title e ++ ":\n" ++ msg e
194200
in Diagnostic
195201
(Range (Position (startLine-1) (startCol-1)) (Position (endLine-1) endCol))
196-
(Just DsError)
202+
(Just DiagnosticSeverity_Error)
203+
Nothing
197204
Nothing
198205
(Just "grls")
199206
(T.pack $ message ++ "\n")
200207
Nothing
201-
(Just (List []))
208+
Nothing
209+
Nothing
202210

203211
objectToSymbol :: (?globals :: Globals) => (a -> Span) -> (a -> Id) -> a -> SymbolInformation
204212
objectToSymbol objSpan objId obj = let loc = objSpan obj in SymbolInformation
205213
(T.pack $ pretty $ objId obj)
206-
(SkUnknown 0)
214+
SymbolKind_Variable
215+
(Nothing)
207216
(Nothing)
208217
(Nothing)
209218
(Location
210219
(filePathToUri $ filename loc)
211220
(Range
212221
(let (x, y) = startPos loc in Position (fromIntegral x-1) (fromIntegral y-1))
213222
(let (x, y) = endPos loc in Position (fromIntegral x-1) (fromIntegral y-1))))
214-
(Nothing)
215223

216224
posInSpan :: Position -> Span -> Bool
217225
posInSpan (Position l c) s = let
@@ -241,28 +249,28 @@ getWordFromString (x:xs) n acc = if x == ' ' then getWordFromString xs (n-1) []
241249

242250
handlers :: (?globals :: Globals) => Handlers LspS
243251
handlers = mconcat
244-
[ notificationHandler SInitialized $ \msg -> do
252+
[ notificationHandler SMethod_Initialized $ \msg -> do
245253
return ()
246-
, notificationHandler STextDocumentDidClose $ \msg -> do
254+
, notificationHandler SMethod_TextDocumentDidClose $ \msg -> do
247255
return ()
248-
, notificationHandler SCancelRequest $ \msg -> do
256+
, notificationHandler SMethod_CancelRequest $ \msg -> do
249257
return ()
250-
, notificationHandler STextDocumentDidSave $ \msg -> do
258+
, notificationHandler SMethod_TextDocumentDidSave $ \msg -> do
251259
let doc = msg ^. L.params . L.textDocument . L.uri
252260
content = fromMaybe "?" $ msg ^. L.params . L.text
253-
validateGranuleCode (toNormalizedUri doc) Nothing content
254-
, notificationHandler STextDocumentDidOpen $ \msg -> do
261+
validateGranuleCode (toNormalizedUri doc) (maybeToNull Nothing) content
262+
, notificationHandler SMethod_TextDocumentDidOpen $ \msg -> do
255263
let doc = msg ^. L.params . L.textDocument . L.uri
256264
content = msg ^. L.params . L.textDocument . L.text
257-
validateGranuleCode (toNormalizedUri doc) Nothing content
258-
, notificationHandler STextDocumentDidChange $ \msg -> do
265+
validateGranuleCode (toNormalizedUri doc) (maybeToNull Nothing) content
266+
, notificationHandler SMethod_TextDocumentDidChange $ \msg -> do
259267
let doc = msg ^. L.params . L.textDocument . L.uri . to toNormalizedUri
260268
mdoc <- getVirtualFile doc
261269
case mdoc of
262270
Just vf@(VirtualFile _ version _rope) -> do
263-
validateGranuleCode doc (Just (fromIntegral version)) (virtualFileText vf)
271+
validateGranuleCode doc (maybeToNull (Just (fromIntegral version))) (virtualFileText vf)
264272
_ -> debugS $ "No virtual file found for: " <> (T.pack (show msg))
265-
, requestHandler SWorkspaceSymbol $ \req responder -> do
273+
, requestHandler SMethod_WorkspaceSymbol $ \req responder -> do
266274
let query = T.unpack $ req ^. L.params . L.query
267275
defns <- getDefns
268276
let possibleDefn = M.lookup query defns
@@ -276,11 +284,11 @@ handlers = mconcat
276284
constrIds = M.fromList $ map (\x -> (pretty $ dataConstrId x, x)) constrs
277285
possibleConstr = M.lookup query constrIds
278286
case possibleConstr of
279-
Nothing -> responder $ Right $ List []
280-
Just c -> responder $ Right $ List [objectToSymbol dataConstrSpan dataConstrId c]
281-
Just d -> responder $ Right $ List [objectToSymbol dataDeclSpan dataDeclId d]
282-
Just d -> responder $ Right $ List [objectToSymbol defSpan defId d]
283-
, requestHandler STextDocumentDefinition $ \req responder -> do
287+
Nothing -> responder $ Right $ InR $ InR Null
288+
Just c -> responder $ Right $ InL [objectToSymbol dataConstrSpan dataConstrId c]
289+
Just d -> responder $ Right $ InL [objectToSymbol dataDeclSpan dataDeclId d]
290+
Just d -> responder $ Right $ InL [objectToSymbol defSpan defId d]
291+
, requestHandler SMethod_TextDocumentDefinition $ \req responder -> do
284292
let params = req ^. L.params
285293
pos = params ^. L.position
286294
doc = params ^. L.textDocument . L.uri . to toNormalizedUri
@@ -289,7 +297,7 @@ handlers = mconcat
289297
Just vf@(VirtualFile _ version _rope) -> do
290298
let t = virtualFileText vf
291299
query = getWordAtPosition t pos
292-
validateGranuleCode doc (Just (fromIntegral version)) t
300+
validateGranuleCode doc (maybeToNull (Just (fromIntegral version))) t
293301
case query of
294302
Nothing -> debugS $ "This should be impossible!"
295303
Just q -> do
@@ -305,10 +313,10 @@ handlers = mconcat
305313
constrIds = M.fromList $ map (\x -> (pretty $ dataConstrId x, x)) constrs
306314
possibleConstr = M.lookup q constrIds
307315
case possibleConstr of
308-
Nothing -> responder $ Right $ InR $ InL $ List []
309-
Just c -> responder $ Right $ InR $ InL $ List [spanToLocation $ dataConstrSpan c]
310-
Just d -> responder $ Right $ InR $ InL $ List [spanToLocation $ dataDeclSpan d]
311-
Just d -> responder $ Right $ InR $ InL $ List [spanToLocation $ defSpan d]
316+
Nothing -> responder $ Right $ InR $ InR Null
317+
Just c -> responder $ Right $ InL $ Definition $ InL $ spanToLocation $ dataConstrSpan c
318+
Just d -> responder $ Right $ InL $ Definition $ InL $ spanToLocation $ dataDeclSpan d
319+
Just d -> responder $ Right $ InL $ Definition $ InL $ spanToLocation $ defSpan d
312320
_ -> debugS $ "No virtual file found for: " <> (T.pack (show doc))
313321
]
314322

@@ -317,15 +325,17 @@ main = do
317325
globals <- Interpreter.getGrConfig >>= (return . Interpreter.grGlobals . snd)
318326
state <- newLsStateVar
319327
runServer $ ServerDefinition
320-
{ onConfigurationChange = const $ const $ Right ()
328+
{ onConfigChange = \_ -> pure ()
321329
, defaultConfig = ()
322330
, doInitialize = const . pure . Right
323-
, staticHandlers = (let ?globals = globals in handlers)
331+
, parseConfig = \_ _ -> Left "Not supported"
332+
, configSection = T.pack "granule"
333+
, staticHandlers = let ?globals = globals in (\_ -> handlers)
324334
, interpretHandler = \env -> Iso (\lsps -> runLspS lsps state env) liftIO
325335
, options =
326336
defaultOptions
327337
{
328-
textDocumentSync =
338+
optTextDocumentSync =
329339
Just
330340
( TextDocumentSyncOptions
331341
(Just True)
@@ -337,4 +347,4 @@ main = do
337347
}
338348
}
339349
where
340-
syncKind = TdSyncFull
350+
syncKind = TextDocumentSyncKind_Full

‎stack.yaml‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,10 @@ packages:
1212
extra-deps:
1313
- text-replace-0.1.0.3
1414
- syz-0.2.0.0
15+
- lsp-types-2.3.0.1
16+
- lsp-2.7.0.1
17+
- mod-0.2.0.1
18+
- row-types-1.0.1.2
1519
- git: https://github.com/jackohughes/haskell-src-exts
1620
commit: 5c2647fa0746bdac046897f5a6b7e4f5ef3afa79
1721

0 commit comments

Comments
 (0)