LSP highlights the first 5 characters

file.lsptest

@@ -0,0 +1 @@
+FIVE letters at the start of the document are highlighted

nvim-setup.lua

@@ -1,2 +1,10 @@
-vim.lsp.config('geolog', { cmd = { './result/bin/geolog-lsp' } })
+vim.filetype.add({
+    extension = {
+        lsptest = "lsptest"
+    }
+})
+vim.lsp.config['geolog'] = {
+    cmd = { './result/bin/geolog-lsp' },
+    filetypes = { 'lsptest'}
+}
 vim.lsp.enable('geolog')

src/Main.hs

@@ -1,36 +1,16 @@
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 import Control.Monad.IO.Class
-import Data.Text qualified as T
 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 $ \_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 = [CodeLens (mkRange 0 0 0 100) (Just cmd) Nothing]
-                        responder $ Right $ InL rsp
-                    pure ()
-                Right _ ->
-                    sendNotification SMethod_WindowShowMessage (ShowMessageParams MessageType_Info "Not turning on code lenses")
-                Left err ->
-                    sendNotification SMethod_WindowShowMessage (ShowMessageParams MessageType_Error $ "Something went wrong!\n" <> T.pack (show err))
-            pure ()
+        [ notificationHandler SMethod_Initialized $ \_ -> pure ()
         , requestHandler SMethod_TextDocumentHover $ \req responder -> do
             let TRequestMessage _ _ _ (HoverParams _doc pos _workDone) = req
                 Position _l _c' = pos
@@ -38,6 +18,23 @@ handlers =
                 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
@@ -49,7 +46,18 @@ main =
             , defaultConfig = ()
             , configSection = "demo"
             , doInitialize = \env _req -> pure $ Right env
-            , staticHandlers = \_caps -> handlers
+            , staticHandlers = const handlers
             , interpretHandler = \env -> Iso (runLspT env) liftIO
-            , options = defaultOptions
+            , options =
+                defaultOptions
+                    { optTextDocumentSync =
+                        Just $
+                            TextDocumentSyncOptions
+                                { _openClose = Just True
+                                , _change = Just TextDocumentSyncKind_Full
+                                , _willSave = Just False
+                                , _willSaveWaitUntil = Just False
+                                , _save = Just (InR (SaveOptions (Just False)))
+                                }
+                    }
             }