64 lines
2.5 KiB
Haskell
64 lines
2.5 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
import Control.Monad.IO.Class
|
|
import Language.LSP.Protocol.Message
|
|
import Language.LSP.Protocol.Types
|
|
import Language.LSP.Server
|
|
import Data.Either (fromRight)
|
|
|
|
handlers :: Handlers (LspM ())
|
|
handlers =
|
|
mconcat
|
|
[ notificationHandler SMethod_Initialized $ \_ -> 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)
|
|
, requestHandler SMethod_TextDocumentSemanticTokensFull $ \req responder -> do
|
|
let TRequestMessage _ _ _ (SemanticTokensParams _doc _workDone _partial) = req
|
|
|
|
-- Each token is encoded as 5 uints:
|
|
-- [deltaLine, deltaStartChar, length, tokenTypeIndex, tokenModifiersBitset]
|
|
-- This example returns a single token at (0,0) of length 5.
|
|
let -- tokenTypeIndex=0 is "whatever the legend's 0 is"
|
|
token = SemanticTokenAbsolute {
|
|
_line = 0,
|
|
_startChar = 0,
|
|
_length = 5,
|
|
_tokenType = SemanticTokenTypes_Keyword,
|
|
_tokenModifiers = []
|
|
}
|
|
tokens = fromRight (error "failed") $ makeSemanticTokens defaultSemanticTokensLegend [token]
|
|
|
|
responder (Right $ InL tokens)
|
|
]
|
|
|
|
main :: IO Int
|
|
main =
|
|
runServer $
|
|
ServerDefinition
|
|
{ parseConfig = const $ const $ Right ()
|
|
, onConfigChange = const $ pure ()
|
|
, defaultConfig = ()
|
|
, configSection = "demo"
|
|
, doInitialize = \env _req -> pure $ Right env
|
|
, staticHandlers = const handlers
|
|
, interpretHandler = \env -> Iso (runLspT env) liftIO
|
|
, options =
|
|
defaultOptions
|
|
{ optTextDocumentSync =
|
|
Just $
|
|
TextDocumentSyncOptions
|
|
{ _openClose = Just True
|
|
, _change = Just TextDocumentSyncKind_Full
|
|
, _willSave = Just False
|
|
, _willSaveWaitUntil = Just False
|
|
, _save = Just (InR (SaveOptions (Just False)))
|
|
}
|
|
}
|
|
}
|