Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update example code in README.md #590

Merged
merged 1 commit into from
Jun 9, 2024
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
77 changes: 44 additions & 33 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -30,50 +30,61 @@ typescript definitions laid out in the specification
There are two example language servers in the `lsp/example/` folder. `Simple.hs` provides a minimal example:

```haskell
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

import Language.LSP.Server
import Language.LSP.Types
import Control.Monad.IO.Class
import qualified Data.Text as T
import Data.Text qualified as T
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
import Language.LSP.Server

handlers :: Handlers (LspM ())
handlers = mconcat
[ notificationHandler SInitialized $ \_not -> do
let params = ShowMessageRequestParams MtInfo "Turn on code lenses?"
(Just [MessageActionItem "Turn on", MessageActionItem "Don't"])
_ <- sendRequest SWindowShowMessageRequest params $ \res ->
case res of
Right (Just (MessageActionItem "Turn on")) -> do
let regOpts = CodeLensRegistrationOptions Nothing Nothing (Just False)

_ <- registerCapability STextDocumentCodeLens regOpts $ \_req responder -> do
handlers =
mconcat
[ notificationHandler SMethod_Initialized $ \_not -> do
let params =
ShowMessageRequestParams
MessageType_Info
"Turn on code lenses?"
(Just [MessageActionItem "Turn on", MessageActionItem "Don't"])
_ <- sendRequest SMethod_WindowShowMessageRequest params $ \case
Right (InL (MessageActionItem "Turn on")) -> do
let regOpts = CodeLensRegistrationOptions (InR Null) Nothing (Just False)

_ <- registerCapability mempty SMethod_TextDocumentCodeLens regOpts $ \_req responder -> do
let cmd = Command "Say hello" "lsp-hello-command" Nothing
rsp = List [CodeLens (mkRange 0 0 0 100) (Just cmd) Nothing]
responder (Right rsp)
rsp = [CodeLens (mkRange 0 0 0 100) (Just cmd) Nothing]
responder $ Right $ InL rsp
pure ()
Right _ ->
sendNotification SWindowShowMessage (ShowMessageParams MtInfo "Not turning on code lenses")
sendNotification SMethod_WindowShowMessage (ShowMessageParams MessageType_Info "Not turning on code lenses")
Left err ->
sendNotification SWindowShowMessage (ShowMessageParams MtError $ "Something went wrong!\n" <> T.pack (show err))
pure ()
, requestHandler STextDocumentHover $ \req responder -> do
let RequestMessage _ _ _ (HoverParams _doc pos _workDone) = req
Position _l _c' = pos
rsp = Hover ms (Just range)
ms = HoverContents $ markedUpContent "lsp-demo-simple-server" "Hello world"
range = Range pos pos
responder (Right $ Just rsp)
]
sendNotification SMethod_WindowShowMessage (ShowMessageParams MessageType_Error $ "Something went wrong!\n" <> T.pack (show err))
pure ()
, requestHandler SMethod_TextDocumentHover $ \req responder -> do
let TRequestMessage _ _ _ (HoverParams _doc pos _workDone) = req
Position _l _c' = pos
rsp = Hover (InL ms) (Just range)
ms = mkMarkdown "Hello world"
range = Range pos pos
responder (Right $ InL rsp)
]

main :: IO Int
main = runServer $ ServerDefinition
{ onConfigurationChange = const $ pure $ Right ()
, doInitialize = \env _req -> pure $ Right env
, staticHandlers = \_caps -> handlers
, interpretHandler = \env -> Iso (runLspT env) liftIO
, options = defaultOptions
}
main =
runServer $
ServerDefinition
{ parseConfig = const $ const $ Right ()
, onConfigChange = const $ pure ()
, defaultConfig = ()
, configSection = "demo"
, doInitialize = \env _req -> pure $ Right env
, staticHandlers = \_caps -> handlers
, interpretHandler = \env -> Iso (runLspT env) liftIO
, options = defaultOptions
}
```

Whilst `Reactor.hs` shows how a reactor design can be used to handle all
Expand Down
Loading