packages: .
+ ./example
flags: +DummyServer
test-show-details: direct
haddock-quickjump: True
source-repository-package
type: git
- location: https://github.com/alanz/haskell-lsp.git
- tag: 9dc38a36be7f1b316eff5dcf223a96d02c3ac6fd
+ location: https://github.com/alanz/lsp.git
+ tag: fd92be6d65f82f098cc0576e7e2200e38fb1cf94
subdir: .
- haskell-lsp-types
+ lsp-types
import Language.Haskell.LSP.Test
import Language.Haskell.LSP.Types
-main = runSession "hie" fullCaps "../test/data/" $ do
- docItem <- openDoc "Rename.hs" "haskell"
+main = runSession "haskell-language-server" fullCaps "../test/data/" $ do
+ doc <- openDoc "Rename.hs" "haskell"
-- Use your favourite favourite combinators.
skipManyTill loggingNotification (count 2 publishDiagnosticsNotification)
-- Send requests and notifications and receive responses
- let params = DocumentSymbolParams docItem
- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
+ rsp <- request STextDocumentDocumentSymbol $
+ DocumentSymbolParams Nothing Nothing doc
liftIO $ print rsp
-- Or use one of the helper functions
- getDocumentSymbols docItem >>= liftIO . print
+ getDocumentSymbols doc >>= liftIO . print
--- /dev/null
+cradle:
+ multi:
+ - path: "./test/data/"
+ config: { cradle: { none: } }
+ - path: "./example/"
+ config: { cradle: { none: } }
+ - path: "./"
+ config:
+ cradle:
+ cabal:
+ - path: "src"
+ component: "lib:lsp-test"
+ - path: "test/dummy-server"
+ component: "exe:dummy-server"
+ - path: "test"
+ component: "test:tests"
cabal-version: 2.0
extra-source-files: README.md
, ChangeLog.md
-tested-with: GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1
+tested-with: GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1, GHC == 8.10.2
source-repository head
type: git
library
hs-source-dirs: src
exposed-modules: Language.Haskell.LSP.Test
- , Language.Haskell.LSP.Test.Replay
- reexported-modules: haskell-lsp:Language.Haskell.LSP.Types
- , haskell-lsp:Language.Haskell.LSP.Types.Capabilities
+ reexported-modules: lsp-types:Language.Haskell.LSP.Types
+ , lsp-types:Language.Haskell.LSP.Types.Capabilities
, parser-combinators:Control.Applicative.Combinators
default-language: Haskell2010
build-depends: base >= 4.10 && < 5
- , haskell-lsp >= 0.22 && < 0.24
+ , lsp-types == 1.0.*
, aeson
, time
, aeson-pretty
hs-source-dirs: test/dummy-server
ghc-options: -W
build-depends: base >= 4.10 && < 5
- , haskell-lsp >= 0.23 && < 0.24
+ , lsp == 1.0.*
, data-default
, aeson
, unordered-containers
, directory
, filepath
+ , unliftio
+ , mtl
default-language: Haskell2010
scope: private
if !flag(DummyServer)
build-depends: base >= 4.10 && < 5
, hspec
, lens
- , haskell-lsp >= 0.22 && < 0.24
+ , lsp-types == 1.0.*
, lsp-test
, data-default
, aeson
show (UnexpectedMessage expected lastMsg) =
"Received an unexpected message from the server:\n" ++
"Was parsing: " ++ expected ++ "\n" ++
- "Last message received:\n" ++ B.unpack (encodePretty lastMsg)
+ "But the last message received was:\n" ++ B.unpack (encodePretty lastMsg)
show (ReplayOutOfOrder received expected) =
let expected' = nub expected
getJsonDiff = lines . B.unpack . encodePretty
satisfy
, satisfyMaybe
, message
+ , response
, responseForId
, customRequest
, customNotification
import Control.Applicative
import Control.Concurrent
-import Control.Lens
import Control.Monad.IO.Class
import Control.Monad
import Data.Conduit.Parser hiding (named)
import qualified Data.Conduit.Parser (named)
-import Data.GADT.Compare
import qualified Data.Text as T
import Data.Typeable
import Language.Haskell.LSP.Types
named :: T.Text -> Session a -> Session a
named s (Session x) = Session (Data.Conduit.Parser.named s x)
-mEq :: SServerMethod m1 -> SServerMethod m2 -> Maybe (m1 :~~: m2)
-mEq m1 m2 = case (splitServerMethod m1, splitServerMethod m2) of
- (IsServerNot, IsServerNot) -> do
- Refl <- geq m1 m2
- pure HRefl
- (IsServerReq, IsServerReq) -> do
- Refl <- geq m1 m2
- pure HRefl
- _ -> Nothing
-
-mEqClient :: SClientMethod m1 -> SClientMethod m2 -> Maybe (m1 :~~: m2)
-mEqClient m1 m2 = case (splitClientMethod m1, splitClientMethod m2) of
- (IsClientNot, IsClientNot) -> do
- Refl <- geq m1 m2
- pure HRefl
- (IsClientReq, IsClientReq) -> do
- Refl <- geq m1 m2
- pure HRefl
- _ -> Nothing
--- | Matches non-custom messages
+-- | Matches a request or a notification coming from the server.
message :: SServerMethod m -> Session (ServerMessage m)
message m1 = named (T.pack $ show m1) $ satisfyMaybe $ \case
FromServerMess m2 msg -> do
- HRefl <- mEq m1 m2
+ HRefl <- mEqServer m1 m2
pure msg
_ -> Nothing
FromServerMess _ _ -> False
FromServerRsp _ _ -> True
--- | Matches a response for a specific id.
+-- | Matches a response coming from the server.
+response :: SMethod (m :: Method FromClient Request) -> Session (ResponseMessage m)
+response m1 = named (T.pack $ show m1) $ satisfyMaybe $ \case
+ FromServerRsp m2 msg -> do
+ HRefl <- mEqClient m1 m2
+ pure msg
+ _ -> Nothing
+
+-- | Like 'response', but matches a response for a specific id.
responseForId :: SMethod (m :: Method FromClient Request) -> LspId m -> Session (ResponseMessage m)
responseForId m lid = named (T.pack $ "Response for id: " ++ show lid) $ do
satisfyMaybe $ \msg -> do
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
import Control.Monad.IO.Class
import Control.Monad
import Control.Lens hiding (List)
-import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.Test
import Language.Haskell.LSP.Types
import Language.Haskell.LSP.Types.Lens hiding
import System.Directory
import System.FilePath
import System.Timeout
+import Data.Type.Equality
{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
{-# ANN module ("HLint: ignore Unnecessary hiding" :: String) #-}
-- won't receive a request - will timeout
-- incoming logging requests shouldn't increase the
-- timeout
- withTimeout 5 $ skipManyTill anyMessage message :: Session ApplyWorkspaceEditRequest
+ withTimeout 5 $ skipManyTill anyMessage (message SWorkspaceApplyEdit) :: Session ApplyWorkspaceEditRequest
-- wait just a bit longer than 5 seconds so we have time
-- to open the document
in timeout 6000000 sesh `shouldThrow` anySessionException
withTimeout 10 $ liftIO $ threadDelay 7000000
getDocumentSymbols doc
-- should now timeout
- skipManyTill anyMessage message :: Session ApplyWorkspaceEditRequest
+ skipManyTill anyMessage (message SWorkspaceApplyEdit)
isTimeout (Timeout _) = True
isTimeout _ = False
in sesh `shouldThrow` isTimeout
it "throw on time out" $
let sesh = runSessionWithConfig (def {messageTimeout = 10}) serverExe fullCaps "test/data/renamePass" $ do
skipMany loggingNotification
- _ <- message :: Session ApplyWorkspaceEditRequest
+ _ <- message SWorkspaceApplyEdit
return ()
in sesh `shouldThrow` anySessionException
describe "UnexpectedMessageException" $ do
it "throws when there's an unexpected message" $
- let selector (UnexpectedMessage "Publish diagnostics notification" (NotLogMessage _)) = True
+ let selector (UnexpectedMessage "Publish diagnostics notification" (FromServerMess SWindowLogMessage _)) = True
selector _ = False
in runSession serverExe fullCaps "test/data/renamePass" publishDiagnosticsNotification `shouldThrow` selector
it "provides the correct types that were expected and received" $
- let selector (UnexpectedMessage "ResponseMessage WorkspaceEdit" (RspDocumentSymbols _)) = True
+ let selector (UnexpectedMessage "STextDocumentRename" (FromServerRsp STextDocumentDocumentSymbol _)) = True
selector _ = False
sesh = do
doc <- openDoc "Desktop/simple.hs" "haskell"
- sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing)
+ sendRequest STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc)
skipMany anyNotification
- message :: Session RenameResponse -- the wrong type
+ response STextDocumentRename -- the wrong type
in runSession serverExe fullCaps "test/data/renamePass" sesh
`shouldThrow` selector
- -- This is too fickle at the moment
- -- describe "replaySession" $
- -- it "passes a test" $
- -- replaySession serverExe "test/data/renamePass"
- -- it "fails a test" $
- -- let selector (ReplayOutOfOrder _ _) = True
- -- selector _ = False
- -- in replaySession serverExe "test/data/renameFail" `shouldThrow` selector
-
- -- describe "manual javascript session" $
- -- it "passes a test" $
- -- runSession "javascript-typescript-stdio" fullCaps "test/data/javascriptPass" $ do
- -- doc <- openDoc "test.js" "javascript"
-
- -- noDiagnostics
-
- -- Right (fooSymbol:_) <- getDocumentSymbols doc
-
- -- liftIO $ do
- -- fooSymbol ^. name `shouldBe` "foo"
- -- fooSymbol ^. kind `shouldBe` SkFunction
-
describe "text document VFS" $
it "sends back didChange notifications" $
runSession serverExe def "test/data/refactor" $ do
doc <- openDoc "Main.hs" "haskell"
let args = toJSON (doc ^. uri)
- reqParams = ExecuteCommandParams "doAnEdit" (Just (List [args])) Nothing
- request_ WorkspaceExecuteCommand reqParams
+ reqParams = ExecuteCommandParams Nothing "doAnEdit" (Just (List [args]))
+ request_ SWorkspaceExecuteCommand reqParams
- editReq <- message :: Session ApplyWorkspaceEditRequest
+ editReq <- message SWorkspaceApplyEdit
liftIO $ do
let (Just cs) = editReq ^. params . edit . changes
[(u, List es)] = HM.toList cs
doc <- openDoc "Main.hs" "haskell"
let args = toJSON (doc ^. uri)
- reqParams = ExecuteCommandParams "doAnEdit" (Just (List [args])) Nothing
- request_ WorkspaceExecuteCommand reqParams
+ reqParams = ExecuteCommandParams Nothing "doAnEdit" (Just (List [args]))
+ request_ SWorkspaceExecuteCommand reqParams
contents <- getDocumentEdit doc
liftIO $ contents `shouldBe` "howdy:: IO Int\nmain = return (42)\n"
it "works" $ runSession serverExe fullCaps "test/data/refactor" $ do
doc <- openDoc "Main.hs" "haskell"
waitForDiagnostics
- [CACodeAction action] <- getCodeActions doc (Range (Position 1 14) (Position 1 18))
+ [InR action] <- getCodeActions doc (Range (Position 1 14) (Position 1 18))
liftIO $ action ^. title `shouldBe` "Delete this"
describe "getAllCodeActions" $
_ <- waitForDiagnostics
actions <- getAllCodeActions doc
liftIO $ do
- let [CACodeAction action] = actions
+ let [InR action] = actions
action ^. title `shouldBe` "Delete this"
action ^. command . _Just . command `shouldBe` "deleteThis"
describe "satisfy" $
it "works" $ runSession serverExe fullCaps "test/data" $ do
openDoc "Format.hs" "haskell"
- let pred (NotLogMessage _) = True
+ let pred (FromServerMess SWindowLogMessage _) = True
pred _ = False
void $ satisfy pred
void publishDiagnosticsNotification
describe "dynamic capabilities" $ do
+
it "keeps track" $ runSession serverExe fullCaps "test/data" $ do
loggingNotification -- initialized log message
createDoc ".register" "haskell" ""
- message :: Session RegisterCapabilityRequest
+ message SClientRegisterCapability
doc <- createDoc "Foo.watch" "haskell" ""
- NotLogMessage msg <- loggingNotification
+ msg <- message SWindowLogMessage
liftIO $ msg ^. params . LSP.message `shouldBe` "got workspace/didChangeWatchedFiles"
- caps <- getRegisteredCapabilities
- liftIO $ caps `shouldBe`
- [ Registration "0" WorkspaceDidChangeWatchedFiles $ Just $ toJSON $
- DidChangeWatchedFilesRegistrationOptions $ List
- [ FileSystemWatcher "*.watch" (Just (WatchKind True True True)) ]
- ]
+ [SomeRegistration (Registration _ regMethod regOpts)] <- getRegisteredCapabilities
+ liftIO $ do
+ case regMethod `mEqClient` SWorkspaceDidChangeWatchedFiles of
+ Just HRefl ->
+ regOpts `shouldBe` (DidChangeWatchedFilesRegistrationOptions $ List
+ [ FileSystemWatcher "*.watch" (Just (WatchKind True True True)) ])
+ Nothing -> expectationFailure "Registration wasn't on workspace/didChangeWatchedFiles"
-- now unregister it by sending a specific createDoc
createDoc ".unregister" "haskell" ""
- message :: Session UnregisterCapabilityRequest
+ message SClientUnregisterCapability
createDoc "Bar.watch" "haskell" ""
- void $ sendRequest TextDocumentHover $ TextDocumentPositionParams doc (Position 0 0) Nothing
+ void $ sendRequest STextDocumentHover $ HoverParams doc (Position 0 0) Nothing
count 0 $ loggingNotification
void $ anyResponse
loggingNotification -- initialized log message
createDoc ".register.abs" "haskell" ""
- message :: Session RegisterCapabilityRequest
+ message SClientRegisterCapability
doc <- createDoc (curDir </> "Foo.watch") "haskell" ""
- NotLogMessage msg <- loggingNotification
+ msg <- message SWindowLogMessage
liftIO $ msg ^. params . LSP.message `shouldBe` "got workspace/didChangeWatchedFiles"
-- now unregister it by sending a specific createDoc
createDoc ".unregister.abs" "haskell" ""
- message :: Session UnregisterCapabilityRequest
+ message SClientUnregisterCapability
createDoc (curDir </> "Bar.watch") "haskell" ""
- void $ sendRequest TextDocumentHover $ TextDocumentPositionParams doc (Position 0 0) Nothing
+ void $ sendRequest STextDocumentHover $ HoverParams doc (Position 0 0) Nothing
count 0 $ loggingNotification
void $ anyResponse
-mkRange :: Int -> Int -> Int -> Int -> Range
-mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
-
didChangeCaps :: ClientCapabilities
didChangeCaps = def { _workspace = Just workspaceCaps }
where
docChangesCaps = def { _workspace = Just workspaceCaps }
where
workspaceCaps = def { _workspaceEdit = Just editCaps }
- editCaps = WorkspaceEditClientCapabilities (Just True)
+ editCaps = WorkspaceEditClientCapabilities (Just True) Nothing Nothing
findExeRecursive :: FilePath -> FilePath -> IO (Maybe FilePath)
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
+
+import Control.Monad
+import Control.Monad.Reader
import Data.Aeson
import Data.Default
-import Data.List (isSuffixOf)
import qualified Data.HashMap.Strict as HM
-import Language.Haskell.LSP.Core
+import Data.List (isSuffixOf)
import Language.Haskell.LSP.Control
-import Language.Haskell.LSP.Messages
+import Language.Haskell.LSP.Core
import Language.Haskell.LSP.Types
-import Control.Concurrent
-import Control.Monad
import System.Directory
import System.FilePath
+import UnliftIO
+import UnliftIO.Concurrent
main = do
- lfvar <- newEmptyMVar
- let initCbs = InitializeCallbacks
- { onInitialConfiguration = const $ Right ()
- , onConfigurationChange = const $ Right ()
- , onStartup = \lf -> do
- putMVar lfvar lf
-
- return Nothing
+ handlerEnv <- HandlerEnv <$> newEmptyMVar <*> newEmptyMVar
+ let initCbs =
+ InitializeCallbacks
+ { doInitialize = \env _req -> pure $ Right env,
+ onConfigurationChange = const $ pure $ Right (),
+ staticHandlers = handlers,
+ interpretHandler = \env ->
+ Iso
+ (\m -> runLspT env (runReaderT m handlerEnv))
+ liftIO
}
- options = def
- { executeCommandCommands = Just ["doAnEdit"]
+ options = def {executeCommandCommands = Just ["doAnEdit"]}
+ run initCbs options
+
+data HandlerEnv = HandlerEnv
+ { relRegToken :: MVar (RegistrationToken WorkspaceDidChangeWatchedFiles),
+ absRegToken :: MVar (RegistrationToken WorkspaceDidChangeWatchedFiles)
}
- run initCbs (handlers lfvar) options Nothing
-handlers :: MVar (LspFuncs ()) -> Handlers
-handlers lfvar = def
- { initializedHandler = pure $ \_ -> send $ NotLogMessage $ fmServerLogMessageNotification MtLog "initialized"
- , hoverHandler = pure $ \req -> send $
- RspHover $ makeResponseMessage req (Just (Hover (HoverContents (MarkupContent MkPlainText "hello")) Nothing))
- , documentSymbolHandler = pure $ \req -> send $
- RspDocumentSymbols $ makeResponseMessage req $ DSDocumentSymbols $
- List [ DocumentSymbol "foo"
+handlers :: Handlers (ReaderT HandlerEnv (LspM ()))
+handlers =
+ mconcat
+ [ notificationHandler SInitialized $
+ \_noti ->
+ sendNotification SWindowLogMessage $
+ LogMessageParams MtLog "initialized",
+ requestHandler STextDocumentHover $
+ \_req responder ->
+ responder $
+ Right $
+ Just $
+ Hover (HoverContents (MarkupContent MkPlainText "hello")) Nothing,
+ requestHandler STextDocumentDocumentSymbol $
+ \_req responder ->
+ responder $
+ Right $
+ InL $
+ List
+ [ DocumentSymbol
+ "foo"
Nothing
SkObject
Nothing
(mkRange 0 0 3 6)
(mkRange 0 0 3 6)
Nothing
- ]
- , didOpenTextDocumentNotificationHandler = pure $ \noti -> do
+ ],
+ notificationHandler STextDocumentDidOpen $
+ \noti -> do
let NotificationMessage _ _ (DidOpenTextDocumentParams doc) = noti
TextDocumentItem uri _ _ _ = doc
Just fp = uriToFilePath uri
- diag = Diagnostic (mkRange 0 0 0 1)
+ diag =
+ Diagnostic
+ (mkRange 0 0 0 1)
(Just DsWarning)
- (Just (NumberValue 42))
+ (Just (InL 42))
(Just "dummy-server")
"Here's a warning"
Nothing
Nothing
- when (".hs" `isSuffixOf` fp) $ void $ forkIO $ do
+ withRunInIO $
+ \runInIO -> do
+ when (".hs" `isSuffixOf` fp) $
+ void $
+ forkIO $
+ do
threadDelay (2 * 10 ^ 6)
- send $ NotPublishDiagnostics $
- fmServerPublishDiagnosticsNotification $ PublishDiagnosticsParams uri $ List [diag]
-
+ runInIO $
+ sendNotification STextDocumentPublishDiagnostics $
+ PublishDiagnosticsParams uri Nothing (List [diag])
-- also act as a registerer for workspace/didChangeWatchedFiles
- when (".register" `isSuffixOf` fp) $ do
- reqId <- readMVar lfvar >>= getNextReqId
- send $ ReqRegisterCapability $ fmServerRegisterCapabilityRequest reqId $
- RegistrationParams $ List $
- [ Registration "0" WorkspaceDidChangeWatchedFiles $ Just $ toJSON $
- DidChangeWatchedFilesRegistrationOptions $ List
- [ FileSystemWatcher "*.watch" (Just (WatchKind True True True)) ]
+ when (".register" `isSuffixOf` fp) $
+ do
+ let regOpts =
+ DidChangeWatchedFilesRegistrationOptions $
+ List
+ [ FileSystemWatcher
+ "*.watch"
+ (Just (WatchKind True True True))
]
- when (".register.abs" `isSuffixOf` fp) $ do
+ Just token <- runInIO $
+ registerCapability SWorkspaceDidChangeWatchedFiles regOpts $
+ \_noti ->
+ sendNotification SWindowLogMessage $
+ LogMessageParams MtLog "got workspace/didChangeWatchedFiles"
+ runInIO $ asks relRegToken >>= \v -> putMVar v token
+ when (".register.abs" `isSuffixOf` fp) $
+ do
curDir <- getCurrentDirectory
- reqId <- readMVar lfvar >>= getNextReqId
- send $ ReqRegisterCapability $ fmServerRegisterCapabilityRequest reqId $
- RegistrationParams $ List $
- [ Registration "1" WorkspaceDidChangeWatchedFiles $ Just $ toJSON $
- DidChangeWatchedFilesRegistrationOptions $ List
- [ FileSystemWatcher (curDir </> "*.watch") (Just (WatchKind True True True)) ]
+ let regOpts =
+ DidChangeWatchedFilesRegistrationOptions $
+ List
+ [ FileSystemWatcher
+ (curDir </> "*.watch")
+ (Just (WatchKind True True True))
]
-
+ Just token <- runInIO $
+ registerCapability SWorkspaceDidChangeWatchedFiles regOpts $
+ \_noti ->
+ sendNotification SWindowLogMessage $
+ LogMessageParams MtLog "got workspace/didChangeWatchedFiles"
+ runInIO $ asks absRegToken >>= \v -> putMVar v token
-- also act as an unregisterer for workspace/didChangeWatchedFiles
- when (".unregister" `isSuffixOf` fp) $ do
- reqId <- readMVar lfvar >>= getNextReqId
- send $ ReqUnregisterCapability $ fmServerUnregisterCapabilityRequest reqId $
- UnregistrationParams $ List [ Unregistration "0" "workspace/didChangeWatchedFiles" ]
- when (".unregister.abs" `isSuffixOf` fp) $ do
- reqId <- readMVar lfvar >>= getNextReqId
- send $ ReqUnregisterCapability $ fmServerUnregisterCapabilityRequest reqId $
- UnregistrationParams $ List [ Unregistration "1" "workspace/didChangeWatchedFiles" ]
- , executeCommandHandler = pure $ \req -> do
- send $ RspExecuteCommand $ makeResponseMessage req Null
- reqId <- readMVar lfvar >>= getNextReqId
- let RequestMessage _ _ _ (ExecuteCommandParams "doAnEdit" (Just (List [val])) _) = req
+ when (".unregister" `isSuffixOf` fp) $
+ do
+ Just token <- runInIO $ asks relRegToken >>= tryReadMVar
+ runInIO $ unregisterCapability token
+ when (".unregister.abs" `isSuffixOf` fp) $
+ do
+ Just token <- runInIO $ asks absRegToken >>= tryReadMVar
+ 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"]
- send $ ReqApplyWorkspaceEdit $ fmServerApplyWorkspaceEditRequest reqId $
- ApplyWorkspaceEditParams $ WorkspaceEdit (Just (HM.singleton docUri edit))
- Nothing
- , codeActionHandler = pure $ \req -> do
+ params =
+ 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
let RequestMessage _ _ _ params = req
- CodeActionParams _ _ cactx _ = params
+ CodeActionParams _ _ _ _ cactx = params
CodeActionContext diags _ = cactx
- caresults = fmap diag2caresult diags
- diag2caresult d = CACodeAction $
- CodeAction "Delete this"
+ codeActions = fmap diag2ca diags
+ diag2ca d =
+ CodeAction
+ "Delete this"
Nothing
(Just (List [d]))
Nothing
+ Nothing
(Just (Command "" "deleteThis" Nothing))
- send $ RspCodeAction $ makeResponseMessage req caresults
- , didChangeWatchedFilesNotificationHandler = pure $ \_ ->
- send $ NotLogMessage $ fmServerLogMessageNotification MtLog "got workspace/didChangeWatchedFiles"
- , completionHandler = pure $ \req -> do
- let res = CompletionList (CompletionListType False (List [item]))
+ resp $ Right $ InR <$> codeActions,
+ requestHandler STextDocumentCompletion $ \_req resp -> do
+ let res = CompletionList True (List [item])
item =
- CompletionItem "foo" (Just CiConstant) (Just (List [])) Nothing
- Nothing Nothing Nothing Nothing Nothing Nothing Nothing
- Nothing Nothing Nothing Nothing Nothing
- send $ RspCompletion $ makeResponseMessage req res
- }
- where send msg = readMVar lfvar >>= \lf -> (sendFunc lf) msg
-
-mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
+ CompletionItem
+ "foo"
+ (Just CiConstant)
+ (Just (List []))
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ resp $ Right $ InR res
+ ]
projects / lsp-test.git / commitdiff