Skip to content

Commit bb543d3

Browse files
banacornbanacorn
committed
[ fix ] Add dummy handler for SInitialized & STextDocumentDidOpen notifications
1 parent ccfa2a3 commit bb543d3

File tree

1 file changed

+87
-83
lines changed

1 file changed

+87
-83
lines changed

‎src/Server.hs‎

Lines changed: 87 additions & 83 deletions
Original file line numberDiff line numberDiff line change
@@ -1,114 +1,118 @@
11
{-# LANGUAGE CPP #-}
2-
{-# LANGUAGE DeriveGeneric #-}
32

43
-- entry point of the LSP server
54

65
module Server
7-
( run
8-
) where
6+
( run,
7+
)
8+
where
99

1010
import qualified Agda
11-
import Control.Concurrent ( writeChan )
12-
import Control.Monad ( void )
13-
import Control.Monad.Reader ( MonadIO(liftIO) )
14-
import Data.Aeson ( FromJSON
15-
, ToJSON
16-
)
17-
import qualified Data.Aeson as JSON
18-
import Data.Text ( pack )
19-
import GHC.IO.IOMode ( IOMode(ReadWriteMode) )
20-
import Language.LSP.Server hiding ( Options )
21-
import Language.LSP.Types hiding ( Options(..)
22-
, TextDocumentSyncClientCapabilities(..)
23-
)
24-
import Monad
25-
import qualified Network.Simple.TCP as TCP
26-
import Network.Socket ( socketToHandle )
11+
import Control.Concurrent (writeChan)
12+
import Control.Monad (void)
13+
import Control.Monad.Reader (MonadIO (liftIO))
14+
import Data.Aeson
15+
( FromJSON,
16+
ToJSON,
17+
)
18+
import qualified Data.Aeson as JSON
19+
import Data.Text (pack)
20+
import qualified Data.Text as T
21+
import GHC.IO.IOMode (IOMode (ReadWriteMode))
22+
import Language.LSP.Server hiding (Options)
23+
import qualified Language.LSP.Server as LSP
24+
import Language.LSP.Types hiding
25+
( Options (..),
26+
TextDocumentSyncClientCapabilities (..),
27+
)
28+
import Monad
29+
import qualified Network.Simple.TCP as TCP
30+
import Network.Socket (socketToHandle)
31+
import Options
32+
import qualified Server.Handler as Handler
33+
import Switchboard (Switchboard)
2734
import qualified Switchboard
28-
import Switchboard ( Switchboard )
29-
30-
import qualified Server.Handler as Handler
31-
32-
import qualified Language.LSP.Server as LSP
33-
import Options
34-
3535

3636
--------------------------------------------------------------------------------
3737

3838
run :: Options -> IO Int
3939
run options = do
4040
case optViaTCP options of
4141
Just port -> do
42-
void
43-
$ TCP.serve (TCP.Host "127.0.0.1") (show port)
44-
$ \(sock, _remoteAddr) -> do
42+
void $
43+
TCP.serve (TCP.Host "127.0.0.1") (show port) $
44+
\(sock, _remoteAddr) -> do
4545
-- writeChan (envLogChan env) "[Server] connection established"
4646
handle <- socketToHandle sock ReadWriteMode
47-
_ <- runServerWithHandles
47+
_ <- runServerWithHandles
4848
#if MIN_VERSION_lsp(1,5,0)
49-
mempty mempty
49+
mempty mempty
5050
#endif
51-
handle handle (serverDefn options)
51+
handle handle (serverDefn options)
5252
return ()
5353
-- Switchboard.destroy switchboard
5454
return 0
5555
Nothing -> do
5656
runServer (serverDefn options)
57-
where
58-
serverDefn :: Options -> ServerDefinition Config
59-
serverDefn options = ServerDefinition
60-
{ defaultConfig = initConfig
61-
, onConfigurationChange = \old newRaw -> case JSON.fromJSON newRaw of
62-
JSON.Error s -> Left $ pack $ "Cannot parse server configuration: " <> s
63-
JSON.Success new -> Right new
64-
, doInitialize = \ctxEnv _req -> do
65-
env <- runLspT ctxEnv (createInitEnv options)
66-
switchboard <- Switchboard.new env
67-
Switchboard.setupLanguageContextEnv switchboard ctxEnv
68-
pure $ Right (ctxEnv, env)
69-
, staticHandlers = handlers
70-
, interpretHandler = \(ctxEnv, env) ->
71-
Iso (runLspT ctxEnv . runServerM env) liftIO
72-
, options = lspOptions
73-
}
57+
where
58+
serverDefn :: Options -> ServerDefinition Config
59+
serverDefn options =
60+
ServerDefinition
61+
{ defaultConfig = initConfig,
62+
onConfigurationChange = \old newRaw -> case JSON.fromJSON newRaw of
63+
JSON.Error s -> Left $ pack $ "Cannot parse server configuration: " <> s
64+
JSON.Success new -> Right new,
65+
doInitialize = \ctxEnv _req -> do
66+
env <- runLspT ctxEnv (createInitEnv options)
67+
switchboard <- Switchboard.new env
68+
Switchboard.setupLanguageContextEnv switchboard ctxEnv
69+
pure $ Right (ctxEnv, env),
70+
staticHandlers = handlers,
71+
interpretHandler = \(ctxEnv, env) ->
72+
Iso (runLspT ctxEnv . runServerM env) liftIO,
73+
options = lspOptions
74+
}
7475

75-
lspOptions :: LSP.Options
76-
lspOptions = defaultOptions { textDocumentSync = Just syncOptions }
76+
lspOptions :: LSP.Options
77+
lspOptions = defaultOptions {textDocumentSync = Just syncOptions}
7778

78-
-- these `TextDocumentSyncOptions` are essential for receiving notifications from the client
79-
syncOptions :: TextDocumentSyncOptions
80-
syncOptions = TextDocumentSyncOptions { _openClose = Just True -- receive open and close notifications from the client
81-
, _change = Just changeOptions -- receive change notifications from the client
82-
, _willSave = Just False -- receive willSave notifications from the client
83-
, _willSaveWaitUntil = Just False -- receive willSave notifications from the client
84-
, _save = Just $ InR saveOptions
85-
}
79+
-- these `TextDocumentSyncOptions` are essential for receiving notifications from the client
80+
syncOptions :: TextDocumentSyncOptions
81+
syncOptions =
82+
TextDocumentSyncOptions
83+
{ _openClose = Just True, -- receive open and close notifications from the client
84+
_change = Just changeOptions, -- receive change notifications from the client
85+
_willSave = Just False, -- receive willSave notifications from the client
86+
_willSaveWaitUntil = Just False, -- receive willSave notifications from the client
87+
_save = Just $ InR saveOptions
88+
}
8689

87-
changeOptions :: TextDocumentSyncKind
88-
changeOptions = TdSyncIncremental
90+
changeOptions :: TextDocumentSyncKind
91+
changeOptions = TdSyncIncremental
8992

90-
-- includes the document content on save, so that we don't have to read it from the disk
91-
saveOptions :: SaveOptions
92-
saveOptions = SaveOptions (Just True)
93+
-- includes the document content on save, so that we don't have to read it from the disk
94+
saveOptions :: SaveOptions
95+
saveOptions = SaveOptions (Just True)
9396

9497
-- handlers of the LSP server
9598
handlers :: Handlers (ServerM (LspM Config))
96-
handlers = mconcat
97-
[ -- custom methods, not part of LSP
98-
requestHandler (SCustomMethod "agda") $ \req responder -> do
99-
let RequestMessage _ _i _ params = req
100-
response <- Agda.sendCommand params
101-
responder $ Right response
102-
,
103-
-- hover provider
104-
requestHandler STextDocumentHover $ \req responder -> do
105-
let
106-
RequestMessage _ _ _ (HoverParams (TextDocumentIdentifier uri) pos _workDone)
107-
= req
108-
result <- Handler.onHover uri pos
109-
responder $ Right result
110-
-- -- syntax highlighting
111-
-- , requestHandler STextDocumentSemanticTokensFull $ \req responder -> do
112-
-- result <- Handler.onHighlight (req ^. (params . textDocument . uri))
113-
-- responder result
114-
]
99+
handlers =
100+
mconcat
101+
[ -- custom methods, not part of LSP
102+
requestHandler (SCustomMethod "agda") $ \req responder -> do
103+
let RequestMessage _ _i _ params = req
104+
response <- Agda.sendCommand params
105+
responder $ Right response,
106+
-- hover provider
107+
requestHandler STextDocumentHover $ \req responder -> do
108+
let RequestMessage _ _ _ (HoverParams (TextDocumentIdentifier uri) pos _workDone) =
109+
req
110+
result <- Handler.onHover uri pos
111+
responder $ Right result,
112+
notificationHandler SInitialized $ \_not -> pure (),
113+
notificationHandler STextDocumentDidOpen $ \_not -> pure ()
114+
-- -- syntax highlighting
115+
-- , requestHandler STextD_cumentSemanticTokensFull $ \req responder -> do
116+
-- result <- Handler.onHighlight (req ^. (params . textDocument . uri))
117+
-- responder result
118+
]

0 commit comments

Comments
 (0)