Skip to content

Commit 38a7edd

Browse files
banacornbanacorn
committed
[ fix ] Place dummy handlers for initialized and workspace/didChangeConfiguration to prevent the client from getting nasty errors
1 parent 79039ef commit 38a7edd

File tree

2 files changed

+68
-77
lines changed

2 files changed

+68
-77
lines changed

‎app/Main.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ module Main where
33
import Control.Monad (when)
44
import Options
55
import Server (run)
6+
-- import Simple (run)
67
import System.Console.GetOpt
78
import System.Directory (doesDirectoryExist)
89
import System.Environment
@@ -33,4 +34,5 @@ main = do
3334
then putStrLn usageMessage
3435
else do
3536
_ <- run options
37+
-- _ <- run
3638
return ()

‎src/Server.hs‎

Lines changed: 66 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -2,45 +2,30 @@
22

33
-- entry point of the LSP server
44

5-
module Server
6-
( run,
7-
)
8-
where
5+
module Server (run) where
96

107
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.Protocol.Message ( pattern RequestMessage
22-
, SMethod( SMethod_CustomMethod, SMethod_TextDocumentHover)
23-
, pattern TRequestMessage
24-
)
25-
import Language.LSP.Protocol.Types ( TextDocumentSyncOptions(..)
26-
, TextDocumentSyncKind( TextDocumentSyncKind_Incremental )
27-
, ServerCapabilities (_textDocumentSync )
28-
, SaveOptions( SaveOptions )
29-
, pattern TextDocumentIdentifier
30-
, pattern HoverParams
31-
, pattern InR
32-
, pattern InL
33-
)
34-
import Monad
35-
import qualified Network.Simple.TCP as TCP
36-
import Network.Socket ( socketToHandle )
8+
import Control.Concurrent (writeChan)
9+
import Control.Monad (void)
10+
import Control.Monad.Reader (MonadIO (liftIO))
11+
import Data.Aeson
12+
( FromJSON,
13+
ToJSON,
14+
)
15+
import qualified Data.Aeson as JSON
16+
import Data.Text (pack)
17+
import GHC.IO.IOMode (IOMode (ReadWriteMode))
18+
import Language.LSP.Protocol.Message
19+
import Language.LSP.Protocol.Types
20+
import Language.LSP.Server hiding (Options)
21+
import qualified Language.LSP.Server hiding (Options)
22+
import Monad
23+
import qualified Network.Simple.TCP as TCP
24+
import Network.Socket (socketToHandle)
25+
import Options
26+
import qualified Server.Handler as Handler
27+
import Switchboard (Switchboard, agdaCustomMethod)
3728
import qualified Switchboard
38-
import Switchboard ( Switchboard, agdaCustomMethod )
39-
40-
import qualified Server.Handler as Handler
41-
42-
import qualified Language.LSP.Server as LSP
43-
import Options
4429

4530
--------------------------------------------------------------------------------
4631

@@ -63,8 +48,7 @@ run options = do
6348
serverDefn :: Options -> ServerDefinition Config
6449
serverDefn options =
6550
ServerDefinition
66-
{
67-
defaultConfig = initConfig,
51+
{ defaultConfig = initConfig,
6852
onConfigChange = const $ pure (),
6953
parseConfig = \old newRaw -> case JSON.fromJSON newRaw of
7054
JSON.Error s -> Left $ pack $ "Cannot parse server configuration: " <> s
@@ -77,52 +61,57 @@ run options = do
7761
configSection = "dummy",
7862
staticHandlers = const handlers,
7963
interpretHandler = \(ctxEnv, env) ->
80-
Iso {
81-
forward = runLspT ctxEnv . runServerM env,
82-
backward = liftIO
83-
},
84-
options = lspOptions
64+
Iso
65+
{ forward = runLspT ctxEnv . runServerM env,
66+
backward = liftIO
67+
},
68+
options = defaultOptions
8569
}
8670

87-
lspOptions :: LSP.Options
88-
lspOptions = defaultOptions { optTextDocumentSync = Just syncOptions }
71+
-- lspOptions :: LSP.Options
72+
-- lspOptions = defaultOptions { optTextDocumentSync = Just syncOptions }
8973

90-
-- these `TextDocumentSyncOptions` are essential for receiving notifications from the client
91-
syncOptions :: TextDocumentSyncOptions
92-
syncOptions =
93-
TextDocumentSyncOptions
94-
{ _openClose = Just True, -- receive open and close notifications from the client
95-
_change = Just changeOptions, -- receive change notifications from the client
96-
_willSave = Just False, -- receive willSave notifications from the client
97-
_willSaveWaitUntil = Just False, -- receive willSave notifications from the client
98-
_save = Just $ InR saveOptions
99-
}
74+
-- -- these `TextDocumentSyncOptions` are essential for receiving notifications from the client
75+
-- syncOptions :: TextDocumentSyncOptions
76+
-- syncOptions =
77+
-- TextDocumentSyncOptions
78+
-- { _openClose = Just True, -- receive open and close notifications from the client
79+
-- _change = Just changeOptions, -- receive change notifications from the client
80+
-- _willSave = Just False, -- receive willSave notifications from the client
81+
-- _willSaveWaitUntil = Just False, -- receive willSave notifications from the client
82+
-- _save = Just $ InR saveOptions
83+
-- }
10084

101-
changeOptions :: TextDocumentSyncKind
102-
changeOptions = TextDocumentSyncKind_Incremental
85+
-- changeOptions :: TextDocumentSyncKind
86+
-- changeOptions = TextDocumentSyncKind_Incremental
10387

104-
-- includes the document content on save, so that we don't have to read it from the disk
105-
saveOptions :: SaveOptions
106-
saveOptions = SaveOptions (Just True)
88+
-- includes the document content on save, so that we don't have to read it from the disk
89+
-- saveOptions :: SaveOptions
90+
-- saveOptions = SaveOptions (Just True)
10791

10892
-- handlers of the LSP server
10993
handlers :: Handlers (ServerM (LspM Config))
110-
handlers = mconcat
111-
[ -- custom methods, not part of LSP
112-
requestHandler agdaCustomMethod $ \ req responder -> do
113-
let TRequestMessage _ _i _ params = req
114-
response <- Agda.sendCommand params
115-
responder $ Right response
116-
,
117-
-- hover provider
118-
requestHandler hoverMethod $ \ req responder -> do
119-
let TRequestMessage _ _ _ (HoverParams (TextDocumentIdentifier uri) pos _workDone) = req
120-
result <- Handler.onHover uri pos
121-
responder $ Right result
122-
-- -- syntax highlighting
123-
-- , requestHandler STextDocumentSemanticTokensFull $ \req responder -> do
124-
-- result <- Handler.onHighlight (req ^. (params . textDocument . uri))
125-
-- responder result
126-
]
94+
handlers =
95+
mconcat
96+
[ -- custom methods, not part of LSP
97+
requestHandler agdaCustomMethod $ \req responder -> do
98+
let TRequestMessage _ _i _ params = req
99+
response <- Agda.sendCommand params
100+
responder $ Right response,
101+
-- hover provider
102+
requestHandler hoverMethod $ \req responder -> do
103+
let TRequestMessage _ _ _ (HoverParams (TextDocumentIdentifier uri) pos _workDone) = req
104+
result <- Handler.onHover uri pos
105+
responder $ Right result,
106+
-- -- syntax highlighting
107+
-- , requestHandler STextDocumentSemanticTokensFull $ \req responder -> do
108+
-- result <- Handler.onHighlight (req ^. (params . textDocument . uri))
109+
-- responder result
110+
111+
-- must provide handler for `initialized` otherwise the client will get nasty error messages
112+
notificationHandler SMethod_Initialized $ \_notification -> return (),
113+
-- must provide handler for `workspace/didChangeConfiguration` otherwise the client will get nasty error messages
114+
notificationHandler SMethod_WorkspaceDidChangeConfiguration $ \_notification -> return ()
115+
]
127116
where
128117
hoverMethod = SMethod_TextDocumentHover

0 commit comments

Comments
 (0)