-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathLSP.hs
556 lines (459 loc) · 23.9 KB
/
LSP.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
-- | An simple abstraction layer above the rather complex
-- and low-level @haskell-lsp@ library.
--
-- (loosely based on the example server code in @haskell-lsp@)
{-# LANGUAGE BangPatterns, ScopedTypeVariables, KindSignatures #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes, GADTs, TypeInType #-}
{-# LANGUAGE TypeOperators, ExplicitNamespaces #-}
{-# LANGUAGE PatternSynonyms #-}
module LSP where
--------------------------------------------------------------------------------
import Control.Monad
import Control.Monad.Reader
import Control.Monad.STM
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Concurrent.STM.TChan
import qualified Control.Exception as E
import Control.Lens
import GHC.Generics (Generic)
import Control.DeepSeq
import Data.Default
import qualified Data.Text as T
import qualified Data.Rope.UTF16 as Rope
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import System.Exit
import System.FilePath
import System.Directory
import System.IO.Unsafe as Unsafe
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Aeson as J
import Language.LSP.Server as S
import Language.LSP.Diagnostics
import qualified Language.LSP.Types as J
import qualified Language.LSP.Types.Lens as J
import Language.LSP.VFS
import System.Log.Logger as L
import Language.LSP.Types ( type (|?)(..) )
import Common
--------------------------------------------------------------------------------
-- * global config
lspServerName :: T.Text
lspServerName = T.pack "toy-ide"
lspServerVersion :: T.Text
lspServerVersion = T.pack "0.1.2"
logging :: Bool
logging = False -- True
{-# NOINLINE logDir #-}
logDir :: FilePath
logDir = Unsafe.unsafePerformIO getTemporaryDirectory -- "/tmp/"
logFile = logDir </> "toy-ide.log"
-- sessionLogFile = logDir </> "toy-ide-session.log"
--------------------------------------------------------------------------------
-- * our simplified LSP abstraction layer
-- | We need this because of the idiotic vscode shitfest
data IDECompletionType
= NormalCompletion -- ^ just normal completion
| SpecCompletion Location -- ^ this is used when the completion starts with a special character, and the fucking stupid vscode tokenizer wants to override us + the textedit is also ignored because - surprise - they are fucking stupid!
deriving Show
data IDECompletion = IDECompletion
{ ideComplLabel :: String
, ideComplReplace :: Maybe String
, ideComplType :: IDECompletionType
, ideComplKind :: Maybe J.CompletionItemKind
}
deriving Show
data IDE result = IDE
{ ideCheckDocument :: T.Text -> result
, ideDiagnostics :: result -> [Diag]
, ideOnHover :: result -> SrcPos -> Maybe (Location,[String])
, ideHighlight :: result -> SrcPos -> [Location]
, ideDefinLoc :: result -> SrcPos -> Maybe Location
, ideCompletion :: result -> SrcPos -> [IDECompletion]
, ideRename :: result -> SrcPos -> String -> [(Location,String)]
, ideGetToken :: result -> SrcPos -> Maybe (Location,String)
}
data Diag = Diag
{ diagLocation :: !Location
, diagSeverity :: !J.DiagnosticSeverity
, diagMessage :: !String
}
deriving (Generic,NFData)
data IDEState result
= IdeChecking !ThreadId -- ^ we are in the process of checking the source
| IdeChecked !result -- ^ checking is done, but no feedback sent yet
| IdeDone !result -- ^ feedback was also sent
ideResult :: IDEState result -> Maybe result
ideResult state = case state of
IdeChecking {} -> Nothing
IdeChecked res -> Just res
IdeDone res -> Just res
type IDETable result = Map J.NormalizedUri (IDEState result)
--------------------------------------------------------------------------------
-- * misc helpers
adjustMVar :: MVar a -> (a -> a) -> IO ()
adjustMVar mv f = do
x <- takeMVar mv
putMVar mv $! f x
mapReplaceIfExists :: Ord k => k -> v -> Map k v -> Map k v
mapReplaceIfExists !k !v = Map.alter f k where
f Nothing = Nothing
f (Just _) = Just v
--------------------------------------------------------------------------------
-- * completion items
-- why isn't this part of @haskell-lsp@?
defCompletionItem :: J.CompletionItem
defCompletionItem = J.CompletionItem
{ J._label = T.empty -- The label of this completion item. By default also the text that is inserted when selecting this completion.
, J._kind = Nothing -- Kind of the item (method, type, color, etc)
, J._tags = Nothing -- Tags for this completion item.
, J._detail = Nothing -- A human-readable string with additional information about this item, like type or symbol information.
, J._documentation = Nothing -- A human-readable string that represents a doc-comment.
, J._deprecated = Nothing -- Indicates if this item is deprecated.
, J._preselect = Nothing -- Select this item when showing. *Note* that only one completion item can be selected and that the tool / client decides which item that is. The rule is that the *first* item of those that match best is selected.
, J._sortText = Nothing -- A string that should be used when filtering a set of completion items. When falsy the label is used.
, J._filterText = Nothing -- A string that should be used when filtering a set of completion items. When falsy the label is used.
, J._insertText = Nothing -- A string that should be inserted a document when selecting this completion. When falsy the label is used.
, J._insertTextFormat = Nothing -- The format of the insert text. The format applies to both the insertText property and the newText property of a provided textEdit.
, J._insertTextMode = Nothing -- How whitespace and indentation is handled during completion item insertion. If not provided the client's default value depends on the textDocument.completion.insertTextMode client capability.
, J._textEdit = Nothing -- An edit which is applied to a document when selecting this completion. When an edit is provided the value of insertText is ignored.
, J._additionalTextEdits = Nothing -- An optional array of additional text edits that are applied when selecting this completion. Edits must not overlap with the main edit nor with themselves.
, J._commitCharacters = Nothing -- An optional set of characters that when pressed while this completion is active will accept it first and then type that character. *Note* that all commit characters should have `length=1` and that superfluous characters will be ignored.
, J._command = Nothing -- An optional command that is executed *after* inserting this completion. *Note* that additional modifications to the current document should be described with the additionalTextEdits-property.
, J._xdata = Nothing
}
mkCompletionItem :: IDECompletion -> J.CompletionItem
mkCompletionItem (IDECompletion label mbreplace typ mbkind) = case mbreplace of
Nothing -> mkCompletionItem (IDECompletion label (Just label) typ mbkind)
Just replace -> case typ of
NormalCompletion -> defCompletionItem
{ J._label = T.pack label
, J._kind = mbkind
, J._insertText = Just (T.pack replace)
}
SpecCompletion loc -> defCompletionItem
{ J._label = T.pack label
, J._kind = mbkind
, J._textEdit = Just (J.CompletionEditText $ J.TextEdit (trimRangeBy1 $ locToRange loc) (T.pack replace))
, J._additionalTextEdits = Just $ J.List [J.TextEdit (rangeInitialChar $ locToRange loc) (T.empty)]
-- . ^^^ this must be done this way because vscode is fucking stupid and does not allow
-- the textedit to be touch anything left of whatever vscode's *own tokenizer* thinks
-- is the current token is, which is abso-fucking-ly bollocks - what the alien fuck are they smoking???
}
--------------------------------------------------------------------------------
-- * re-check documents
-- seriously...
class SomeVersion v where versionToMaybeInt :: v -> Maybe Int
instance SomeVersion (Maybe Int) where versionToMaybeInt = id
instance SomeVersion Int where versionToMaybeInt = Just
checkDocument
:: (NFData result, SomeVersion ver, J.HasUri textdoc J.Uri, J.HasVersion textdoc ver)
=> IDE result -> MVar (IDETable result)
-> textdoc -> Maybe FilePath -> T.Text -> LspM Config ()
checkDocument ide global tdoc mbFilePath text = do
let uri = tdoc ^. J.uri . to J.toNormalizedUri
ver = tdoc ^. J.version
liftIO $ debugM "checkDocument" $ "checking document..."
let !result = ideCheckDocument ide text
-- liftIO $ print result
rnf result `seq` (liftIO $ adjustMVar global (mapReplaceIfExists uri (IdeChecked result)))
liftIO $ debugM "checkDocument" $ "computing diagnostics..."
let !diags = ideDiagnostics ide result
sendDiags uri (versionToMaybeInt ver) diags -- version ???
rnf diags `seq` (liftIO $ adjustMVar global (mapReplaceIfExists uri (IdeDone result)))
liftIO $ debugM "checkDocument" $ "done."
return ()
updateDocument
:: (NFData result, SomeVersion ver, J.HasUri textdoc J.Uri, J.HasVersion textdoc ver)
=> IDE result -> MVar (IDETable result)
-> textdoc -> Maybe FilePath -> T.Text -> LspM Config ()
updateDocument ide global tdoc mbFileName text = do
let uri = tdoc ^. J.uri . to J.toNormalizedUri
lspEnv <- getLspEnv -- :: LanguageContextEnv config
liftIO $ debugM "updateDocument" $ "updating document..."
liftIO $ do
table <- takeMVar global
case Map.lookup uri table of
Just (IdeChecking old_threadid) -> killThread old_threadid
_ -> return ()
threadid <- forkIO $ runLspT lspEnv $ checkDocument ide global tdoc mbFileName text
putMVar global $! (Map.insert uri (IdeChecking threadid) table)
closeDocument
:: NFData result => IDE result -> MVar (IDETable result)
-> J.NormalizedUri -> LspM Config ()
closeDocument ide global uri = do
liftIO $ adjustMVar global (Map.delete uri)
--------------------------------------------------------------------------------
-- * interfacing with @haskell-lsp@
lspMain :: forall result. NFData result => IDE result -> IO ()
lspMain ide = do
global <- newMVar Map.empty :: IO (MVar (IDETable result))
run ide global >>= \r -> case r of
0 -> exitSuccess
c -> exitWith . ExitFailure $ c
run :: forall result. NFData result => IDE result -> MVar (IDETable result) -> IO Int
run ide global = flip E.catches handlers $ do
rin <- atomically newTChan :: IO (TChan ReactorInput)
let serverDefinition = ServerDefinition
{ defaultConfig = Config
, onConfigurationChange = \oldconfig v -> case J.fromJSON v of
J.Error e -> Left (T.pack e)
J.Success cfg -> Right cfg
, doInitialize = \env _ -> forkIO (reactor rin) >> pure (Right env)
, staticHandlers = lspHandlers ide global rin
, interpretHandler = \env -> S.Iso (runLspT env) liftIO
, options = lspOptions
}
flip E.finally finalProc $ do
if logging
then setupLogger (Just logFile) ["reactor"] DEBUG
else setupLogger Nothing ["reactor"] DEBUG
runServer serverDefinition
where
handlers = [ E.Handler ioExcept
, E.Handler someExcept
]
finalProc = removeAllHandlers
ioExcept (e :: E.IOException) = print e >> return 1
someExcept (e :: E.SomeException) = print e >> return 1
--------------------------------------------------------------------------------
-- | Server configuration
data Config
= Config
deriving (Generic, J.ToJSON, J.FromJSON)
newtype ReactorInput
= ReactorAction (IO ())
--------------------------------------------------------------------------------
-- * conversion between LSP's and our positions
-- LSP starts from 0, Megaparsec starts from 1...
srcPosToPos :: SrcPos -> J.Position
srcPosToPos (SrcPos l c) = J.Position (l-1) (c-1)
posToSrcPos :: J.Position -> SrcPos
posToSrcPos (J.Position l c) = SrcPos (l+1) (c+1)
locToRange :: Location -> J.Range
locToRange (Location p1 p2) = J.Range (srcPosToPos p1) (srcPosToPos p2)
rangeToLoc :: J.Range -> Location
rangeToLoc (J.Range p1 p2) = Location (posToSrcPos p1) (posToSrcPos p2)
--------------------------------------------------------------------------------
-- fucking stupid vscode textedit completion shitfest
trimRangeBy1 :: J.Range -> J.Range
trimRangeBy1 (J.Range p1 p2) = J.Range (moveRight p1) p2
rangeInitialChar :: J.Range -> J.Range
rangeInitialChar (J.Range p _) = J.Range p (moveRight p)
-- extendRangeBy1 :: J.Range -> J.Range
-- extendRangeBy1 (J.Range p1 p2) = J.Range p1 (moveRight p2)
-- moveRangeBy1 :: J.Range -> J.Range
-- moveRangeBy1 (J.Range p1 p2) = J.Range (moveRight p1) (moveRight p2)
moveRight :: J.Position -> J.Position
moveRight (J.Position line col) = J.Position line (col+1)
--------------------------------------------------------------------------------
-- | send back diagnostics
sendDiags :: J.NormalizedUri -> Maybe Int -> [Diag] -> LspM Config ()
sendDiags fileUri version mydiags = do
let diags =
[ J.Diagnostic
{ _range = locToRange loc -- range
, _severity = Just severity -- severity
, _code = Nothing -- code
, _source = Just lspServerName -- source
, _message = T.pack msg -- message
, _tags = Nothing -- tags
, _relatedInformation = Nothing -- related info
}
| Diag loc severity msg <- mydiags
]
publishDiagnostics 100 fileUri version (partitionBySource diags)
--------------------------------------------------------------------------------
-- we call this when the document is first loaded or when it changes
updateDocumentLsp
:: (NFData result, SomeVersion ver, J.HasVersion textdoc ver, J.HasUri textdoc J.Uri)
=> IDE result -> MVar (IDETable result) -> textdoc -> LspM Config ()
updateDocumentLsp ide global doc0 = do
let doc = J.toNormalizedUri (doc0 ^. J.uri)
fileName = J.uriToFilePath (doc0 ^. J.uri)
-- liftIO $ debugM "updateDocumentLsp" $ "updating document " ++ show fileName
mdoc <- getVirtualFile doc
case mdoc of
Just (VirtualFile lsp_ver file_ver str) -> do
updateDocument ide global doc0 fileName (Rope.toText str)
Nothing -> do
liftIO $ debugM "updateDocumentLsp" $ "updateDocumentLsp: vfs returned Nothing"
--------------------------------------------------------------------------------
-- * the main event handler
-- | The single point that all events flow through, allowing management of state
-- to stitch replies and requests together from the two asynchronous sides: lsp
-- server and backend compiler
reactor :: TChan ReactorInput -> IO ()
reactor inp = do
debugM "reactor" "Started the reactor"
forever $ do
ReactorAction act <- atomically $ readTChan inp
act
-- | Check if we have a handler, and if we create a haskell-lsp handler to pass it as
-- input into the reactor
lspHandlers
:: forall result. NFData result => IDE result -> MVar (IDETable result)
-> TChan ReactorInput -> Handlers (LspM Config)
lspHandlers ide global rin = mapHandlers goReq goNot (handle ide global) where
goReq :: forall (a :: J.Method J.FromClient J.Request). Handler (LspM Config) a -> Handler (LspM Config) a
goReq f = \msg k -> do
env <- getLspEnv
liftIO $ atomically $ writeTChan rin $ ReactorAction (runLspT env $ f msg k)
goNot :: forall (a :: J.Method J.FromClient J.Notification). Handler (LspM Config) a -> Handler (LspM Config) a
goNot f = \msg -> do
env <- getLspEnv
liftIO $ atomically $ writeTChan rin $ ReactorAction (runLspT env $ f msg)
--------------------------------------------------------------------------------
-- * The actual event handling logic
-- | Where the actual logic resides for handling requests and notifications.
handle :: forall result. NFData result => IDE result -> MVar (IDETable result) -> Handlers (LspM Config)
handle ide global = mconcat
-- See
-- <https://hackage.haskell.org/package/lsp-types-1.1.0.0/docs/Language-LSP-Types.html#t:MessageParams>
-- for request parameter types, and
-- <https://hackage.haskell.org/package/lsp-types-1.1.0.0/docs/Language-LSP-Types.html#t:ResponseResult>
-- for the response types
[ -- initialized notification
notificationHandler J.SInitialized $ \_notification -> do
liftIO $ debugM "reactor.handle" $ "Initialized Notification"
-- we could register extra capabilities here
-- registerTextDocumentContentProvider
return ()
----------------------------------------------------------------------------
-- open document notification
, notificationHandler J.STextDocumentDidOpen $ \notification -> do
let doc = notification ^. J.params . J.textDocument
updateDocumentLsp ide global doc
-- save document notification
, notificationHandler J.STextDocumentDidSave $ \notification -> do
-- let doc = notification ^. J.params . J.textDocument
return ()
-- close document notification
, notificationHandler J.STextDocumentDidClose $ \notification -> do
let uri = notification ^. J.params . J.textDocument . J.uri
closeDocument ide global (J.toNormalizedUri uri)
-- change document notification
-- we should re-parse and update everything!
, notificationHandler J.STextDocumentDidChange $ \notification -> do
let doc = notification ^. J.params . J.textDocument
updateDocumentLsp ide global doc
----------------------------------------------------------------------------
-- hover request
-- we should send back some tooltip info
-- MessageParams TextDocumentHover = HoverParams
, requestHandler J.STextDocumentHover $ \req responder -> do
let J.HoverParams tdoc pos _workdone = req ^. J.params
doc = req ^. J.params . J.textDocument . J.uri
uri = J.toNormalizedUri doc
liftIO $ debugM "reactor.handle" $ "hover request at " ++ show (posToSrcPos pos)
mbMsg <- ideGetMaybe uri $ \res -> ideOnHover ide res (posToSrcPos pos)
mbHover <- case mbMsg of
Nothing -> return Nothing
Just (loc,msgs) -> do
liftIO $ debugM "reactor.handle" $ "ide says: " ++ show msgs
let hc = J.HoverContents $ J.markedUpContent lspServerName (T.pack $ unlines msgs)
hov = J.Hover hc (Just $ locToRange loc) :: J.Hover
return $ Just hov
responder (Right mbHover)
-- . ^^^ ResponseResult TextDocumentHover = Maybe Hover
--
----------------------------------------------------------------------------
-- highlight request
-- we should send back a list of ranges
, requestHandler J.STextDocumentDocumentHighlight $ \req responder -> do
let J.DocumentHighlightParams tdoc pos _workdone _partialres = req ^. J.params
doc = req ^. J.params . J.textDocument . J.uri
uri = J.toNormalizedUri doc
liftIO $ debugM "reactor.handle" $ "highlight request at " ++ show (posToSrcPos pos)
hlList1 <- ideGetList uri $ \res -> ideHighlight ide res (posToSrcPos pos)
let hlList = [ J.DocumentHighlight (locToRange loc) Nothing | loc <- hlList1 ]
responder (Right $ J.List hlList)
----------------------------------------------------------------------------
-- (jump to) definition request
, requestHandler J.STextDocumentDefinition $ \req responder -> do
let J.DefinitionParams tdoc pos _workdone _partialres = req ^. J.params
doc = req ^. J.params . J.textDocument . J.uri
uri = J.toNormalizedUri doc
liftIO $ debugM "reactor.handle" $ "definition request at " ++ show (posToSrcPos pos)
mbloc <- ideGetMaybe uri $ \res -> ideDefinLoc ide res (posToSrcPos pos)
let rsp :: J.Location |? (J.List J.Location |? J.List J.LocationLink)
rsp = case mbloc of
Just loc -> J.InL (J.Location doc (locToRange loc))
Nothing -> J.InR (J.InL $ J.List []) -- ?? how to return failure - apparently this way
responder (Right rsp)
-- . ^^^ ResponseResult TextDocumentDefinition = Location |? (List Location |? List LocationLink)
----------------------------------------------------------------------------
-- completion request
, requestHandler J.STextDocumentCompletion $ \req responder -> do
let J.CompletionParams tdoc pos _workdone _partialrestok _ctx = req ^. J.params
doc = req ^. J.params . J.textDocument . J.uri
uri = J.toNormalizedUri doc
mbToken <- ideGetMaybe uri $ \res -> ideGetToken ide res (posToSrcPos pos)
let token = case mbToken of { Just (loc,t) -> t ; Nothing -> "" }
liftIO $ debugM "reactor.handle" $ "completion request at " ++ show (posToSrcPos pos) ++ " for token `" ++ token ++ "`"
clist <- ideGetList uri $ \res -> ideCompletion ide res (posToSrcPos pos)
let items = map mkCompletionItem clist
let rsp = J.InR (J.CompletionList False (J.List items))
responder (Right rsp)
-- . ^^^ ResponseResult TextDocumentCompletion = List CompletionItem |? CompletionList
----------------------------------------------------------------------------
-- rename request
, requestHandler J.STextDocumentRename $ \req responder -> do
let J.RenameParams tdoc pos _workdone newName = req ^. J.params
doc = req ^. J.params . J.textDocument . J.uri
uri = J.toNormalizedUri doc
liftIO $ debugM "reactor.handle" $ "rename request at " ++ show (posToSrcPos pos)
list <- ideGetList uri $ \res -> ideRename ide res (posToSrcPos pos) (T.unpack newName)
-- liftIO $ debugM "reactor.handle" $ "renaming = " ++ show list
let edits = J.List [ InL (J.TextEdit (locToRange loc) (T.pack newText)) | (loc,newText) <- list ]
let vtdoc = J.VersionedTextDocumentIdentifier doc (Just 0) -- Nothing -- ???
let docedit = J.InL (J.TextDocumentEdit vtdoc edits) :: J.DocumentChange
let rsp = J.WorkspaceEdit
{ J._changes = Nothing
, J._documentChanges = Just (J.List [docedit])
, J._changeAnnotations = Nothing
}
responder (Right rsp)
-- . ^^^ ResponseResult TextDocumentRename = WorkspaceEdit
]
where
-- common access patterns
ideGetMaybe :: J.NormalizedUri -> (result -> Maybe a) -> LspM config (Maybe a)
ideGetMaybe uri user = liftIO (tryReadMVar global) >>= \mbtable -> case mbtable of
Nothing -> return Nothing
Just table -> case Map.lookup uri table >>= ideResult of
Nothing -> return Nothing
Just result -> return (user result)
ideGetList :: J.NormalizedUri -> (result -> [a]) -> LspM config [a]
ideGetList uri user = liftIO (tryReadMVar global) >>= \mbtable -> case mbtable of
Nothing -> return []
Just table -> case Map.lookup uri table >>= ideResult of
Nothing -> return []
Just result -> return (user result)
--------------------------------------------------------------------------------
syncOptions :: J.TextDocumentSyncOptions
syncOptions = J.TextDocumentSyncOptions
{ J._openClose = Just True
, J._change = Just J.TdSyncIncremental
, J._willSave = Just False
, J._willSaveWaitUntil = Just False
, J._save = Just (J.InL False)
}
myServerInfo :: J.ServerInfo
myServerInfo = J.ServerInfo
{ J._name = lspServerName
, J._version = Just lspServerVersion
}
-- Defined in ‘lsp-1.1.1.0:Language.LSP.Server.Core’
lspOptions :: Options
lspOptions = def
{ textDocumentSync = Just syncOptions
, completionTriggerCharacters = Just "\\#"
, serverInfo = Just myServerInfo
-- , executeCommandCommands = Just ["lsp-hello-command"]
}
--------------------------------------------------------------------------------