diff --git a/geolog-lsp.cabal b/geolog-lsp.cabal index 35c0c86..adb0336 100644 --- a/geolog-lsp.cabal +++ b/geolog-lsp.cabal @@ -15,13 +15,20 @@ extra-doc-files: CHANGELOG.md common warnings ghc-options: -Wall +common extensions + default-extensions: + OverloadedRecordDot + executable geolog-lsp - import: warnings + import: warnings, extensions main-is: Main.hs -- other-modules: -- other-extensions: - build-depends: base, + build-depends: + base, lsp, - text + text, + containers, + lens hs-source-dirs: src default-language: GHC2024 diff --git a/src/Main.hs b/src/Main.hs index ca494e6..c930065 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,37 +1,39 @@ -{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} +import Control.Lens ((^.)) import Control.Monad.IO.Class +import Data.Either (fromRight) +import Data.Maybe (fromJust) +import Language.LSP.Protocol.Lens (params, textDocument, uri) import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import Language.LSP.Server -import Data.Either (fromRight) +import Language.LSP.VFS (virtualFileText) handlers :: Handlers (LspM ()) handlers = mconcat [ notificationHandler SMethod_Initialized $ \_ -> pure () , requestHandler SMethod_TextDocumentHover $ \req responder -> do - let TRequestMessage _ _ _ (HoverParams _doc pos _workDone) = req + let + docUri = toNormalizedUri $ req ^. (params . textDocument . uri) + TRequestMessage _ _ _ (HoverParams _doc pos _workDone) = req Position _l _c' = pos - rsp = Hover (InL ms) (Just range) - ms = mkMarkdown "Hello world" + rsp txt = Hover (InL . mkMarkdown $ txt) (Just range) range = Range pos pos - responder (Right $ InL rsp) + c <- fromJust <$> getVirtualFile docUri + responder (Right . InL . rsp . virtualFileText $ c) , 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 = [] - } + docUri = toNormalizedUri $ req ^. (params . textDocument . uri) + token = + SemanticTokenAbsolute + { _line = 0 + , _startChar = 0 + , _length = 5 + , _tokenType = SemanticTokenTypes_Keyword + , _tokenModifiers = [] + } tokens = fromRight (error "failed") $ makeSemanticTokens defaultSemanticTokensLegend [token] responder (Right $ InL tokens)