X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=test%2Fdummy-server%2FMain.hs;h=6beee8bb3ecc17aacd43fe4783dc6dca1eb38b71;hb=a3f3199c221524124aeabce9a91e73655800a862;hp=5ecf12645bc0ccf1702b213bd01677a0062393d5;hpb=84e2707604b3a64c00062104fa40e2ea76040155;p=lsp-test.git

diff --git a/test/dummy-server/Main.hs b/test/dummy-server/Main.hs
index 5ecf126..6beee8b 100644
--- a/test/dummy-server/Main.hs
+++ b/test/dummy-server/Main.hs
@@ -1,15 +1,14 @@
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeInType #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 import Control.Monad
 import Control.Monad.Reader
-import Data.Aeson
-import Data.Default
+import Data.Aeson hiding (defaultOptions)
 import qualified Data.HashMap.Strict as HM
 import Data.List (isSuffixOf)
-import Language.Haskell.LSP.Control
-import Language.Haskell.LSP.Core
-import Language.Haskell.LSP.Types
+import Data.String
+import Language.LSP.Server
+import Language.LSP.Types
 import System.Directory
 import System.FilePath
 import UnliftIO
@@ -17,18 +16,16 @@ import UnliftIO.Concurrent
 
 main = do
   handlerEnv <- HandlerEnv <$> newEmptyMVar <*> newEmptyMVar
-  let initCbs =
-        InitializeCallbacks
+  runServer $ ServerDefinition
     { doInitialize = \env _req -> pure $ Right env,
       onConfigurationChange = const $ pure $ Right (),
       staticHandlers = handlers,
       interpretHandler = \env ->
         Iso
           (\m -> runLspT env (runReaderT m handlerEnv))
-                liftIO
+          liftIO,
+      options = defaultOptions {executeCommandCommands = Just ["doAnEdit"]}
     }
-      options = def {executeCommandCommands = Just ["doAnEdit"]}
-  run initCbs options
 
 data HandlerEnv = HandlerEnv
   { relRegToken :: MVar (RegistrationToken WorkspaceDidChangeWatchedFiles),
@@ -41,14 +38,14 @@ handlers =
     [ notificationHandler SInitialized $
         \_noti ->
           sendNotification SWindowLogMessage $
-            LogMessageParams MtLog "initialized",
-      requestHandler STextDocumentHover $
+            LogMessageParams MtLog "initialized"
+    , requestHandler STextDocumentHover $
         \_req responder ->
           responder $
             Right $
               Just $
-                Hover (HoverContents (MarkupContent MkPlainText "hello")) Nothing,
-      requestHandler STextDocumentDocumentSymbol $
+                Hover (HoverContents (MarkupContent MkPlainText "hello")) Nothing
+    , requestHandler STextDocumentDocumentSymbol $
         \_req responder ->
           responder $
             Right $
@@ -62,8 +59,8 @@ handlers =
                       (mkRange 0 0 3 6)
                       (mkRange 0 0 3 6)
                       Nothing
-                  ],
-      notificationHandler STextDocumentDidOpen $
+                  ]
+     , notificationHandler STextDocumentDidOpen $
         \noti -> do
           let NotificationMessage _ _ (DidOpenTextDocumentParams doc) = noti
               TextDocumentItem uri _ _ _ = doc
@@ -110,7 +107,7 @@ handlers =
                         DidChangeWatchedFilesRegistrationOptions $
                           List
                             [ FileSystemWatcher
-                                (curDir </> "*.watch")
+                                (fromString $ curDir </> "*.watch")
                                 (Just (WatchKind True True True))
                             ]
                   Just token <- runInIO $
@@ -127,8 +124,8 @@ handlers =
               when (".unregister.abs" `isSuffixOf` fp) $
                 do
                   Just token <- runInIO $ asks absRegToken >>= tryReadMVar
-                  runInIO $ unregisterCapability token,
-      requestHandler SWorkspaceExecuteCommand $ \req resp -> do
+                  runInIO $ unregisterCapability token
+     , requestHandler SWorkspaceExecuteCommand $ \req resp -> do
         let RequestMessage _ _ _ (ExecuteCommandParams Nothing "doAnEdit" (Just (List [val]))) = req
             Success docUri = fromJSON val
             edit = List [TextEdit (mkRange 0 0 0 5) "howdy"]
@@ -136,8 +133,8 @@ handlers =
               ApplyWorkspaceEditParams (Just "Howdy edit") $
                 WorkspaceEdit (Just (HM.singleton docUri edit)) Nothing
         resp $ Right Null
-        void $ sendRequest SWorkspaceApplyEdit params (const (pure ())),
-      requestHandler STextDocumentCodeAction $ \req resp -> do
+        void $ sendRequest SWorkspaceApplyEdit params (const (pure ()))
+     , requestHandler STextDocumentCodeAction $ \req resp -> do
         let RequestMessage _ _ _ params = req
             CodeActionParams _ _ _ _ cactx = params
             CodeActionContext diags _ = cactx
@@ -149,9 +146,10 @@ handlers =
                 (Just (List [d]))
                 Nothing
                 Nothing
+                Nothing
                 (Just (Command "" "deleteThis" Nothing))
-        resp $ Right $ InR <$> codeActions,
-      requestHandler STextDocumentCompletion $ \_req resp -> do
+        resp $ Right $ InR <$> codeActions
+     , requestHandler STextDocumentCompletion $ \_req resp -> do
         let res = CompletionList True (List [item])
             item =
               CompletionItem