@@ -30,50 +30,61 @@ typescript definitions laid out in the specification
30
30
There are two example language servers in the ` lsp/example/ ` folder. ` Simple.hs ` provides a minimal example:
31
31
32
32
``` haskell
33
+ {-# LANGUAGE DuplicateRecordFields #-}
34
+ {-# LANGUAGE LambdaCase #-}
33
35
{-# LANGUAGE OverloadedStrings #-}
34
36
35
- import Language.LSP.Server
36
- import Language.LSP.Types
37
37
import Control.Monad.IO.Class
38
- import qualified Data.Text as T
38
+ import Data.Text qualified as T
39
+ import Language.LSP.Protocol.Message
40
+ import Language.LSP.Protocol.Types
41
+ import Language.LSP.Server
39
42
40
43
handlers :: Handlers (LspM () )
41
- handlers = mconcat
42
- [ notificationHandler SInitialized $ \ _not -> do
43
- let params = ShowMessageRequestParams MtInfo " Turn on code lenses?"
44
- (Just [MessageActionItem " Turn on" , MessageActionItem " Don't" ])
45
- _ <- sendRequest SWindowShowMessageRequest params $ \ res ->
46
- case res of
47
- Right (Just (MessageActionItem " Turn on" )) -> do
48
- let regOpts = CodeLensRegistrationOptions Nothing Nothing (Just False )
49
-
50
- _ <- registerCapability STextDocumentCodeLens regOpts $ \ _req responder -> do
44
+ handlers =
45
+ mconcat
46
+ [ notificationHandler SMethod_Initialized $ \ _not -> do
47
+ let params =
48
+ ShowMessageRequestParams
49
+ MessageType_Info
50
+ " Turn on code lenses?"
51
+ (Just [MessageActionItem " Turn on" , MessageActionItem " Don't" ])
52
+ _ <- sendRequest SMethod_WindowShowMessageRequest params $ \ case
53
+ Right (InL (MessageActionItem " Turn on" )) -> do
54
+ let regOpts = CodeLensRegistrationOptions (InR Null ) Nothing (Just False )
55
+
56
+ _ <- registerCapability mempty SMethod_TextDocumentCodeLens regOpts $ \ _req responder -> do
51
57
let cmd = Command " Say hello" " lsp-hello-command" Nothing
52
- rsp = List [CodeLens (mkRange 0 0 0 100 ) (Just cmd) Nothing ]
53
- responder ( Right rsp)
58
+ rsp = [CodeLens (mkRange 0 0 0 100 ) (Just cmd) Nothing ]
59
+ responder $ Right $ InL rsp
54
60
pure ()
55
61
Right _ ->
56
- sendNotification SWindowShowMessage (ShowMessageParams MtInfo " Not turning on code lenses" )
62
+ sendNotification SMethod_WindowShowMessage (ShowMessageParams MessageType_Info " Not turning on code lenses" )
57
63
Left err ->
58
- sendNotification SWindowShowMessage (ShowMessageParams MtError $ " Something went wrong!\n " <> T. pack (show err))
59
- pure ()
60
- , requestHandler STextDocumentHover $ \ req responder -> do
61
- let RequestMessage _ _ _ (HoverParams _doc pos _workDone) = req
62
- Position _l _c' = pos
63
- rsp = Hover ms (Just range)
64
- ms = HoverContents $ markedUpContent " lsp-demo-simple-server " " Hello world"
65
- range = Range pos pos
66
- responder (Right $ Just rsp)
67
- ]
64
+ sendNotification SMethod_WindowShowMessage (ShowMessageParams MessageType_Error $ " Something went wrong!\n " <> T. pack (show err))
65
+ pure ()
66
+ , requestHandler SMethod_TextDocumentHover $ \ req responder -> do
67
+ let TRequestMessage _ _ _ (HoverParams _doc pos _workDone) = req
68
+ Position _l _c' = pos
69
+ rsp = Hover ( InL ms) (Just range)
70
+ ms = mkMarkdown " Hello world"
71
+ range = Range pos pos
72
+ responder (Right $ InL rsp)
73
+ ]
68
74
69
75
main :: IO Int
70
- main = runServer $ ServerDefinition
71
- { onConfigurationChange = const $ pure $ Right ()
72
- , doInitialize = \ env _req -> pure $ Right env
73
- , staticHandlers = \ _caps -> handlers
74
- , interpretHandler = \ env -> Iso (runLspT env) liftIO
75
- , options = defaultOptions
76
- }
76
+ main =
77
+ runServer $
78
+ ServerDefinition
79
+ { parseConfig = const $ const $ Right ()
80
+ , onConfigChange = const $ pure ()
81
+ , defaultConfig = ()
82
+ , configSection = " demo"
83
+ , doInitialize = \ env _req -> pure $ Right env
84
+ , staticHandlers = \ _caps -> handlers
85
+ , interpretHandler = \ env -> Iso (runLspT env) liftIO
86
+ , options = defaultOptions
87
+ }
77
88
```
78
89
79
90
Whilst ` Reactor.hs ` shows how a reactor design can be used to handle all
0 commit comments