haskell-lsp (empty) → 0.1.0.0
raw patch · 21 files changed
+7219/−0 lines, 21 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, containers, data-default, directory, filepath, hashable, haskell-lsp, hslogger, hspec, lens, mtl, parsec, stm, text, time, transformers, unordered-containers, vector, yi-rope
Files
- ChangeLog.md +6/−0
- LICENSE +20/−0
- README.md +52/−0
- Setup.hs +2/−0
- example/Main.hs +368/−0
- haskell-lsp.cabal +115/−0
- src/Language/Haskell/LSP/Constant.hs +12/−0
- src/Language/Haskell/LSP/Control.hs +117/−0
- src/Language/Haskell/LSP/Core.hs +592/−0
- src/Language/Haskell/LSP/Diagnostics.hs +89/−0
- src/Language/Haskell/LSP/Messages.hs +311/−0
- src/Language/Haskell/LSP/TH/ClientCapabilities.hs +641/−0
- src/Language/Haskell/LSP/TH/Constants.hs +17/−0
- src/Language/Haskell/LSP/TH/DataTypesJSON.hs +4164/−0
- src/Language/Haskell/LSP/Utility.hs +59/−0
- src/Language/Haskell/LSP/VFS.hs +181/−0
- test/DiagnosticsSpec.hs +187/−0
- test/Main.hs +22/−0
- test/MethodSpec.hs +89/−0
- test/Spec.hs +9/−0
- test/VspSpec.hs +166/−0
+ ChangeLog.md view
@@ -0,0 +1,6 @@+# Revision history for haskell-lsp++## 0.1.0.0 -- 2017-07-19++* First version. Implements version 3 of the Microsoft Language+ Server Protocol
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Alan Zimmerman++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,52 @@+# haskell-lsp+Haskell library for the Microsoft Language Server Protocol++Warning: this library and its associated ecosystem is under development at the+moment. So do not have high expectations, it is not ready for casual use.++## Hacking++To see this library in use you need to install the [haskell-ide-engine](https://github.com/alanz/haskell-ide-engine/)++ git clone https://github.com/alanz/haskell-ide-engine+ cd haskell-ide-engine+ stack install++This will put the `hie` executable in your path.++Then, run the plugin in vscode:++ git clone https://github.com/alanz/vscode-hie-server+ cd vscode-hie-server+ code .++In vscode, press F5 to run the extension in development mode.++You can see a log from `hie` by doing++ tail -F /tmp/hie-vscode.log++There are also facilities on the code to send back language-server-protocol log+and show events.++It can also be used with emacs, see https://github.com/emacs-lsp/lsp-haskell++## Using the example server++ stack install++will generate a `lsp-hello` executable.++Changing the server to be called in the [`vscode-hie-server`](https://github.com/alanz/vscode-hie-server/blob/master/hie-vscode.sh#L21) plugin from `hie` to+`lsp-hello` will run the example server instead of hie.++Likewise, changing the executable in `lsp-haskell` for emacs.++## Useful links++- https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md++## Other resource++See #haskell-ide-engine on IRC freenode+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/Main.hs view
@@ -0,0 +1,368 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main (main) where++import Control.Concurrent+import Control.Concurrent.STM.TChan+import qualified Control.Exception as E+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.STM+import Control.Monad.State+import Control.Monad.Reader+import qualified Data.Aeson as J+import Data.Default+import qualified Data.HashMap.Strict as H+import Data.Monoid+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified Language.Haskell.LSP.Control as CTRL+import qualified Language.Haskell.LSP.Core as Core+import Language.Haskell.LSP.Diagnostics+import Language.Haskell.LSP.Messages+import qualified Language.Haskell.LSP.TH.DataTypesJSON as J+import qualified Language.Haskell.LSP.Utility as U+import Language.Haskell.LSP.VFS+import System.Exit+import qualified System.Log.Logger as L+import qualified Yi.Rope as Yi+import Control.Lens+++-- ---------------------------------------------------------------------+{-# ANN module ("HLint: ignore Eta reduce" :: String) #-}+{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+-- ---------------------------------------------------------------------+--++main :: IO ()+main = do+ run (return ()) >>= \case+ 0 -> exitSuccess+ c -> exitWith . ExitFailure $ c++-- ---------------------------------------------------------------------++run :: IO () -> IO Int+run dispatcherProc = flip E.catches handlers $ do++ rin <- atomically newTChan :: IO (TChan ReactorInput)++ let+ dp lf = do+ liftIO $ U.logs $ "main.run:dp entered"+ _rpid <- forkIO $ reactor lf def rin+ liftIO $ U.logs $ "main.run:dp tchan"+ dispatcherProc+ liftIO $ U.logs $ "main.run:dp after dispatcherProc"+ return Nothing++ flip E.finally finalProc $ do+ Core.setupLogger "/tmp/lsp-hello.log" [] L.DEBUG+ CTRL.run dp (lspHandlers rin) lspOptions++ where+ handlers = [ E.Handler ioExcept+ , E.Handler someExcept+ ]+ finalProc = L.removeAllHandlers+ ioExcept (e :: E.IOException) = print e >> return 1+ someExcept (e :: E.SomeException) = print e >> return 1++-- ---------------------------------------------------------------------++-- The reactor is a process that serialises and buffers all requests from the+-- LSP client, so they can be sent to the backend compiler one at a time, and a+-- reply sent.++data ReactorInput+ = HandlerRequest Core.OutMessage+ -- ^ injected into the reactor input by each of the individual callback handlers++data ReactorState =+ ReactorState+ { lspReqId :: !J.LspId -- ^ unique ids for requests to the client+ }++instance Default ReactorState where+ def = ReactorState (J.IdInt 0)++-- ---------------------------------------------------------------------++-- | The monad used in the reactor+type R a = ReaderT Core.LspFuncs (StateT ReactorState IO) a++-- ---------------------------------------------------------------------+-- reactor monad functions+-- ---------------------------------------------------------------------++-- ---------------------------------------------------------------------++reactorSend :: (J.ToJSON a) => a -> R ()+reactorSend msg = do+ lf <- ask+ liftIO $ Core.sendFunc lf msg++-- ---------------------------------------------------------------------++publishDiagnostics :: J.Uri -> Maybe J.TextDocumentVersion -> DiagnosticsBySource -> R ()+publishDiagnostics uri mv diags = do+ lf <- ask+ liftIO $ (Core.publishDiagnosticsFunc lf) uri mv diags++-- ---------------------------------------------------------------------++nextLspReqId :: R J.LspId+nextLspReqId = do+ s <- get+ let i@(J.IdInt r) = lspReqId s+ put s { lspReqId = J.IdInt (r + 1) }+ return i++-- ---------------------------------------------------------------------++-- | The single point that all events flow through, allowing management of state+-- to stitch replies and requests together from the two asynchronous sides: lsp+-- server and backend compiler+reactor :: Core.LspFuncs -> ReactorState -> TChan ReactorInput -> IO ()+reactor lf st inp = do+ liftIO $ U.logs $ "reactor:entered"+ flip evalStateT st $ flip runReaderT lf $ forever $ do+ inval <- liftIO $ atomically $ readTChan inp+ case inval of++ -- Handle any response from a message originating at the server, such as+ -- "workspace/applyEdit"+ HandlerRequest (Core.RspFromClient rm) -> do+ liftIO $ U.logs $ "reactor:got RspFromClient:" ++ show rm++ -- -------------------------------++ HandlerRequest (Core.NotInitialized _notification) -> do+ liftIO $ U.logm $ "****** reactor: processing Initialized Notification"+ -- Server is ready, register any specific capabilities we need++ {-+ Example:+ {+ "method": "client/registerCapability",+ "params": {+ "registrations": [+ {+ "id": "79eee87c-c409-4664-8102-e03263673f6f",+ "method": "textDocument/willSaveWaitUntil",+ "registerOptions": {+ "documentSelector": [+ { "language": "javascript" }+ ]+ }+ }+ ]+ }+ }+ -}+ let+ registration = J.Registration "lsp-hello-registered" J.WorkspaceExecuteCommand Nothing+ let registrations = J.RegistrationParams (J.List [registration])+ rid <- nextLspReqId++ reactorSend $ fmServerRegisterCapabilityRequest rid registrations++ -- example of showMessageRequest+ let+ params = J.ShowMessageRequestParams J.MtWarning "choose an option for XXX"+ (Just [J.MessageActionItem "option a", J.MessageActionItem "option b"])+ rid1 <- nextLspReqId++ reactorSend $ fmServerShowMessageRequest rid1 params++ -- -------------------------------++ HandlerRequest (Core.NotDidOpenTextDocument notification) -> do+ liftIO $ U.logm $ "****** reactor: processing NotDidOpenTextDocument"+ let+ doc = notification ^. J.params+ . J.textDocument+ . J.uri+ fileName = J.uriToFilePath doc+ liftIO $ U.logs $ "********* fileName=" ++ show fileName+ sendDiagnostics doc (Just 0)++ -- -------------------------------++ HandlerRequest (Core.NotDidChangeTextDocument notification) -> do+ let doc :: J.Uri+ doc = notification ^. J.params+ . J.textDocument+ . J.uri+ mdoc <- liftIO $ Core.getVirtualFileFunc lf doc+ case mdoc of+ Just (VirtualFile _version str) -> do+ liftIO $ U.logs $ "reactor:processing NotDidChangeTextDocument: vf got:" ++ (show $ Yi.toString str)+ Nothing -> do+ liftIO $ U.logs $ "reactor:processing NotDidChangeTextDocument: vf returned Nothing"++ liftIO $ U.logs $ "reactor:processing NotDidChangeTextDocument: uri=" ++ (show doc)++ -- -------------------------------++ HandlerRequest (Core.NotDidSaveTextDocument notification) -> do+ liftIO $ U.logm "****** reactor: processing NotDidSaveTextDocument"+ let+ doc = notification ^. J.params+ . J.textDocument+ . J.uri+ fileName = J.uriToFilePath doc+ liftIO $ U.logs $ "********* fileName=" ++ show fileName+ sendDiagnostics doc Nothing++ -- -------------------------------++ HandlerRequest (Core.ReqRename req) -> do+ liftIO $ U.logs $ "reactor:got RenameRequest:" ++ show req+ let+ _params = req ^. J.params+ _doc = _params ^. J.textDocument . J.uri+ J.Position _l _c' = _params ^. J.position+ _newName = _params ^. J.newName++ let we = J.WorkspaceEdit+ Nothing -- "changes" field is deprecated+ (Just (J.List [])) -- populate with actual changes from the rename+ let rspMsg = Core.makeResponseMessage req we+ reactorSend rspMsg++ -- -------------------------------++ HandlerRequest (Core.ReqHover req) -> do+ liftIO $ U.logs $ "reactor:got HoverRequest:" ++ show req+ let J.TextDocumentPositionParams _doc pos = req ^. J.params+ J.Position _l _c' = pos++ let+ ht = J.Hover ms (Just range)+ ms = J.List [J.CodeString $ J.LanguageString "lsp-hello" "TYPE INFO" ]+ range = J.Range pos pos+ reactorSend $ Core.makeResponseMessage req ht++ -- -------------------------------++ HandlerRequest (Core.ReqCodeAction req) -> do+ liftIO $ U.logs $ "reactor:got CodeActionRequest:" ++ show req+ let params = req ^. J.params+ doc = params ^. J.textDocument+ -- fileName = drop (length ("file://"::String)) doc+ -- J.Range from to = J._range (params :: J.CodeActionParams)+ (J.List diags) = params ^. J.context . J.diagnostics++ let+ -- makeCommand only generates commands for diagnostics whose source is us+ makeCommand (J.Diagnostic (J.Range start _) _s _c (Just "lsp-hello") _m ) = [J.Command title cmd cmdparams]+ where+ title = "Apply LSP hello command:" <> head (T.lines _m)+ -- NOTE: the cmd needs to be registered via the InitializeResponse message. See lspOptions above+ cmd = "lsp-hello-command"+ -- need 'file' and 'start_pos'+ args = J.Array$ V.fromList+ [ J.Object $ H.fromList [("file", J.Object $ H.fromList [("textDocument",J.toJSON doc)])]+ , J.Object $ H.fromList [("start_pos",J.Object $ H.fromList [("position", J.toJSON start)])]+ ]+ cmdparams = Just args+ makeCommand (J.Diagnostic _r _s _c _source _m ) = []+ let body = J.List $ concatMap makeCommand diags+ reactorSend $ Core.makeResponseMessage req body++ -- -------------------------------++ HandlerRequest (Core.ReqExecuteCommand req) -> do+ liftIO $ U.logs $ "reactor:got ExecuteCommandRequest:" -- ++ show req+ let params = req ^. J.params+ margs = params ^. J.arguments++ liftIO $ U.logs $ "reactor:ExecuteCommandRequest:margs=" ++ show margs++ let+ reply v = reactorSend $ Core.makeResponseMessage req v+ -- When we get a RefactorResult or HieDiff, we need to send a+ -- separate WorkspaceEdit Notification+ r = J.List [] :: J.List Int+ liftIO $ U.logs $ "ExecuteCommand response got:r=" ++ show r+ case toWorkspaceEdit r of+ Just we -> do+ reply (J.Object mempty)+ lid <- nextLspReqId+ -- reactorSend $ J.RequestMessage "2.0" lid "workspace/applyEdit" (Just we)+ reactorSend $ fmServerApplyWorkspaceEditRequest lid we+ Nothing ->+ reply (J.Object mempty)++ -- -------------------------------++ HandlerRequest om -> do+ liftIO $ U.logs $ "reactor:got HandlerRequest:" ++ show om++-- ---------------------------------------------------------------------++toWorkspaceEdit :: t -> Maybe J.ApplyWorkspaceEditParams+toWorkspaceEdit _ = Nothing++-- ---------------------------------------------------------------------++-- | Analyze the file and send any diagnostics to the client in a+-- "textDocument/publishDiagnostics" notification+sendDiagnostics :: J.Uri -> Maybe Int -> R ()+sendDiagnostics fileUri mversion = do+ let+ diags = [J.Diagnostic+ (J.Range (J.Position 0 1) (J.Position 0 5))+ (Just J.DsWarning) -- severity+ Nothing -- code+ (Just "lsp-hello") -- source+ "Example diagnostic message"+ ]+ -- reactorSend $ J.NotificationMessage "2.0" "textDocument/publishDiagnostics" (Just r)+ publishDiagnostics fileUri mversion (partitionBySource diags)++-- ---------------------------------------------------------------------++syncMethod :: J.TextDocumentSyncKind+syncMethod = J.TdSyncIncremental++lspOptions :: Core.Options+lspOptions = def { Core.textDocumentSync = Just syncMethod+ , Core.executeCommandProvider = Just (J.ExecuteCommandOptions (J.List ["lsp-hello-command"]))+ }++lspHandlers :: TChan ReactorInput -> Core.Handlers+lspHandlers rin+ = def { Core.initializedHandler = Just $ passHandler rin Core.NotInitialized+ , Core.renameHandler = Just $ passHandler rin Core.ReqRename+ , Core.hoverHandler = Just $ passHandler rin Core.ReqHover+ , Core.didOpenTextDocumentNotificationHandler = Just $ passHandler rin Core.NotDidOpenTextDocument+ , Core.didSaveTextDocumentNotificationHandler = Just $ passHandler rin Core.NotDidSaveTextDocument+ , Core.didChangeTextDocumentNotificationHandler = Just $ passHandler rin Core.NotDidChangeTextDocument+ , Core.didCloseTextDocumentNotificationHandler = Just $ passHandler rin Core.NotDidCloseTextDocument+ , Core.cancelNotificationHandler = Just $ passHandler rin Core.NotCancelRequest+ , Core.responseHandler = Just $ responseHandlerCb rin+ , Core.codeActionHandler = Just $ passHandler rin Core.ReqCodeAction+ , Core.executeCommandHandler = Just $ passHandler rin Core.ReqExecuteCommand+ }++-- ---------------------------------------------------------------------++passHandler :: TChan ReactorInput -> (a -> Core.OutMessage) -> Core.Handler a+passHandler rin c notification = do+ atomically $ writeTChan rin (HandlerRequest (c notification))++-- ---------------------------------------------------------------------++responseHandlerCb :: TChan ReactorInput -> Core.Handler J.BareResponseMessage+responseHandlerCb _rin resp = do+ U.logs $ "******** got ResponseMessage, ignoring:" ++ show resp++-- ---------------------------------------------------------------------
+ haskell-lsp.cabal view
@@ -0,0 +1,115 @@+name: haskell-lsp+version: 0.1.0.0+synopsis: Haskell library for the Microsoft Language Server Protocol++description: An implementation of the types, and basic message server to+ allow language implementors to support the Language Server+ Protocol for their specific language.+ .+ An example of this is for Haskell via the Haskell IDE+ Engine, at https://github.com//haskell-ide-engine++homepage: https://github.com/alanz/haskell-lsp+license: MIT+license-file: LICENSE+author: Alan Zimmerman+maintainer: alan.zimm@gmail.com+copyright: Alan Zimmerman, 2016+category: Development+build-type: Simple+extra-source-files: ChangeLog.md, README.md+cabal-version: >=1.10++library+ exposed-modules: Language.Haskell.LSP.Constant+ , Language.Haskell.LSP.Core+ , Language.Haskell.LSP.Control+ , Language.Haskell.LSP.Diagnostics+ , Language.Haskell.LSP.Messages+ , Language.Haskell.LSP.TH.ClientCapabilities+ , Language.Haskell.LSP.TH.Constants+ , Language.Haskell.LSP.TH.DataTypesJSON+ , Language.Haskell.LSP.Utility+ , Language.Haskell.LSP.VFS+ -- other-modules:+ -- other-extensions:+ ghc-options: -Wall+ -- ghc-options: -Werror+ build-depends: base >=4.9 && <4.10+ , aeson >=1.0.0.0+ , bytestring+ , containers+ , directory+ , data-default+ , filepath+ , hslogger+ , hashable+ , lens >= 4.15.2+ , mtl+ , parsec+ , stm+ , text+ , time+ , unordered-containers+ , yi-rope+ hs-source-dirs: src+ default-language: Haskell2010++executable lsp-hello+ main-is: Main.hs+ hs-source-dirs: example+ -- src+ default-language: Haskell2010+ ghc-options: -Wall++ build-depends: base >=4.9 && <4.10+ , aeson+ , bytestring+ , containers+ , directory+ , data-default+ , filepath+ , hslogger+ , lens >= 4.15.2+ , mtl+ , parsec+ , stm+ , text+ , time+ , transformers+ , unordered-containers+ , vector+ , yi-rope+ -- the package library. Comment this out if you want repl changes to propagate+ , haskell-lsp++test-suite haskell-lsp-test+ type: exitcode-stdio-1.0+ -- hs-source-dirs: test src+ hs-source-dirs: test+ main-is: Main.hs+ other-modules: Spec+ VspSpec+ DiagnosticsSpec+ MethodSpec+ build-depends: base+ , aeson+ , containers+ , directory+ , hspec+ , hashable+ -- , hspec-jenkins+ , lens >= 4.15.2+ , yi-rope+ , haskell-lsp+ -- , data-default+ -- , bytestring+ -- , hslogger+ , text+ -- , unordered-containers+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/alanz/haskell-lsp
+ src/Language/Haskell/LSP/Constant.hs view
@@ -0,0 +1,12 @@+module Language.Haskell.LSP.Constant where++_LOG_NAME :: String+_LOG_NAME = "haskell-lsp"++_LOG_FORMAT :: String+-- _LOG_FORMAT = "$time [$tid] $prio $loggername - $msg"+_LOG_FORMAT = "$time [$tid] - $msg"++_LOG_FORMAT_DATE :: String+_LOG_FORMAT_DATE = "%Y-%m-%d %H:%M:%S"+
+ src/Language/Haskell/LSP/Control.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Language.Haskell.LSP.Control+ (+ run+ ) where++import Control.Concurrent+import Control.Concurrent.STM.TChan+import Control.Monad+import Control.Monad.STM+import qualified Data.Aeson as J+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as B+import Data.Monoid+import qualified Language.Haskell.LSP.Core as Core+import Language.Haskell.LSP.Utility+import System.IO+import Text.Parsec++-- ---------------------------------------------------------------------++run :: Core.InitializeCallback -- ^ function to be called once initialize has+ -- been received from the client. Further message+ -- processing will start only after this returns.+ -> Core.Handlers+ -> Core.Options+ -> IO Int -- exit code+run dp h o = do++ logm $ B.pack "\n\n\n\n\nhaskell-lsp:Starting up server ..."+ hSetBuffering stdin NoBuffering+ hSetEncoding stdin utf8++ hSetBuffering stdout NoBuffering+ hSetEncoding stdout utf8++ cout <- atomically newTChan :: IO (TChan BSL.ByteString)+ _rhpid <- forkIO $ sendServer cout+++ let sendFunc :: Core.SendFunc+ sendFunc str = atomically $ writeTChan cout (J.encode str)+ let lf = error "LifeCycle error, ClientCapabilites not set yet via initialize maessage"++ mvarDat <- newMVar ((Core.defaultLanguageContextData h o lf :: Core.LanguageContextData)+ { Core.resSendResponse = sendFunc+ } )++ ioLoop dp mvarDat++ return 1++-- ---------------------------------------------------------------------++ioLoop :: Core.InitializeCallback -> MVar Core.LanguageContextData -> IO ()+ioLoop dispatcherProc mvarDat = go BSL.empty+ where+ go :: BSL.ByteString -> IO ()+ go buf = do+ c <- BSL.hGet stdin 1+ if c == BSL.empty+ then do+ logm $ B.pack "\nhaskell-lsp:Got EOF, exiting 1 ...\n"+ return ()+ else do+ -- logs $ "ioLoop: got" ++ show c+ let newBuf = BSL.append buf c+ case readContentLength (lbs2str newBuf) of+ Left _ -> go newBuf+ Right len -> do+ cnt <- BSL.hGet stdin len+ if cnt == BSL.empty+ then do+ logm $ B.pack "\nhaskell-lsp:Got EOF, exiting 1 ...\n"+ return ()+ else do+ logm $ (B.pack "---> ") <> cnt+ Core.handleRequest dispatcherProc mvarDat newBuf cnt+ ioLoop dispatcherProc mvarDat+ where+ readContentLength :: String -> Either ParseError Int+ readContentLength = parse parser "readContentLength"++ parser = do+ _ <- string "Content-Length: "+ len <- manyTill digit (string _TWO_CRLF)+ return . read $ len++-- ---------------------------------------------------------------------++-- | Simple server to make sure all stdout is serialised+sendServer :: TChan BSL.ByteString -> IO ()+sendServer cstdout = do+ forever $ do+ str <- atomically $ readTChan cstdout+ let out = BSL.concat+ [ str2lbs $ "Content-Length: " ++ show (BSL.length str)+ , str2lbs _TWO_CRLF+ , str ]++ BSL.hPut stdout out+ hFlush stdout+ logm $ B.pack "<--2--" <> str++-- |+--+--+_TWO_CRLF :: String+_TWO_CRLF = "\r\n\r\n"++
+ src/Language/Haskell/LSP/Core.hs view
@@ -0,0 +1,592 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Language.Haskell.LSP.Core (+ handleRequest+ , LanguageContextData(..)+ , Handler+ , InitializeCallback+ , LspFuncs(..)+ , SendFunc+ , Handlers(..)+ , Options(..)+ , OutMessage(..)+ , defaultLanguageContextData+ , initializeRequestHandler+ , makeResponseMessage+ , makeResponseError+ , setupLogger+ , sendErrorResponseS+ , sendErrorLogS+ , sendErrorShowS+ ) where++import Control.Concurrent+import qualified Control.Exception as E+import Control.Monad+import Control.Lens ( (<&>), (^.) )+import qualified Data.Aeson as J+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as B+import Data.Default+import qualified Data.HashMap.Strict as HM+import qualified Data.List as L+import qualified Data.Map as Map+import Data.Monoid+import qualified Data.Text as T+import Data.Text ( Text )+import Language.Haskell.LSP.Constant+import Language.Haskell.LSP.Messages+import qualified Language.Haskell.LSP.TH.ClientCapabilities as C+import qualified Language.Haskell.LSP.TH.DataTypesJSON as J+import Language.Haskell.LSP.Utility+import Language.Haskell.LSP.VFS+import Language.Haskell.LSP.Diagnostics+import System.Directory+import System.Exit+import System.IO+import qualified System.Log.Formatter as L+import qualified System.Log.Handler as LH+import qualified System.Log.Handler.Simple as LHS+import System.Log.Logger+import qualified System.Log.Logger as L++-- ---------------------------------------------------------------------+{-# ANN module ("HLint: ignore Eta reduce" :: String) #-}+{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+-- ---------------------------------------------------------------------++-- | A function to send a message to the client+type SendFunc = forall a. (J.ToJSON a => a -> IO ())++-- | state used by the LSP dispatcher to manage the message loop+data LanguageContextData =+ LanguageContextData {+ resSeqDebugContextData :: !Int+ , resRootPath :: !(Maybe FilePath)+ , resHandlers :: !Handlers+ , resOptions :: !Options+ , resSendResponse :: !SendFunc+ , resVFS :: !VFS+ , resDiagnostics :: !DiagnosticStore+ , resLspFuncs :: LspFuncs -- NOTE: Cannot be strict, lazy initialization+ }++-- ---------------------------------------------------------------------++-- | Language Server Protocol options supported by the given language server.+-- These are automatically turned into capabilities reported to the client+-- during initialization.+data Options =+ Options+ { textDocumentSync :: Maybe J.TextDocumentSyncKind+ , completionProvider :: Maybe J.CompletionOptions+ , signatureHelpProvider :: Maybe J.SignatureHelpOptions+ , codeLensProvider :: Maybe J.CodeLensOptions+ , documentOnTypeFormattingProvider :: Maybe J.DocumentOnTypeFormattingOptions+ , documentLinkProvider :: Maybe J.DocumentLinkOptions+ , executeCommandProvider :: Maybe J.ExecuteCommandOptions+ }++instance Default Options where+ def = Options Nothing Nothing Nothing Nothing Nothing Nothing Nothing++-- | A function to publish diagnostics. It aggregates all diagnostics pertaining+-- to a particular version of a document, by source, and sends a+-- 'textDocument/publishDiagnostics' notification with the total whenever it is+-- updated.+type PublishDiagnosticsFunc = J.Uri -> Maybe J.TextDocumentVersion -> DiagnosticsBySource -> IO ()++-- | Returned to the server on startup, providing ways to interact with the client.+data LspFuncs =+ LspFuncs+ { clientCapabilities :: !C.ClientCapabilities+ , sendFunc :: !SendFunc+ , getVirtualFileFunc :: !(J.Uri -> IO (Maybe VirtualFile))+ , publishDiagnosticsFunc :: !PublishDiagnosticsFunc+ }++-- | The function in the LSP process that is called once the 'initialize'+-- message is received. Message processing will only continue once this returns,+-- so it should create whatever processes are needed.+type InitializeCallback = LspFuncs -> IO (Maybe J.ResponseError)++-- | The Handler type captures a function that receives local read-only state+-- 'a', a function to send a reply message once encoded as a ByteString, and a+-- received message of type 'b'+type Handler b = b -> IO ()++-- | Callbacks from the language server to the language handler+data Handlers =+ Handlers+ {+ -- Capability-advertised handlers+ hoverHandler :: !(Maybe (Handler J.HoverRequest))+ , completionHandler :: !(Maybe (Handler J.CompletionRequest))+ , completionResolveHandler :: !(Maybe (Handler J.CompletionItemResolveRequest))+ , signatureHelpHandler :: !(Maybe (Handler J.SignatureHelpRequest))+ , definitionHandler :: !(Maybe (Handler J.DefinitionRequest))+ , referencesHandler :: !(Maybe (Handler J.ReferencesRequest))+ , documentHighlightHandler :: !(Maybe (Handler J.DocumentHighlightRequest))+ , documentSymbolHandler :: !(Maybe (Handler J.DocumentSymbolRequest))+ , workspaceSymbolHandler :: !(Maybe (Handler J.WorkspaceSymbolRequest))+ , codeActionHandler :: !(Maybe (Handler J.CodeActionRequest))+ , codeLensHandler :: !(Maybe (Handler J.CodeLensRequest))+ , codeLensResolveHandler :: !(Maybe (Handler J.CodeLensResolveRequest))+ , documentFormattingHandler :: !(Maybe (Handler J.DocumentFormattingRequest))+ , documentRangeFormattingHandler :: !(Maybe (Handler J.DocumentRangeFormattingRequest))+ , documentTypeFormattingHandler :: !(Maybe (Handler J.DocumentOnTypeFormattingRequest))+ , renameHandler :: !(Maybe (Handler J.RenameRequest))+ -- new in 3.0+ , documentLinkHandler :: !(Maybe (Handler J.DocumentLinkRequest))+ , documentLinkResolveHandler :: !(Maybe (Handler J.DocumentLinkResolveRequest))+ , executeCommandHandler :: !(Maybe (Handler J.ExecuteCommandRequest))+ -- Next 2 go from server -> client+ -- , registerCapabilityHandler :: !(Maybe (Handler J.RegisterCapabilityRequest))+ -- , unregisterCapabilityHandler :: !(Maybe (Handler J.UnregisterCapabilityRequest))+ , willSaveWaitUntilTextDocHandler:: !(Maybe (Handler J.WillSaveWaitUntilTextDocumentResponse))++ -- Notifications from the client+ , didChangeConfigurationParamsHandler :: !(Maybe (Handler J.DidChangeConfigurationNotification))+ , didOpenTextDocumentNotificationHandler :: !(Maybe (Handler J.DidOpenTextDocumentNotification))+ , didChangeTextDocumentNotificationHandler :: !(Maybe (Handler J.DidChangeTextDocumentNotification))+ , didCloseTextDocumentNotificationHandler :: !(Maybe (Handler J.DidCloseTextDocumentNotification))+ , didSaveTextDocumentNotificationHandler :: !(Maybe (Handler J.DidSaveTextDocumentNotification))+ , didChangeWatchedFilesNotificationHandler :: !(Maybe (Handler J.DidChangeWatchedFilesNotification))+ -- new in 3.0+ , initializedHandler :: !(Maybe (Handler J.InitializedNotification))+ , willSaveTextDocumentNotificationHandler :: !(Maybe (Handler J.WillSaveTextDocumentNotification))+ , cancelNotificationHandler :: !(Maybe (Handler J.CancelNotification))++ -- Responses to Request messages originated from the server+ , responseHandler :: !(Maybe (Handler J.BareResponseMessage))+ }++instance Default Handlers where+ def = Handlers Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing+ Nothing Nothing Nothing++-- ---------------------------------------------------------------------+nop :: a -> b -> IO a+nop = const . return++helper :: J.FromJSON a+ => (MVar LanguageContextData -> a -> IO ())+ -> (MVar LanguageContextData -> J.Value -> IO ())+helper requestHandler mvarDat json =+ case J.fromJSON json of+ J.Success req -> requestHandler mvarDat req+ J.Error err -> do+ let msg = T.pack . unwords $ ["haskell-lsp:parse error.", show json, show err] ++ _ERR_MSG_URL+ sendErrorLog mvarDat msg++handlerMap :: InitializeCallback+ -> Handlers -> J.ClientMethod -> (MVar LanguageContextData -> J.Value -> IO ())+-- General+handlerMap i _ J.Initialize = helper (initializeRequestHandler i)+handlerMap _ h J.Initialized = hh nop $ initializedHandler h+handlerMap _ _ J.Shutdown = helper shutdownRequestHandler+handlerMap _ _ J.Exit = \_ _ -> do+ logm $ B.pack "haskell-lsp:Got exit, exiting"+ exitSuccess+handlerMap _ h J.CancelRequest = hh nop $ cancelNotificationHandler h+-- Workspace+handlerMap _ h J.WorkspaceDidChangeConfiguration = hh nop $ didChangeConfigurationParamsHandler h+handlerMap _ h J.WorkspaceDidChangeWatchedFiles = hh nop $ didChangeWatchedFilesNotificationHandler h+handlerMap _ h J.WorkspaceSymbol = hh nop $ workspaceSymbolHandler h+handlerMap _ h J.WorkspaceExecuteCommand = hh nop $ executeCommandHandler h+-- Document+handlerMap _ h J.TextDocumentDidOpen = hh openVFS $ didOpenTextDocumentNotificationHandler h+handlerMap _ h J.TextDocumentDidChange = hh changeVFS $ didChangeTextDocumentNotificationHandler h+handlerMap _ h J.TextDocumentWillSave = hh nop $ willSaveTextDocumentNotificationHandler h+handlerMap _ h J.TextDocumentWillSaveWaitUntil = hh nop $ willSaveWaitUntilTextDocHandler h+handlerMap _ h J.TextDocumentDidSave = hh nop $ didSaveTextDocumentNotificationHandler h+handlerMap _ h J.TextDocumentDidClose = hh closeVFS $ didCloseTextDocumentNotificationHandler h+handlerMap _ h J.TextDocumentCompletion = hh nop $ completionHandler h+handlerMap _ h J.CompletionItemResolve = hh nop $ completionResolveHandler h+handlerMap _ h J.TextDocumentHover = hh nop $ hoverHandler h+handlerMap _ h J.TextDocumentSignatureHelp = hh nop $ signatureHelpHandler h+handlerMap _ h J.TextDocumentReferences = hh nop $ referencesHandler h+handlerMap _ h J.TextDocumentDocumentHighlight = hh nop $ documentHighlightHandler h+handlerMap _ h J.TextDocumentDocumentSymbol = hh nop $ documentSymbolHandler h+handlerMap _ h J.TextDocumentFormatting = hh nop $ documentFormattingHandler h+handlerMap _ h J.TextDocumentRangeFormatting = hh nop $ documentRangeFormattingHandler h+handlerMap _ h J.TextDocumentOnTypeFormatting = hh nop $ documentTypeFormattingHandler h+handlerMap _ h J.TextDocumentDefinition = hh nop $ definitionHandler h+handlerMap _ h J.TextDocumentCodeAction = hh nop $ codeActionHandler h+handlerMap _ h J.TextDocumentCodeLens = hh nop $ codeLensHandler h+handlerMap _ h J.CodeLensResolve = hh nop $ codeLensResolveHandler h+handlerMap _ h J.TextDocumentDocumentLink = hh nop $ documentLinkHandler h+handlerMap _ h J.DocumentLinkResolve = hh nop $ documentLinkResolveHandler h+handlerMap _ h J.TextDocumentRename = hh nop $ renameHandler h+handlerMap _ _ (J.Misc x) = helper f+ where f :: MVar LanguageContextData -> J.TraceNotification -> IO ()+ f mvarDat _ = do+ let msg = "haskell-lsp:Got " ++ T.unpack x ++ " ignoring"+ logm (B.pack msg)+ sendErrorLog mvarDat (T.pack msg)++-- ---------------------------------------------------------------------++-- | Adapter from the normal handlers exposed to the library users and the+-- internal message loop+hh :: forall b. (J.FromJSON b)+ => (VFS -> b -> IO VFS) -> Maybe (Handler b) -> MVar LanguageContextData -> J.Value -> IO ()+hh _ Nothing = \mvarDat json -> do+ let msg = T.pack $ unwords ["haskell-lsp:no handler for.", show json]+ sendErrorLog mvarDat msg+hh getVfs (Just h) = \mvarDat json -> do+ case J.fromJSON json of+ J.Success req -> do+ ctx <- readMVar mvarDat+ vfs' <- getVfs (resVFS ctx) req+ modifyMVar_ mvarDat (\c -> return c {resVFS = vfs'})+ h req+ J.Error err -> do+ let msg = T.pack $ unwords $ ["haskell-lsp:parse error.", show json, show err] ++ _ERR_MSG_URL+ sendErrorLog mvarDat msg++-- ---------------------------------------------------------------------++getVirtualFile :: MVar LanguageContextData -> J.Uri -> IO (Maybe VirtualFile)+getVirtualFile mvarDat uri = do+ ctx <- readMVar mvarDat+ return $ Map.lookup uri (resVFS ctx)++-- ---------------------------------------------------------------------++-- | Wrap all the protocol messages into a single type, for use in the language+-- handler in storing the original message+data OutMessage = ReqHover J.HoverRequest+ | ReqCompletion J.CompletionRequest+ | ReqCompletionItemResolve J.CompletionItemResolveRequest+ | ReqSignatureHelp J.SignatureHelpRequest+ | ReqDefinition J.DefinitionRequest+ | ReqFindReferences J.ReferencesRequest+ | ReqDocumentHighlights J.DocumentHighlightRequest+ | ReqDocumentSymbols J.DocumentSymbolRequest+ | ReqWorkspaceSymbols J.WorkspaceSymbolRequest+ | ReqCodeAction J.CodeActionRequest+ | ReqCodeLens J.CodeLensRequest+ | ReqCodeLensResolve J.CodeLensResolveRequest+ | ReqDocumentFormatting J.DocumentFormattingRequest+ | ReqDocumentRangeFormatting J.DocumentRangeFormattingRequest+ | ReqDocumentOnTypeFormatting J.DocumentOnTypeFormattingRequest+ | ReqRename J.RenameRequest+ | ReqExecuteCommand J.ExecuteCommandRequest+ -- responses+ | RspHover J.HoverResponse+ | RspCompletion J.CompletionResponse+ | RspCompletionItemResolve J.CompletionItemResolveResponse+ | RspSignatureHelp J.SignatureHelpResponse+ | RspDefinition J.DefinitionResponse+ | RspFindReferences J.ReferencesResponse+ | RspDocumentHighlights J.DocumentHighlightsResponse+ | RspDocumentSymbols J.DocumentSymbolsResponse+ | RspWorkspaceSymbols J.WorkspaceSymbolsResponse+ | RspCodeAction J.CodeActionResponse+ | RspCodeLens J.CodeLensResponse+ | RspCodeLensResolve J.CodeLensResolveResponse+ | RspDocumentFormatting J.DocumentFormattingResponse+ | RspDocumentRangeFormatting J.DocumentRangeFormattingResponse+ | RspDocumentOnTypeFormatting J.DocumentOnTypeFormattingResponse+ | RspRename J.RenameResponse+ | RspExecuteCommand J.ExecuteCommandResponse++ -- notifications+ | NotInitialized J.InitializedNotification+ | NotDidChangeConfigurationParams J.DidChangeConfigurationNotification+ | NotDidOpenTextDocument J.DidOpenTextDocumentNotification+ | NotDidChangeTextDocument J.DidChangeTextDocumentNotification+ | NotDidCloseTextDocument J.DidCloseTextDocumentNotification+ | NotDidSaveTextDocument J.DidSaveTextDocumentNotification+ | NotDidChangeWatchedFiles J.DidChangeWatchedFilesNotification++ | NotCancelRequest J.CancelNotification++ | RspFromClient J.BareResponseMessage+ deriving (Eq,Read,Show)++-- ---------------------------------------------------------------------+-- |+--+--+_INITIAL_RESPONSE_SEQUENCE :: Int+_INITIAL_RESPONSE_SEQUENCE = 0+++-- |+--+--+_SEP_WIN :: Char+_SEP_WIN = '\\'++-- |+--+--+_SEP_UNIX :: Char+_SEP_UNIX = '/'++-- |+--+--+_ERR_MSG_URL :: [String]+_ERR_MSG_URL = [ "`stack update` and install new haskell-lsp."+ , "Or check information on https://marketplace.visualstudio.com/items?itemName=xxxxxxxxxxxxxxx"+ ]+++-- |+--+--+defaultLanguageContextData :: Handlers -> Options -> LspFuncs -> LanguageContextData+defaultLanguageContextData h o lf = LanguageContextData _INITIAL_RESPONSE_SEQUENCE Nothing h o (BSL.putStr . J.encode) mempty mempty lf++-- ---------------------------------------------------------------------++handleRequest :: InitializeCallback+ -> MVar LanguageContextData -> BSL.ByteString -> BSL.ByteString -> IO ()+handleRequest dispatcherProc mvarDat contLenStr jsonStr = do+ {-+ Message Types we must handle are the following++ Request | jsonrpc | id | method | params?+ Response | jsonrpc | id | | | response? | error?+ Notification | jsonrpc | | method | params?++ -}++ case J.eitherDecode jsonStr :: Either String J.Object of+ Left err -> do+ let msg = T.pack $ unwords [ "haskell-lsp:incoming message parse error.", lbs2str contLenStr, lbs2str jsonStr, show err]+ ++ L.intercalate "\n" ("" : "" : _ERR_MSG_URL)+ ++ "\n"+ sendErrorLog mvarDat msg++ Right o -> do+ case HM.lookup "method" o of+ Just cmd@(J.String s) -> case J.fromJSON cmd of+ J.Success m -> handle (J.Object o) m+ J.Error _ -> do+ let msg = T.pack $ unwords ["haskell-lsp:unknown message received:method='" ++ T.unpack s ++ "',", lbs2str contLenStr, lbs2str jsonStr]+ sendErrorLog mvarDat msg+ Just oops -> logs $ "haskell-lsp:got strange method param, ignoring:" ++ show oops+ Nothing -> do+ logs $ "haskell-lsp:Got reply message:" ++ show jsonStr+ handleResponse (J.Object o)++ where+ handleResponse json = do+ ctx <- readMVar mvarDat+ case responseHandler $ resHandlers ctx of+ Nothing -> sendErrorLog mvarDat $ T.pack $ "haskell-lsp: responseHandler is not defined, ignoring response " ++ lbs2str jsonStr+ Just h -> case J.fromJSON json of+ J.Success res -> h res+ J.Error err -> let msg = T.pack $ unwords $ ["haskell-lsp:response parse error.", lbs2str jsonStr, show err] ++ _ERR_MSG_URL+ in sendErrorLog mvarDat msg+ -- capability based handlers+ handle json cmd = do+ ctx <- readMVar mvarDat+ let h = resHandlers ctx+ handlerMap dispatcherProc h cmd mvarDat json++-- ---------------------------------------------------------------------++makeResponseMessage :: J.RequestMessage J.ClientMethod req resp -> resp -> J.ResponseMessage resp+makeResponseMessage req result = J.ResponseMessage "2.0" (J.responseId $ req ^. J.id) (Just result) Nothing++makeResponseError :: J.LspIdRsp -> J.ResponseError -> J.ResponseMessage ()+makeResponseError origId err = J.ResponseMessage "2.0" origId Nothing (Just err)++-- ---------------------------------------------------------------------+-- |+--+sendEvent :: J.ToJSON a => MVar LanguageContextData -> a -> IO ()+sendEvent mvarCtx str = sendResponse mvarCtx str++-- |+--+sendResponse :: J.ToJSON a => MVar LanguageContextData -> a -> IO ()+sendResponse mvarCtx str = do+ ctx <- readMVar mvarCtx+ resSendResponse ctx str+++-- ---------------------------------------------------------------------+-- |+--+--+sendErrorResponse :: MVar LanguageContextData -> J.LspIdRsp -> Text -> IO ()+sendErrorResponse mv origId msg = sendErrorResponseS (sendEvent mv) origId J.InternalError msg++sendErrorResponseS :: SendFunc -> J.LspIdRsp -> J.ErrorCode -> Text -> IO ()+sendErrorResponseS sf origId err msg = do+ sf $ (J.ResponseMessage "2.0" origId Nothing+ (Just $ J.ResponseError err msg Nothing) :: J.ErrorResponse)++sendErrorLog :: MVar LanguageContextData -> Text -> IO ()+sendErrorLog mv msg = sendErrorLogS (sendEvent mv) msg++sendErrorLogS :: SendFunc -> Text -> IO ()+sendErrorLogS sf msg =+ sf $ fmServerLogMessageNotification J.MtError msg++-- sendErrorShow :: String -> IO ()+-- sendErrorShow msg = sendErrorShowS sendEvent msg++sendErrorShowS :: SendFunc -> Text -> IO ()+sendErrorShowS sf msg =+ sf $ fmServerShowMessageNotification J.MtError msg++-- ---------------------------------------------------------------------++defaultErrorHandlers :: (Show a) => MVar LanguageContextData -> J.LspIdRsp -> a -> [E.Handler ()]+defaultErrorHandlers mvarDat origId req = [ E.Handler someExcept ]+ where+ someExcept (e :: E.SomeException) = do+ let msg = T.pack $ unwords ["request error.", show req, show e]+ sendErrorResponse mvarDat origId msg+ sendErrorLog mvarDat msg+++-- |=====================================================================+--+-- Handlers++-- |+--+initializeRequestHandler :: InitializeCallback+ -> MVar LanguageContextData+ -> J.InitializeRequest -> IO ()+initializeRequestHandler dispatcherProc mvarCtx req@(J.RequestMessage _ origId _ params) =+ flip E.catches (defaultErrorHandlers mvarCtx (J.responseId origId) req) $ do++ ctx0 <- readMVar mvarCtx++ let rootDir = getFirst $ foldMap First [ params ^. J.rootUri >>= J.uriToFilePath+ , params ^. J.rootPath <&> T.unpack ]++ modifyMVar_ mvarCtx (\c -> return c { resRootPath = rootDir })+ case rootDir of+ Nothing -> return ()+ Just dir -> do+ logs $ "haskell-lsp:initializeRequestHandler: setting current dir to project root:" ++ dir+ unless (null dir) $ setCurrentDirectory dir++ let+ getCapabilities :: J.InitializeParams -> C.ClientCapabilities+ getCapabilities (J.InitializeParams _ _ _ _ c _) = c++ -- Launch the given process once the project root directory has been set+ let lspFuncs = LspFuncs (getCapabilities params)+ (resSendResponse ctx0)+ (getVirtualFile mvarCtx)+ (publishDiagnostics mvarCtx)+ let ctx = ctx0 { resLspFuncs = lspFuncs }+ modifyMVar_ mvarCtx (\_ -> return ctx)++ initializationResult <- dispatcherProc lspFuncs++ case initializationResult of+ Just errResp -> do+ sendResponse mvarCtx $ makeResponseError (J.responseId origId) errResp++ Nothing -> do++ let+ h = resHandlers ctx+ o = resOptions ctx++ supported (Just _) = Just True+ supported Nothing = Nothing++ capa =+ J.InitializeResponseCapabilitiesInner+ { J._textDocumentSync = textDocumentSync o+ , J._hoverProvider = supported (hoverHandler h)+ , J._completionProvider = completionProvider o+ , J._signatureHelpProvider = signatureHelpProvider o+ , J._definitionProvider = supported (definitionHandler h)+ , J._referencesProvider = supported (referencesHandler h)+ , J._documentHighlightProvider = supported (documentHighlightHandler h)++ , J._documentSymbolProvider = supported (documentSymbolHandler h)+ , J._workspaceSymbolProvider = supported (workspaceSymbolHandler h)+ , J._codeActionProvider = supported (codeActionHandler h)+ , J._codeLensProvider = codeLensProvider o+ , J._documentFormattingProvider = supported (documentFormattingHandler h)+ , J._documentRangeFormattingProvider = supported (documentRangeFormattingHandler h)+ , J._documentOnTypeFormattingProvider = documentOnTypeFormattingProvider o+ , J._renameProvider = supported (renameHandler h)+ , J._documentLinkProvider = documentLinkProvider o+ , J._executeCommandProvider = executeCommandProvider o+ -- TODO: Add something for experimental+ , J._experimental = (Nothing :: Maybe J.Value)+ }++ -- TODO: wrap this up into a fn to create a response message+ res = J.ResponseMessage "2.0" (J.responseId origId) (Just $ J.InitializeResponseCapabilities capa) Nothing++ sendResponse mvarCtx res++-- |+--+shutdownRequestHandler :: MVar LanguageContextData -> J.ShutdownRequest -> IO ()+shutdownRequestHandler mvarCtx req@(J.RequestMessage _ origId _ _) =+ flip E.catches (defaultErrorHandlers mvarCtx (J.responseId origId) req) $ do+ let res = makeResponseMessage req "ok"++ sendResponse mvarCtx res++-- ---------------------------------------------------------------------++-- | Take the new diagnostics, update the stored diagnostics for the given file+-- and version, and publish the total to the client.+publishDiagnostics :: MVar LanguageContextData -> PublishDiagnosticsFunc+publishDiagnostics mvarDat uri mversion diags = do+ ctx <- readMVar mvarDat+ let ds = updateDiagnostics (resDiagnostics ctx) uri mversion diags+ modifyMVar_ mvarDat (\c -> return c {resDiagnostics = ds})+ let mdp = getDiagnosticParamsFor ds uri+ case mdp of+ Nothing -> return ()+ Just params -> do+ (resSendResponse ctx) $ J.NotificationMessage "2.0" J.TextDocumentPublishDiagnostics (Just params)++-- |=====================================================================+--+-- utility+++-- |+-- Logger+--+setupLogger :: FilePath -> [String] -> Priority -> IO ()+setupLogger logFile extraLogNames level = do++ logStream <- openFile logFile AppendMode+ hSetEncoding logStream utf8++ logH <- LHS.streamHandler logStream level++ let logHandle = logH {LHS.closeFunc = hClose}+ logFormat = L.tfLogFormatter _LOG_FORMAT_DATE _LOG_FORMAT+ logHandler = LH.setFormatter logHandle logFormat++ L.updateGlobalLogger L.rootLoggerName $ L.setHandlers ([] :: [LHS.GenericHandler Handle])+ L.updateGlobalLogger _LOG_NAME $ L.setHandlers [logHandler]+ L.updateGlobalLogger _LOG_NAME $ L.setLevel level++ -- Also route the additional log names to the same log+ forM_ extraLogNames $ \logName -> do+ L.updateGlobalLogger logName $ L.setHandlers [logHandler]+ L.updateGlobalLogger logName $ L.setLevel level+
+ src/Language/Haskell/LSP/Diagnostics.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-++Manage the "textDocument/publishDiagnostics" notifications to keep a local copy of the+diagnostics for a particular file and version, partitioned by source.+-}+module Language.Haskell.LSP.Diagnostics+ (+ DiagnosticStore+ , DiagnosticsBySource+ , StoreItem(..)+ , partitionBySource+ , updateDiagnostics+ , getDiagnosticParamsFor++ -- * for tests+ ) where++import qualified Data.Map as Map+import qualified Language.Haskell.LSP.TH.DataTypesJSON as J++-- ---------------------------------------------------------------------+{-# ANN module ("hlint: ignore Eta reduce" :: String) #-}+{-# ANN module ("hlint: ignore Redundant do" :: String) #-}+-- ---------------------------------------------------------------------++{-+We need a three level store++ Uri : Maybe TextDocumentVersion : Maybe DiagnosticSource : [Diagnostics]++For a given Uri, as soon as we see a new (Maybe TextDocumentVersion) we flush+all prior entries for the Uri.++-}++type DiagnosticStore = Map.Map J.Uri StoreItem++data StoreItem+ = StoreItem (Maybe J.TextDocumentVersion) DiagnosticsBySource+ deriving (Show,Eq)++type DiagnosticsBySource = Map.Map (Maybe J.DiagnosticSource) [J.Diagnostic]++-- ---------------------------------------------------------------------++partitionBySource :: [J.Diagnostic] -> DiagnosticsBySource+partitionBySource diags = Map.fromListWith (++) $ map (\d -> (J._source d, [d])) diags++-- ---------------------------------------------------------------------++updateDiagnostics :: DiagnosticStore+ -> J.Uri -> Maybe J.TextDocumentVersion -> DiagnosticsBySource+ -> DiagnosticStore+updateDiagnostics store uri mv newDiagsBySource = r+ where+ newStore :: DiagnosticStore+ newStore = Map.insert uri (StoreItem mv newDiagsBySource) store++ -- newDiagsBySource :: DiagnosticsBySource+ -- newDiagsBySource = Map.fromListWith (++) $ map (\d -> (J._source d, [d])) diags++ updateDbs dbs = Map.insert uri new store+ where+ new = StoreItem mv newDbs+ -- note: Map.union is left-biased, so for identical keys the first+ -- argument is used+ newDbs = Map.union newDiagsBySource dbs++ r = case Map.lookup uri store of+ Nothing -> newStore+ Just (StoreItem mvs dbs) ->+ if mvs /= mv+ then newStore+ else updateDbs dbs++-- ---------------------------------------------------------------------++getDiagnosticParamsFor :: DiagnosticStore -> J.Uri -> Maybe J.PublishDiagnosticsParams+getDiagnosticParamsFor ds uri =+ case Map.lookup uri ds of+ Nothing -> Nothing+ Just (StoreItem _ diags) ->+ Just $ J.PublishDiagnosticsParams uri (J.List (concat $ Map.elems diags))++-- ---------------------------------------------------------------------
+ src/Language/Haskell/LSP/Messages.hs view
@@ -0,0 +1,311 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Language.Haskell.LSP.Messages (+ -- * General+ fmClientInitializeRequest+ , fmClientInitializedNotification+ , fmClientShutdownRequest+ , fmClientExitNotification+ , fmClientCancelNotification++ -- * Window+ , fmServerShowMessageNotification+ , fmServerShowMessageRequest+ , fmServerLogMessageNotification+ , fmServerTelemetryNotification++ -- * Client+ , fmServerRegisterCapabilityRequest+ , fmServerUnregisterCapabilityRequest++ -- * Workspace+ , fmClientDidChangeConfigurationNotification+ , fmClientDidChangeWatchedFilesNotification+ , fmClientWorkspaceSymbolRequest+ , fmClientExecuteCommandRequest+ , fmServerApplyWorkspaceEditRequest++ -- * Document+ , fmServerPublishDiagnosticsNotification+ , fmClientDidOpenTextDocumentNotification+ , fmClientDidChangeTextDocumentNotification+ , fmClientWillSaveTextDocumentNotification+ , fmClientWillSaveWaitUntilRequest+ , fmClientDidSaveTextDocumentNotification+ , fmClientDidCloseTextDocumentNotification+ , fmClientCompletionRequest+ , fmClientCompletionItemResolveRequest+ , fmClientHoverRequest+ , fmClientSignatureHelpRequest+ , fmClientReferencesRequest+ , fmClientDocumentHighlightRequest+ , fmClientDocumentSymbolRequest+ , fmClientDocumentFormattingRequest+ , fmClientDocumentRangeFormattingRequest+ , fmClientDocumentOnTypeFormattingRequest+ , fmClientDefinitionRequest+ , fmClientCodeActionRequest+ , fmClientCodeLensRequest+ , fmClientCodeLensResolveRequest+ , fmClientDocumentLinkRequest+ , fmClientDocumentLinkResolveRequest+ , fmClientRenameRequest+ ) where++import qualified Data.Aeson as J+import Data.Text ( Text )+import qualified Language.Haskell.LSP.TH.DataTypesJSON as J++-- ---------------------------------------------------------------------+{-# ANN module ("HLint: ignore Eta reduce" :: String) #-}+{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+-- ---------------------------------------------------------------------++-- ----------------------------------------------------------------------+-- General+-- ----------------------------------------------------------------------++-- * :leftwards_arrow_with_hook: [initialize](#initialize)++fmClientInitializeRequest :: J.LspId -> J.InitializeParams -> J.InitializeRequest+fmClientInitializeRequest rid params+ = J.RequestMessage "2.0" rid J.Initialize params++-- ----------------------------------------------------------------------+-- * **New** :arrow_right: [initialized](#initialized)++-- | From 3.0+fmClientInitializedNotification :: J.InitializedNotification+fmClientInitializedNotification = J.NotificationMessage "2.0" J.Initialized Nothing++-- ----------------------------------------------------------------------+-- * :leftwards_arrow_with_hook: [shutdown](#shutdown)++fmClientShutdownRequest :: J.LspId -> Maybe J.Value -> J.ShutdownRequest+fmClientShutdownRequest rid params+ = J.RequestMessage "2.0" rid J.Shutdown params++-- ----------------------------------------------------------------------+-- * :arrow_right: [exit](#exit)++fmClientExitNotification :: J.ExitNotification+fmClientExitNotification = J.NotificationMessage "2.0" J.Exit Nothing++-- ----------------------------------------------------------------------+-- * :arrow_right: [$/cancelRequest](#cancelRequest)++fmClientCancelNotification :: J.LspId -> J.CancelNotification+fmClientCancelNotification idToCancel+ = J.NotificationMessage "2.0" J.CancelRequest (J.CancelParams idToCancel)++-- ----------------------------------------------------------------------+-- Window+-- ----------------------------------------------------------------------++-- * :arrow_left: [window/showMessage](#window_showMessage)++fmServerShowMessageNotification :: J.MessageType -> Text -> J.ShowMessageNotification+fmServerShowMessageNotification mt msg+ = J.NotificationMessage "2.0" J.WindowShowMessage (J.ShowMessageParams mt msg)++-- ----------------------------------------------------------------------+-- * :arrow_right_hook: [window/showMessageRequest](#window_showMessageRequest)++fmServerShowMessageRequest :: J.LspId -> J.ShowMessageRequestParams -> J.ShowMessageRequest+fmServerShowMessageRequest rid params+ = J.RequestMessage "2.0" rid J.WindowShowMessageRequest params++-- ----------------------------------------------------------------------+-- * :arrow_left: [window/logMessage](#window_logMessage)++fmServerLogMessageNotification :: J.MessageType -> Text -> J.LogMessageNotification+fmServerLogMessageNotification mt msg+ = J.NotificationMessage "2.0" J.WindowLogMessage (J.LogMessageParams mt msg)++-- ----------------------------------------------------------------------+-- * :arrow_left: [telemetry/event](#telemetry_event)++fmServerTelemetryNotification :: J.Value -> J.TelemetryNotification+fmServerTelemetryNotification params+ = J.NotificationMessage "2.0" J.TelemetryEvent params++-- ----------------------------------------------------------------------+-- Client+-- ----------------------------------------------------------------------++-- * :arrow_right_hook: [client/registerCapability](#client_registerCapability)+-- | from 3.0+fmServerRegisterCapabilityRequest :: J.LspId -> J.RegistrationParams -> J.RegisterCapabilityRequest+fmServerRegisterCapabilityRequest rid params+ = J.RequestMessage "2.0" rid J.ClientRegisterCapability params++-- * :arrow_right_hook: [client/unregisterCapability](#client_unregisterCapability)+-- | from 3.0+fmServerUnregisterCapabilityRequest :: J.LspId -> J.UnregistrationParams -> J.UnregisterCapabilityRequest+fmServerUnregisterCapabilityRequest rid params+ = J.RequestMessage "2.0" rid J.ClientUnregisterCapability params++-- ----------------------------------------------------------------------+-- Workspace+-- ----------------------------------------------------------------------++-- * :arrow_right: [workspace/didChangeConfiguration](#workspace_didChangeConfiguration)+fmClientDidChangeConfigurationNotification :: J.DidChangeConfigurationParams -> J.DidChangeConfigurationNotification+fmClientDidChangeConfigurationNotification params+ = J.NotificationMessage "2.0" J.WorkspaceDidChangeConfiguration params++-- * :arrow_right: [workspace/didChangeWatchedFiles](#workspace_didChangeWatchedFiles)+fmClientDidChangeWatchedFilesNotification :: J.DidChangeWatchedFilesParams -> J.DidChangeWatchedFilesNotification+fmClientDidChangeWatchedFilesNotification params+ = J.NotificationMessage "2.0" J.WorkspaceDidChangeWatchedFiles params++-- * :leftwards_arrow_with_hook: [workspace/symbol](#workspace_symbol)+fmClientWorkspaceSymbolRequest :: J.LspId -> J.WorkspaceSymbolParams -> J.WorkspaceSymbolRequest+fmClientWorkspaceSymbolRequest rid params+ = J.RequestMessage "2.0" rid J.WorkspaceSymbol params++-- * **New** :leftwards_arrow_with_hook: [workspace/executeCommand](#workspace_executeCommand)+-- | From 3.0+fmClientExecuteCommandRequest :: J.LspId -> J.ExecuteCommandParams -> J.ExecuteCommandRequest+fmClientExecuteCommandRequest rid params+ = J.RequestMessage "2.0" rid J.WorkspaceExecuteCommand params++-- * **New** :arrow_right_hook: [workspace/applyEdit](#workspace_applyEdit)+-- | From 3.0+fmServerApplyWorkspaceEditRequest :: J.LspId -> J.ApplyWorkspaceEditParams -> J.ApplyWorkspaceEditRequest+fmServerApplyWorkspaceEditRequest rid params+ = J.RequestMessage "2.0" rid J.WorkspaceApplyEdit params++-- ----------------------------------------------------------------------+ -- Document+-- ----------------------------------------------------------------------++-- * :arrow_left: [textDocument/publishDiagnostics](#textDocument_publishDiagnostics)+fmServerPublishDiagnosticsNotification :: J.PublishDiagnosticsParams -> J.PublishDiagnosticsNotification+fmServerPublishDiagnosticsNotification params+ = J.NotificationMessage "2.0" J.TextDocumentPublishDiagnostics params++-- * :arrow_right: [textDocument/didOpen](#textDocument_didOpen)+fmClientDidOpenTextDocumentNotification :: J.DidOpenTextDocumentParams -> J.DidOpenTextDocumentNotification+fmClientDidOpenTextDocumentNotification params+ = J.NotificationMessage "2.0" J.TextDocumentDidOpen params++-- * :arrow_right: [textDocument/didChange](#textDocument_didChange)+fmClientDidChangeTextDocumentNotification :: J.DidChangeTextDocumentParams -> J.DidChangeTextDocumentNotification+fmClientDidChangeTextDocumentNotification params+ = J.NotificationMessage "2.0" J.TextDocumentDidChange params++-- * :arrow_right: [textDocument/willSave](#textDocument_willSave)+fmClientWillSaveTextDocumentNotification :: J.WillSaveTextDocumentParams -> J.WillSaveTextDocumentNotification+fmClientWillSaveTextDocumentNotification params+ = J.NotificationMessage "2.0" J.TextDocumentWillSave params++-- * **New** :leftwards_arrow_with_hook: [textDocument/willSaveWaitUntil](#textDocument_willSaveWaitUntil)+-- | From 3.0+fmClientWillSaveWaitUntilRequest :: J.LspId -> J.WillSaveTextDocumentParams -> J.WillSaveWaitUntilTextDocumentRequest+fmClientWillSaveWaitUntilRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentWillSaveWaitUntil params++-- * **New** :arrow_right: [textDocument/didSave](#textDocument_didSave)+-- | 3.0+fmClientDidSaveTextDocumentNotification :: J.DidSaveTextDocumentParams -> J.DidSaveTextDocumentNotification+fmClientDidSaveTextDocumentNotification params+ = J.NotificationMessage "2.0" J.TextDocumentDidSave params++-- * :arrow_right: [textDocument/didClose](#textDocument_didClose)+fmClientDidCloseTextDocumentNotification :: J.DidCloseTextDocumentParams -> J.DidCloseTextDocumentNotification+fmClientDidCloseTextDocumentNotification params+ = J.NotificationMessage "2.0" J.TextDocumentDidClose params++-- * :leftwards_arrow_with_hook: [textDocument/completion](#textDocument_completion)+fmClientCompletionRequest :: J.LspId -> J.TextDocumentPositionParams -> J.CompletionRequest+fmClientCompletionRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentCompletion params++-- * :leftwards_arrow_with_hook: [completionItem/resolve](#completionItem_resolve)+fmClientCompletionItemResolveRequest :: J.LspId -> J.CompletionItem -> J.CompletionItemResolveRequest+fmClientCompletionItemResolveRequest rid params+ = J.RequestMessage "2.0" rid J.CompletionItemResolve params++-- * :leftwards_arrow_with_hook: [textDocument/hover](#textDocument_hover)+fmClientHoverRequest :: J.LspId -> J.TextDocumentPositionParams -> J.HoverRequest+fmClientHoverRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentHover params++-- * :leftwards_arrow_with_hook: [textDocument/signatureHelp](#textDocument_signatureHelp)+fmClientSignatureHelpRequest :: J.LspId -> J.TextDocumentPositionParams -> J.SignatureHelpRequest+fmClientSignatureHelpRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentSignatureHelp params++-- * :leftwards_arrow_with_hook: [textDocument/references](#textDocument_references)+fmClientReferencesRequest :: J.LspId -> J.ReferenceParams -> J.ReferencesRequest+fmClientReferencesRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentReferences params++-- * :leftwards_arrow_with_hook: [textDocument/documentHighlight](#textDocument_documentHighlight)+fmClientDocumentHighlightRequest :: J.LspId -> J.TextDocumentPositionParams -> J.DocumentHighlightRequest+fmClientDocumentHighlightRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentDocumentHighlight params++-- * :leftwards_arrow_with_hook: [textDocument/documentSymbol](#textDocument_documentSymbol)+fmClientDocumentSymbolRequest :: J.LspId -> J.DocumentSymbolParams -> J.DocumentSymbolRequest+fmClientDocumentSymbolRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentDocumentSymbol params++-- * :leftwards_arrow_with_hook: [textDocument/formatting](#textDocument_formatting)+fmClientDocumentFormattingRequest :: J.LspId -> J.DocumentFormattingParams -> J.DocumentFormattingRequest+fmClientDocumentFormattingRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentFormatting params++-- * :leftwards_arrow_with_hook: [textDocument/rangeFormatting](#textDocument_rangeFormatting)+fmClientDocumentRangeFormattingRequest :: J.LspId -> J.DocumentRangeFormattingParams -> J.DocumentRangeFormattingRequest+fmClientDocumentRangeFormattingRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentRangeFormatting params++-- * :leftwards_arrow_with_hook: [textDocument/onTypeFormatting](#textDocument_onTypeFormatting)+fmClientDocumentOnTypeFormattingRequest :: J.LspId -> J.DocumentOnTypeFormattingParams -> J.DocumentOnTypeFormattingRequest+fmClientDocumentOnTypeFormattingRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentOnTypeFormatting params++-- * :leftwards_arrow_with_hook: [textDocument/definition](#textDocument_definition)+fmClientDefinitionRequest :: J.LspId -> J.TextDocumentPositionParams -> J.DefinitionRequest+fmClientDefinitionRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentDefinition params++-- * :leftwards_arrow_with_hook: [textDocument/codeAction](#textDocument_codeAction)+fmClientCodeActionRequest :: J.LspId -> J.CodeActionParams -> J.CodeActionRequest+fmClientCodeActionRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentCodeAction params++-- * :leftwards_arrow_with_hook: [textDocument/codeLens](#textDocument_codeLens)+fmClientCodeLensRequest :: J.LspId -> J.CodeLensParams -> J.CodeLensRequest+fmClientCodeLensRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentCodeLens params++-- * :leftwards_arrow_with_hook: [codeLens/resolve](#codeLens_resolve)+fmClientCodeLensResolveRequest :: J.LspId -> J.CodeLens -> J.CodeLensResolveRequest+fmClientCodeLensResolveRequest rid params+ = J.RequestMessage "2.0" rid J.CodeLensResolve params++-- * :leftwards_arrow_with_hook: [textDocument/documentLink](#textDocument_documentLink)+fmClientDocumentLinkRequest :: J.LspId -> J.DocumentLinkParams -> J.DocumentLinkRequest+fmClientDocumentLinkRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentDocumentLink params++-- * :leftwards_arrow_with_hook: [documentLink/resolve](#documentLink_resolve)+fmClientDocumentLinkResolveRequest :: J.LspId -> J.DocumentLink -> J.DocumentLinkResolveRequest+fmClientDocumentLinkResolveRequest rid params+ = J.RequestMessage "2.0" rid J.DocumentLinkResolve params++-- * :leftwards_arrow_with_hook: [textDocument/rename](#textDocument_rename)+fmClientRenameRequest :: J.LspId -> J.RenameParams -> J.RenameRequest+fmClientRenameRequest rid params+ = J.RequestMessage "2.0" rid J.TextDocumentRename params+
+ src/Language/Haskell/LSP/TH/ClientCapabilities.hs view
@@ -0,0 +1,641 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Language.Haskell.LSP.TH.ClientCapabilities where++import Data.Aeson.TH+-- import Data.Aeson.Types+import qualified Data.Aeson as A+-- import qualified Data.HashMap.Strict as H+-- import qualified Data.Text as T++import Language.Haskell.LSP.TH.Constants+-- import Language.Haskell.LSP.Utility+import Data.Default++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++WorkspaceClientCapabilites++define capabilities the editor / tool provides on the workspace:+/**+ * Workspace specific client capabilities.+ */+export interface WorkspaceClientCapabilites {+ /**+ * The client supports applying batch edits to the workspace by supporting+ * the request 'workspace/applyEdit'+ */+ applyEdit?: boolean;++ /**+ * Capabilities specific to `WorkspaceEdit`s+ */+ workspaceEdit?: {+ /**+ * The client supports versioned document changes in `WorkspaceEdit`s+ */+ documentChanges?: boolean;+ };++ /**+ * Capabilities specific to the `workspace/didChangeConfiguration` notification.+ */+ didChangeConfiguration?: {+ /**+ * Did change configuration notification supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `workspace/didChangeWatchedFiles` notification.+ */+ didChangeWatchedFiles?: {+ /**+ * Did change watched files notification supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `workspace/symbol` request.+ */+ symbol?: {+ /**+ * Symbol request supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `workspace/executeCommand` request.+ */+ executeCommand?: {+ /**+ * Execute command supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };+}+-}++-- -------------------------------------++data WorkspaceEditClientCapabilities =+ WorkspaceEditClientCapabilities+ { _documentChanges :: Maybe Bool -- ^The client supports versioned document+ -- changes in `WorkspaceEdit`s+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''WorkspaceEditClientCapabilities)++-- -------------------------------------++data DidChangeConfigurationClientCapabilities =+ DidChangeConfigurationClientCapabilities+ { _dynamicRegistration :: Maybe Bool -- ^Did change configuration+ -- notification supports dynamic+ -- registration.+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''DidChangeConfigurationClientCapabilities)++-- -------------------------------------++data DidChangeWatchedFilesClientCapabilities =+ DidChangeWatchedFilesClientCapabilities+ { _dynamicRegistration :: Maybe Bool -- ^Did change watched files+ -- notification supports dynamic+ -- registration.+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''DidChangeWatchedFilesClientCapabilities)++-- -------------------------------------++data SymbolClientCapabilities =+ SymbolClientCapabilities+ { _dynamicRegistration :: Maybe Bool -- ^Symbol request supports dynamic+ -- registration.+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''SymbolClientCapabilities)++-- -------------------------------------++data ExecuteClientCapabilities =+ ExecuteClientCapabilities+ { _dynamicRegistration :: Maybe Bool -- ^Execute command supports dynamic+ -- registration.+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''ExecuteClientCapabilities)++-- -------------------------------------++data WorkspaceClientCapabilites =+ WorkspaceClientCapabilites+ { -- | The client supports applying batch edits to the workspace by supporting+ -- the request 'workspace/applyEdit'+ _applyEdit :: Maybe Bool++ -- | Capabilities specific to `WorkspaceEdit`s+ , _workspaceEdit :: Maybe WorkspaceClientCapabilites++ -- | Capabilities specific to the `workspace/didChangeConfiguration` notification.+ , _didChangeConfiguration :: Maybe DidChangeConfigurationClientCapabilities++ -- | Capabilities specific to the `workspace/didChangeWatchedFiles` notification.+ , _didChangeWatchedFiles :: Maybe DidChangeWatchedFilesClientCapabilities++ -- | Capabilities specific to the `workspace/symbol` request.+ , _symbol :: Maybe SymbolClientCapabilities++ -- | Capabilities specific to the `workspace/executeCommand` request.+ , _executeCommand :: Maybe ExecuteClientCapabilities+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''WorkspaceClientCapabilites)++instance Default WorkspaceClientCapabilites where+ def = WorkspaceClientCapabilites def def def def def def++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++TextDocumentClientCapabilities+ define capabilities the editor / tool provides on text documents.++/**+ * Text document specific client capabilities.+ */+export interface TextDocumentClientCapabilities {++ synchronization?: {+ /**+ * Whether text document synchronization supports dynamic registration.+ */+ dynamicRegistration?: boolean;++ /**+ * The client supports sending will save notifications.+ */+ willSave?: boolean;++ /**+ * The client supports sending a will save request and+ * waits for a response providing text edits which will+ * be applied to the document before it is saved.+ */+ willSaveWaitUntil?: boolean;++ /**+ * The client supports did save notifications.+ */+ didSave?: boolean;+ }++ /**+ * Capabilities specific to the `textDocument/completion`+ */+ completion?: {+ /**+ * Whether completion supports dynamic registration.+ */+ dynamicRegistration?: boolean;++ /**+ * The client supports the following `CompletionItem` specific+ * capabilities.+ */+ completionItem?: {+ /**+ * Client supports snippets as insert text.+ *+ * A snippet can define tab stops and placeholders with `$1`, `$2`+ * and `${3:foo}`. `$0` defines the final tab stop, it defaults to+ * the end of the snippet. Placeholders with equal identifiers are linked,+ * that is typing in one will update others too.+ */+ snippetSupport?: boolean;+ }+ };++ /**+ * Capabilities specific to the `textDocument/hover`+ */+ hover?: {+ /**+ * Whether hover supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `textDocument/signatureHelp`+ */+ signatureHelp?: {+ /**+ * Whether signature help supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `textDocument/references`+ */+ references?: {+ /**+ * Whether references supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `textDocument/documentHighlight`+ */+ documentHighlight?: {+ /**+ * Whether document highlight supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `textDocument/documentSymbol`+ */+ documentSymbol?: {+ /**+ * Whether document symbol supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `textDocument/formatting`+ */+ formatting?: {+ /**+ * Whether formatting supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `textDocument/rangeFormatting`+ */+ rangeFormatting?: {+ /**+ * Whether range formatting supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `textDocument/onTypeFormatting`+ */+ onTypeFormatting?: {+ /**+ * Whether on type formatting supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `textDocument/definition`+ */+ definition?: {+ /**+ * Whether definition supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `textDocument/codeAction`+ */+ codeAction?: {+ /**+ * Whether code action supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `textDocument/codeLens`+ */+ codeLens?: {+ /**+ * Whether code lens supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `textDocument/documentLink`+ */+ documentLink?: {+ /**+ * Whether document link supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };++ /**+ * Capabilities specific to the `textDocument/rename`+ */+ rename?: {+ /**+ * Whether rename supports dynamic registration.+ */+ dynamicRegistration?: boolean;+ };+}++-}++-- -------------------------------------++-- TODO:AZ: this name is Java-ridiculously long+data SynchronizationTextDocumentClientCapabilities =+ SynchronizationTextDocumentClientCapabilities+ { -- | Whether text document synchronization supports dynamic registration.+ _dynamicRegistration :: Maybe Bool++ -- | The client supports sending will save notifications.+ , _willSave :: Maybe Bool++ -- | The client supports sending a will save request and waits for a+ -- response providing text edits which will be applied to the document+ -- before it is saved.+ , _willSaveWaitUntil :: Maybe Bool++ -- | The client supports did save notifications.+ , _didSave :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''SynchronizationTextDocumentClientCapabilities)++instance Default SynchronizationTextDocumentClientCapabilities where+ def = SynchronizationTextDocumentClientCapabilities def def def def++-- -------------------------------------++data CompletionItemClientCapabilities =+ CompletionItemClientCapabilities+ {+ -- | Client supports snippets as insert text.+ --+ -- A snippet can define tab stops and placeholders with `$1`, `$2` and+ -- `${3:foo}`. `$0` defines the final tab stop, it defaults to the end of+ -- the snippet. Placeholders with equal identifiers are linked, that is+ -- typing in one will update others too.+ _snippetSupport :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''CompletionItemClientCapabilities)++data CompletionClientCapabilities =+ CompletionClientCapabilities+ { _dynamicRegistration :: Maybe Bool -- ^Whether completion supports dynamic+ -- registration.+ , _completionItem :: Maybe CompletionItemClientCapabilities+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''CompletionClientCapabilities)++-- -------------------------------------++data HoverClientCapabilities =+ HoverClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''HoverClientCapabilities)++-- -------------------------------------++data SignatureHelpClientCapabilities =+ SignatureHelpClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''SignatureHelpClientCapabilities)++-- -------------------------------------++data ReferencesClientCapabilities =+ ReferencesClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''ReferencesClientCapabilities)++-- -------------------------------------++data DocumentHighlightClientCapabilities =+ DocumentHighlightClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''DocumentHighlightClientCapabilities)++-- -------------------------------------++data DocumentSymbolClientCapabilities =+ DocumentSymbolClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''DocumentSymbolClientCapabilities)++-- -------------------------------------++data FormattingClientCapabilities =+ FormattingClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''FormattingClientCapabilities)++-- -------------------------------------++data RangeFormattingClientCapabilities =+ RangeFormattingClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''RangeFormattingClientCapabilities)++-- -------------------------------------++data OnTypeFormattingClientCapabilities =+ OnTypeFormattingClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''OnTypeFormattingClientCapabilities)++-- -------------------------------------++data DefinitionClientCapabilities =+ DefinitionClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''DefinitionClientCapabilities)++-- -------------------------------------++data CodeActionClientCapabilities =+ CodeActionClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''CodeActionClientCapabilities)++-- -------------------------------------++data CodeLensClientCapabilities =+ CodeLensClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''CodeLensClientCapabilities)++-- -------------------------------------++data DocumentLinkClientCapabilities =+ DocumentLinkClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''DocumentLinkClientCapabilities)++-- -------------------------------------++data RenameClientCapabilities =+ RenameClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''RenameClientCapabilities)++-- -------------------------------------++data TextDocumentClientCapabilities =+ TextDocumentClientCapabilities+ { _synchronization :: Maybe SynchronizationTextDocumentClientCapabilities++ -- | Capabilities specific to the `textDocument/completion`+ , _completion :: Maybe CompletionClientCapabilities++ -- | Capabilities specific to the `textDocument/hover`+ , _hover :: Maybe HoverClientCapabilities++ -- | Capabilities specific to the `textDocument/signatureHelp`+ , _signatureHelp :: Maybe SignatureHelpClientCapabilities++ -- | Capabilities specific to the `textDocument/references`+ , _references :: Maybe ReferencesClientCapabilities++ -- | Capabilities specific to the `textDocument/documentHighlight`+ , _documentHighlight :: Maybe DocumentHighlightClientCapabilities++ -- | Capabilities specific to the `textDocument/documentSymbol`+ , _documentSymbol :: Maybe DocumentSymbolClientCapabilities++ -- | Capabilities specific to the `textDocument/formatting`+ , _formatting :: Maybe FormattingClientCapabilities++ -- | Capabilities specific to the `textDocument/rangeFormatting`+ , _rangeFormatting :: Maybe RangeFormattingClientCapabilities++ -- | Capabilities specific to the `textDocument/onTypeFormatting`+ , _onTypeFormatting :: Maybe OnTypeFormattingClientCapabilities++ -- | Capabilities specific to the `textDocument/definition`+ , _definition :: Maybe DefinitionClientCapabilities++ -- | Capabilities specific to the `textDocument/codeAction`+ , _codeAction :: Maybe CodeActionClientCapabilities++ -- | Capabilities specific to the `textDocument/codeLens`+ , _codeLens :: Maybe CodeLensClientCapabilities++ -- | Capabilities specific to the `textDocument/documentLink`+ , _documentLink :: Maybe DocumentLinkClientCapabilities++ -- | Capabilities specific to the `textDocument/rename`+ , _rename :: Maybe RenameClientCapabilities+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''TextDocumentClientCapabilities)++instance Default TextDocumentClientCapabilities where+ def = TextDocumentClientCapabilities def def def def def def def+ def def def def def def def def++-- ---------------------------------------------------------------------+{-+New in 3.0++-----------++ClientCapabilities++now define capabilities for dynamic registration, workspace and text document+features the client supports. The experimental can be used to pass experimential+capabilities under development. For future compatibility a ClientCapabilities+object literal can have more properties set than currently defined. Servers+receiving a ClientCapabilities object literal with unknown properties should+ignore these properties. A missing property should be interpreted as an absence+of the capability. If a property is missing that defines sub properties all sub+properties should be interpreted as an absence of the capability.++Client capabilities got introduced with the version 3.0 of the protocol. They+therefore only describe capabilities that got introduced in 3.x or later.+Capabilities that existed in the 2.x version of the protocol are still mandatory+for clients. Clients cannot opt out of providing them. So even if a client omits+the ClientCapabilities.textDocument.synchronization it is still required that+the client provides text document synchronization (e.g. open, changed and close+notifications).++interface ClientCapabilities {+ /**+ * Workspace specific client capabilities.+ */+ workspace?: WorkspaceClientCapabilites;++ /**+ * Text document specific client capabilities.+ */+ textDocument?: TextDocumentClientCapabilities;++ /**+ * Experimental client capabilities.+ */+ experimental?: any;+}+-}++data ClientCapabilities =+ ClientCapabilities+ { _workspace :: Maybe WorkspaceClientCapabilites+ , _textDocument :: Maybe TextDocumentClientCapabilities+ , _experimental :: Maybe A.Object+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''ClientCapabilities)++instance Default ClientCapabilities where+ def = ClientCapabilities def def def
+ src/Language/Haskell/LSP/TH/Constants.hs view
@@ -0,0 +1,17 @@++module Language.Haskell.LSP.TH.Constants where++import Data.Aeson.TH++-- ---------------------------------------------------------------------++-- | Standard options for use when generating JSON instances+lspOptions :: Options+lspOptions = defaultOptions { omitNothingFields = True, fieldLabelModifier = drop 1 }+ -- NOTE: This needs to be in a separate file because of the TH stage restriction++customModifier :: String -> String+customModifier "_xdata" = "data"+customModifier "_xtype" = "type"+customModifier xs = drop 1 xs+
+ src/Language/Haskell/LSP/TH/DataTypesJSON.hs view
@@ -0,0 +1,4164 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Language.Haskell.LSP.TH.DataTypesJSON where++import Control.Lens.TH ( makeFieldsNoPrefix )+import Data.Aeson.TH+import Data.Aeson.Types+import qualified Data.Aeson as A+import qualified Data.HashMap.Strict as H+import Data.Hashable+import qualified Data.Text as T+import Data.Text ( Text )+import Data.Monoid ( (<>) )+import System.IO ( FilePath )++import Language.Haskell.LSP.TH.ClientCapabilities+import Language.Haskell.LSP.TH.Constants+import Language.Haskell.LSP.Utility++-- ---------------------------------------------------------------------++-- | This data type is used to host a FromJSON instance for the encoding used by+-- elisp, where an empty list shows up as "null"+newtype List a = List [a]+ deriving (Show,Read,Eq,Monoid)++instance (A.ToJSON a) => A.ToJSON (List a) where+ toJSON (List ls) = toJSON ls++instance (A.FromJSON a) => A.FromJSON (List a) where+ parseJSON A.Null = return (List [])+ parseJSON v = List <$> parseJSON v++-- ---------------------------------------------------------------------++newtype Uri = Uri { getUri :: Text }+ deriving (Eq,Ord,Read,Show,A.FromJSON,A.ToJSON,Hashable,A.ToJSONKey,A.FromJSONKey)++uriToFilePath :: Uri -> Maybe FilePath+uriToFilePath (Uri uri)+ | "file://" `T.isPrefixOf` uri = Just $ T.unpack $ T.drop n uri+ | otherwise = Nothing+ where n = T.length "file://"++filePathToUri :: FilePath -> Uri+filePathToUri file = Uri $ T.pack $ "file://" ++ file++-- ---------------------------------------------------------------------++-- | Id used for a request, Can be either a String or an Int+data LspId = IdInt Int | IdString Text+ deriving (Show,Read,Eq,Ord)++instance A.ToJSON LspId where+ toJSON (IdInt i) = toJSON i+ toJSON (IdString s) = toJSON s++instance A.FromJSON LspId where+ parseJSON v@(A.Number _) = IdInt <$> parseJSON v+ parseJSON (A.String s) = return (IdString s)+ parseJSON _ = mempty++-- ---------------------------------------------------------------------++-- | Id used for a response, Can be either a String or an Int, or Null. If a+-- request doesn't provide a result value the receiver of a request still needs+-- to return a response message to conform to the JSON RPC specification. The+-- result property of the ResponseMessage should be set to null in this case to+-- signal a successful request.+data LspIdRsp = IdRspInt Int | IdRspString Text | IdRspNull+ deriving (Show,Read,Eq)++instance A.ToJSON LspIdRsp where+ toJSON (IdRspInt i) = toJSON i+ toJSON (IdRspString s) = toJSON s+ toJSON IdRspNull = A.Null++instance A.FromJSON LspIdRsp where+ parseJSON v@(A.Number _) = IdRspInt <$> parseJSON v+ parseJSON (A.String s) = return $ IdRspString s+ parseJSON A.Null = return IdRspNull+ parseJSON _ = mempty++responseId :: LspId -> LspIdRsp+responseId (IdInt i) = (IdRspInt i)+responseId (IdString s) = (IdRspString s)++-- ---------------------------------------------------------------------++-- Client Methods+data ClientMethod =+ -- General+ Initialize+ | Initialized+ | Shutdown+ | Exit+ | CancelRequest+ -- Workspace+ | WorkspaceDidChangeConfiguration+ | WorkspaceDidChangeWatchedFiles+ | WorkspaceSymbol+ | WorkspaceExecuteCommand+ -- Document+ | TextDocumentDidOpen+ | TextDocumentDidChange+ | TextDocumentWillSave+ | TextDocumentWillSaveWaitUntil+ | TextDocumentDidSave+ | TextDocumentDidClose+ | TextDocumentCompletion+ | CompletionItemResolve+ | TextDocumentHover+ | TextDocumentSignatureHelp+ | TextDocumentReferences+ | TextDocumentDocumentHighlight+ | TextDocumentDocumentSymbol+ | TextDocumentFormatting+ | TextDocumentRangeFormatting+ | TextDocumentOnTypeFormatting+ | TextDocumentDefinition+ | TextDocumentCodeAction+ | TextDocumentCodeLens+ | CodeLensResolve+ | TextDocumentDocumentLink+ | DocumentLinkResolve+ | TextDocumentRename+ -- Messages of the form $/message+ -- Implementation Dependent, can be ignored+ | Misc Text+ deriving (Eq,Ord,Read,Show)++instance A.FromJSON ClientMethod where+ -- General+ parseJSON (A.String "initialize") = return Initialize+ parseJSON (A.String "initialized") = return Initialized+ parseJSON (A.String "shutdown") = return Shutdown+ parseJSON (A.String "exit") = return Exit+ parseJSON (A.String "$/cancelRequest") = return CancelRequest+ -- Workspace+ parseJSON (A.String "workspace/didChangeConfiguration") = return WorkspaceDidChangeConfiguration+ parseJSON (A.String "workspace/didChangeWatchedFiles") = return WorkspaceDidChangeWatchedFiles+ parseJSON (A.String "workspace/symbol") = return WorkspaceSymbol+ parseJSON (A.String "workspace/executeCommand") = return WorkspaceExecuteCommand+ -- Document+ parseJSON (A.String "textDocument/didOpen") = return TextDocumentDidOpen+ parseJSON (A.String "textDocument/didChange") = return TextDocumentDidChange+ parseJSON (A.String "textDocument/willSave") = return TextDocumentWillSave+ parseJSON (A.String "textDocument/willSaveWaitUntil") = return TextDocumentWillSaveWaitUntil+ parseJSON (A.String "textDocument/didSave") = return TextDocumentDidSave+ parseJSON (A.String "textDocument/didClose") = return TextDocumentDidClose+ parseJSON (A.String "textDocument/completion") = return TextDocumentCompletion+ parseJSON (A.String "completionItem/resolve") = return CompletionItemResolve+ parseJSON (A.String "textDocument/hover") = return TextDocumentHover+ parseJSON (A.String "textDocument/signatureHelp") = return TextDocumentSignatureHelp+ parseJSON (A.String "textDocument/references") = return TextDocumentReferences+ parseJSON (A.String "textDocument/documentHighlight") = return TextDocumentDocumentHighlight+ parseJSON (A.String "textDocument/documentSymbol") = return TextDocumentDocumentSymbol+ parseJSON (A.String "textDocument/formatting") = return TextDocumentFormatting+ parseJSON (A.String "textDocument/rangeFormatting") = return TextDocumentRangeFormatting+ parseJSON (A.String "textDocument/onTypeFormatting") = return TextDocumentOnTypeFormatting+ parseJSON (A.String "textDocument/definition") = return TextDocumentDefinition+ parseJSON (A.String "textDocument/codeAction") = return TextDocumentCodeAction+ parseJSON (A.String "textDocument/codeLens") = return TextDocumentCodeLens+ parseJSON (A.String "codeLens/resolve") = return CodeLensResolve+ parseJSON (A.String "textDocument/documentLink") = return TextDocumentDocumentLink+ parseJSON (A.String "documentLink/resolve") = return DocumentLinkResolve+ parseJSON (A.String "textDocument/rename") = return TextDocumentRename+ parseJSON (A.String x) = if T.isPrefixOf "$/" x+ then return $ Misc (T.drop 2 x)+ else mempty+ parseJSON _ = mempty++instance A.ToJSON ClientMethod where+ -- General+ toJSON Initialize = A.String "initialize"+ toJSON Initialized = A.String "initialized"+ toJSON Shutdown = A.String "shutdown"+ toJSON Exit = A.String "exit"+ toJSON CancelRequest = A.String "$/cancelRequest"+ -- Workspace+ toJSON WorkspaceDidChangeConfiguration = A.String "workspace/didChangeConfiguration"+ toJSON WorkspaceDidChangeWatchedFiles = A.String "workspace/didChangeWatchedFiles"+ toJSON WorkspaceSymbol = A.String "workspace/symbol"+ toJSON WorkspaceExecuteCommand = A.String "workspace/executeCommand"+ -- Document+ toJSON TextDocumentDidOpen = A.String "textDocument/didOpen"+ toJSON TextDocumentDidChange = A.String "textDocument/didChange"+ toJSON TextDocumentWillSave = A.String "textDocument/willSave"+ toJSON TextDocumentWillSaveWaitUntil = A.String "textDocument/willSaveWaitUntil"+ toJSON TextDocumentDidSave = A.String "textDocument/didSave"+ toJSON TextDocumentDidClose = A.String "textDocument/didClose"+ toJSON TextDocumentCompletion = A.String "textDocument/completion"+ toJSON CompletionItemResolve = A.String "completionItem/resolve"+ toJSON TextDocumentHover = A.String "textDocument/hover"+ toJSON TextDocumentSignatureHelp = A.String "textDocument/signatureHelp"+ toJSON TextDocumentReferences = A.String "textDocument/references"+ toJSON TextDocumentDocumentHighlight = A.String "textDocument/documentHighlight"+ toJSON TextDocumentDocumentSymbol = A.String "textDocument/documentSymbol"+ toJSON TextDocumentFormatting = A.String "textDocument/formatting"+ toJSON TextDocumentRangeFormatting = A.String "textDocument/rangeFormatting"+ toJSON TextDocumentOnTypeFormatting = A.String "textDocument/onTypeFormatting"+ toJSON TextDocumentDefinition = A.String "textDocument/definition"+ toJSON TextDocumentCodeAction = A.String "textDocument/codeAction"+ toJSON TextDocumentCodeLens = A.String "textDocument/codeLens"+ toJSON CodeLensResolve = A.String "codeLens/resolve"+ toJSON TextDocumentRename = A.String "textDocument/rename"+ toJSON TextDocumentDocumentLink = A.String "textDocument/documentLink"+ toJSON DocumentLinkResolve = A.String "documentLink/resolve"+ toJSON (Misc xs) = A.String $ "$/" <> xs++data ServerMethod =+ -- Window+ WindowShowMessage+ | WindowShowMessageRequest+ | WindowLogMessage+ | TelemetryEvent+ -- Client+ | ClientRegisterCapability+ | ClientUnregisterCapability+ -- Workspace+ | WorkspaceApplyEdit+ -- Document+ | TextDocumentPublishDiagnostics+ deriving (Eq,Ord,Read,Show)++instance A.FromJSON ServerMethod where+ -- Window+ parseJSON (A.String "window/showMessage") = return WindowShowMessage+ parseJSON (A.String "window/showMessageRequest") = return WindowShowMessageRequest+ parseJSON (A.String "window/logMessage") = return WindowLogMessage+ parseJSON (A.String "telemetry/event") = return TelemetryEvent+ -- Client+ parseJSON (A.String "client/registerCapability") = return ClientRegisterCapability+ parseJSON (A.String "client/unregisterCapability") = return ClientUnregisterCapability+ -- Workspace+ parseJSON (A.String "workspace/applyEdit") = return WorkspaceApplyEdit+ -- Document+ parseJSON (A.String "textDocument/publishDiagnostics") = return TextDocumentPublishDiagnostics+ parseJSON _ = mempty++instance A.ToJSON ServerMethod where+ -- Window+ toJSON WindowShowMessage = A.String "window/showMessage"+ toJSON WindowShowMessageRequest = A.String "window/showMessageRequest"+ toJSON WindowLogMessage = A.String "window/logMessage"+ toJSON TelemetryEvent = A.String "telemetry/event"+ -- Client+ toJSON ClientRegisterCapability = A.String "client/registerCapability"+ toJSON ClientUnregisterCapability = A.String "client/unregisterCapability"+ -- Workspace+ toJSON WorkspaceApplyEdit = A.String "workspace/applyEdit"+ -- Document+ toJSON TextDocumentPublishDiagnostics = A.String "textDocument/publishDiagnostics"++data RequestMessage m req resp =+ RequestMessage+ { _jsonrpc :: Text+ , _id :: LspId+ , _method :: m+ , _params :: req+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''RequestMessage)+makeFieldsNoPrefix ''RequestMessage++-- ---------------------------------------------------------------------+{-+interface ResponseError<D> {+ /**+ * A number indicating the error type that occurred.+ */+ code: number;++ /**+ * A string providing a short description of the error.+ */+ message: string;++ /**+ * A Primitive or Structured value that contains additional+ * information about the error. Can be omitted.+ */+ data?: D;+}++export namespace ErrorCodes {+ // Defined by JSON RPC+ export const ParseError: number = -32700;+ export const InvalidRequest: number = -32600;+ export const MethodNotFound: number = -32601;+ export const InvalidParams: number = -32602;+ export const InternalError: number = -32603;+ export const serverErrorStart: number = -32099;+ export const serverErrorEnd: number = -32000;+ export const ServerNotInitialized: number = -32002;+ export const UnknownErrorCode: number = -32001;++ // Defined by the protocol.+ export const RequestCancelled: number = -32800;+}+-}++data ErrorCode = ParseError+ | InvalidRequest+ | MethodNotFound+ | InvalidParams+ | InternalError+ -- ^ Note: server error codes are reserved from -32099 to -32000+ deriving (Read,Show,Eq)++instance A.ToJSON ErrorCode where+ toJSON ParseError = A.Number (-32700)+ toJSON InvalidRequest = A.Number (-32600)+ toJSON MethodNotFound = A.Number (-32601)+ toJSON InvalidParams = A.Number (-32602)+ toJSON InternalError = A.Number (-32603)++instance A.FromJSON ErrorCode where+ parseJSON (A.Number (-32700)) = pure ParseError+ parseJSON (A.Number (-32600)) = pure InvalidRequest+ parseJSON (A.Number (-32601)) = pure MethodNotFound+ parseJSON (A.Number (-32602)) = pure InvalidParams+ parseJSON (A.Number (-32603)) = pure InternalError+ parseJSON _ = mempty++-- -------------------------------------++data ResponseError =+ ResponseError+ { _code :: ErrorCode+ , _message :: Text+ , _xdata :: Maybe A.Value+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions{ fieldLabelModifier = customModifier } ''ResponseError)+makeFieldsNoPrefix ''ResponseError++-- ---------------------------------------------------------------------++data ResponseMessage a =+ ResponseMessage+ { _jsonrpc :: Text+ , _id :: LspIdRsp+ , _result :: Maybe a+ , _error :: Maybe ResponseError+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''ResponseMessage)+makeFieldsNoPrefix ''ResponseMessage++type ErrorResponse = ResponseMessage ()++-- ---------------------------------------------------------------------++type BareResponseMessage = ResponseMessage A.Value++-- ---------------------------------------------------------------------+{-+$ Notifications and Requests++Notification and requests ids starting with '$/' are messages which are protocol+implementation dependent and might not be implementable in all clients or+servers. For example if the server implementation uses a single threaded+synchronous programming language then there is little a server can do to react+to a '$/cancelRequest'. If a server or client receives notifications or requests+starting with '$/' it is free to ignore them if they are unknown.+-}++data NotificationMessage m a =+ NotificationMessage+ { _jsonrpc :: Text+ , _method :: m+ , _params :: a+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''NotificationMessage)+makeFieldsNoPrefix ''NotificationMessage++-- ---------------------------------------------------------------------+{-+Cancellation Support++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#cancellation-support++ New: The base protocol now offers support for request cancellation. To+ cancel a request, a notification message with the following properties is+ sent:++Notification:++ method: '$/cancelRequest'+ params: CancelParams defined as follows:++interface CancelParams {+ /**+ * The request id to cancel.+ */+ id: number | string;+}++A request that got canceled still needs to return from the server and send a+response back. It can not be left open / hanging. This is in line with the JSON+RPC protocol that requires that every request sends a response back. In addition+it allows for returning partial results on cancel.+-}++data CancelParams =+ CancelParams+ { _id :: LspId+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''CancelParams)+makeFieldsNoPrefix ''CancelParams++type CancelNotification = NotificationMessage ClientMethod CancelParams++-- ---------------------------------------------------------------------++{-+The current protocol is talored for textual documents which content can be+represented as a string. There is currently no support for binary documents.+Positions inside a document (see Position definition below) are expressed as a+zero-based line and character offset. To ensure that both client and server+split the string into the same line representation the protocol specs the+following end of line sequences: '\n', '\r\n' and '\r'.++export const EOL: string[] = ['\n', '\r\n', '\r'];+-}+{-+https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#position++Position in a text document expressed as zero-based line and character offset. A+position is between two characters like an 'insert' cursor in a editor.++interface Position {+ /**+ * Line position in a document (zero-based).+ */+ line: number;++ /**+ * Character offset on a line in a document (zero-based).+ */+ character: number;+}+-}+data Position =+ Position+ { _line :: Int+ , _character :: Int+ } deriving (Show, Read, Eq, Ord)++$(deriveJSON lspOptions ''Position)+makeFieldsNoPrefix ''Position++-- ---------------------------------------------------------------------+{-+https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#range++A range in a text document expressed as (zero-based) start and end positions. A+range is comparable to a selection in an editor. Therefore the end position is+exclusive.++interface Range {+ /**+ * The range's start position.+ */+ start: Position;++ /**+ * The range's end position.+ */+ end: Position;+}+-}++data Range =+ Range+ { _start :: Position+ , _end :: Position+ } deriving (Show, Read, Eq, Ord)++$(deriveJSON lspOptions ''Range)+makeFieldsNoPrefix ''Range++-- ---------------------------------------------------------------------+{-+https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#location++Represents a location inside a resource, such as a line inside a text file.++interface Location {+ uri: string;+ range: Range;+}+-}++data Location =+ Location+ { _uri :: Uri+ , _range :: Range+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''Location)+makeFieldsNoPrefix ''Location++-- ---------------------------------------------------------------------+{-+The protocol currently supports the following diagnostic severities:++enum DiagnosticSeverity {+ /**+ * Reports an error.+ */+ Error = 1,+ /**+ * Reports a warning.+ */+ Warning = 2,+ /**+ * Reports an information.+ */+ Information = 3,+ /**+ * Reports a hint.+ */+ Hint = 4+}+-}+data DiagnosticSeverity+ = DsError -- ^ Error = 1,+ | DsWarning -- ^ Warning = 2,+ | DsInfo -- ^ Info = 3,+ | DsHint -- ^ Hint = 4+ deriving (Eq,Ord,Show,Read)++instance A.ToJSON DiagnosticSeverity where+ toJSON DsError = A.Number 1+ toJSON DsWarning = A.Number 2+ toJSON DsInfo = A.Number 3+ toJSON DsHint = A.Number 4++instance A.FromJSON DiagnosticSeverity where+ parseJSON (A.Number 1) = pure DsError+ parseJSON (A.Number 2) = pure DsWarning+ parseJSON (A.Number 3) = pure DsInfo+ parseJSON (A.Number 4) = pure DsHint+ parseJSON _ = mempty++-- ---------------------------------------------------------------------+{-+Diagnostic++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#diagnostic++Represents a diagnostic, such as a compiler error or warning. Diagnostic objects+are only valid in the scope of a resource.++interface Diagnostic {+ /**+ * The range at which the message applies.+ */+ range: Range;++ /**+ * The diagnostic's severity. Can be omitted. If omitted it is up to the+ * client to interpret diagnostics as error, warning, info or hint.+ */+ severity?: number;++ /**+ * The diagnostic's code. Can be omitted.+ */+ code?: number | string;++ /**+ * A human-readable string describing the source of this+ * diagnostic, e.g. 'typescript' or 'super lint'.+ */+ source?: string;++ /**+ * The diagnostic's message.+ */+ message: string;+}+-}++type DiagnosticSource = Text+data Diagnostic =+ Diagnostic+ { _range :: Range+ , _severity :: Maybe DiagnosticSeverity+ , _code :: Maybe Text -- Note: Protocol allows Int too.+ , _source :: Maybe DiagnosticSource+ , _message :: Text+ } deriving (Show, Read, Eq, Ord)++$(deriveJSON lspOptions ''Diagnostic)+makeFieldsNoPrefix ''Diagnostic++-- ---------------------------------------------------------------------+{-+Command++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#command++Represents a reference to a command. Provides a title which will be used to+represent a command in the UI. Commands are identitifed using a string+identifier and the protocol currently doesn't specify a set of well known+commands. So executing a command requires some tool extension code.++interface Command {+ /**+ * Title of the command, like `save`.+ */+ title: string;+ /**+ * The identifier of the actual command handler.+ */+ command: string;+ /**+ * Arguments that the command handler should be+ * invoked with.+ */+ arguments?: any[];+}+-}++data Command =+ Command+ { _title :: Text+ , _command :: Text+ , _arguments :: Maybe A.Value+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''Command)+makeFieldsNoPrefix ''Command++-- ---------------------------------------------------------------------+{-+TextEdit++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#textedit++A textual edit applicable to a text document.++interface TextEdit {+ /**+ * The range of the text document to be manipulated. To insert+ * text into a document create a range where start === end.+ */+ range: Range;++ /**+ * The string to be inserted. For delete operations use an+ * empty string.+ */+ newText: string;+}+++-}++data TextEdit =+ TextEdit+ { _range :: Range+ , _newText :: Text+ } deriving (Show,Read,Eq)++$(deriveJSON lspOptions ''TextEdit)+makeFieldsNoPrefix ''TextEdit++-- ---------------------------------------------------------------------+{-+VersionedTextDocumentIdentifier++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#versionedtextdocumentidentifier++ New: An identifier to denote a specific version of a text document.++interface VersionedTextDocumentIdentifier extends TextDocumentIdentifier {+ /**+ * The version number of this document.+ */+ version: number;+-}++type TextDocumentVersion = Int++data VersionedTextDocumentIdentifier =+ VersionedTextDocumentIdentifier+ { _uri :: Uri+ , _version :: TextDocumentVersion+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''VersionedTextDocumentIdentifier)+makeFieldsNoPrefix ''VersionedTextDocumentIdentifier++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++TextDocumentEdit+https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#new-textdocumentedit++If multiple TextEdits are applied to a text document, all text edits describe+changes made to the initial document version. Execution wise text edits should+applied from the bottom to the top of the text document. Overlapping text edits+are not supported.++export interface TextDocumentEdit {+ /**+ * The text document to change.+ */+ textDocument: VersionedTextDocumentIdentifier;++ /**+ * The edits to be applied.+ */+ edits: TextEdit[];+}++-}++data TextDocumentEdit =+ TextDocumentEdit+ { _textDocument :: VersionedTextDocumentIdentifier+ , _edits :: List TextEdit+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''TextDocumentEdit)+makeFieldsNoPrefix ''TextDocumentEdit++-- ---------------------------------------------------------------------+{-+Changed in 3.0+--------------++WorkspaceEdit++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#workspaceedit+++Changed A workspace edit represents changes to many resources managed in the+workspace. The edit should either provide changes or documentChanges. If+documentChanges are present they are preferred over changes if the client can+handle versioned document edits.++export interface WorkspaceEdit {+ /**+ * Holds changes to existing resources.+ */+ changes?: { [uri: string]: TextEdit[]; };++ /**+ * An array of `TextDocumentEdit`s to express changes to specific a specific+ * version of a text document. Whether a client supports versioned document+ * edits is expressed via `WorkspaceClientCapabilites.versionedWorkspaceEdit`.+ */+ documentChanges?: TextDocumentEdit[];+}+-}++type WorkspaceEditMap = H.HashMap Uri (List TextEdit)++data WorkspaceEdit =+ WorkspaceEdit+ { _changes :: Maybe WorkspaceEditMap+ , _documentChanges :: Maybe (List TextDocumentEdit)+ } deriving (Show, Read, Eq)++instance Monoid WorkspaceEdit where+ mempty = WorkspaceEdit Nothing Nothing+ mappend (WorkspaceEdit a b) (WorkspaceEdit c d) = WorkspaceEdit (a <> c) (b <> d)++$(deriveJSON lspOptions ''WorkspaceEdit)+makeFieldsNoPrefix ''WorkspaceEdit++-- ---------------------------------------------------------------------+{-+TextDocumentIdentifier++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#textdocumentidentifier++Text documents are identified using a URI. On the protocol level, URIs are+passed as strings. The corresponding JSON structure looks like this:++interface TextDocumentIdentifier {+ /**+ * The text document's URI.+ */+ uri: string;+}+-}+data TextDocumentIdentifier =+ TextDocumentIdentifier+ { _uri :: Uri+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''TextDocumentIdentifier)+makeFieldsNoPrefix ''TextDocumentIdentifier++-- ---------------------------------------------------------------------++{-+TextDocumentItem++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#textdocumentitem++ New: An item to transfer a text document from the client to the server.++interface TextDocumentItem {+ /**+ * The text document's URI.+ */+ uri: string;++ /**+ * The text document's language identifier.+ */+ languageId: string;++ /**+ * The version number of this document (it will strictly increase after each+ * change, including undo/redo).+ */+ version: number;++ /**+ * The content of the opened text document.+ */+ text: string;+}+-}++data TextDocumentItem =+ TextDocumentItem {+ _uri :: Uri+ , _languageId :: Text+ , _version :: Int+ , _text :: Text+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''TextDocumentItem)+makeFieldsNoPrefix ''TextDocumentItem++-- ---------------------------------------------------------------------+{-+TextDocumentPositionParams++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#textdocumentpositionparams++ Changed: Was TextDocumentPosition in 1.0 with inlined parameters+++interface TextDocumentPositionParams {+ /**+ * The text document.+ */+ textDocument: TextDocumentIdentifier;++ /**+ * The position inside the text document.+ */+ position: Position;+}++-}+data TextDocumentPositionParams =+ TextDocumentPositionParams+ { _textDocument :: TextDocumentIdentifier+ , _position :: Position+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''TextDocumentPositionParams)+makeFieldsNoPrefix ''TextDocumentPositionParams++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++DocumentFilter+https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#new-documentfilter++A document filter denotes a document through properties like language, schema or+pattern. Examples are a filter that applies to TypeScript files on disk or a+filter the applies to JSON files with name package.json:++ { language: 'typescript', scheme: 'file' }+ { language: 'json', pattern: '**/package.json' }++export interface DocumentFilter {+ /**+ * A language id, like `typescript`.+ */+ language?: string;++ /**+ * A Uri [scheme](#Uri.scheme), like `file` or `untitled`.+ */+ scheme?: string;++ /**+ * A glob pattern, like `*.{ts,js}`.+ */+ pattern?: string;+}+-}+data DocumentFilter =+ DocumentFilter+ { _language :: Text+ , _scheme :: Text+ , _pattern :: Maybe Text+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''DocumentFilter)+makeFieldsNoPrefix ''DocumentFilter++{-+A document selector is the combination of one or many document filters.++export type DocumentSelector = DocumentFilter[];+-}+type DocumentSelector = List DocumentFilter++-- =====================================================================+-- ACTUAL PROTOCOL -----------------------------------------------------+-- =====================================================================++-- ---------------------------------------------------------------------+-- Initialize Request+-- ---------------------------------------------------------------------+{-+Initialize Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#initialize-request++The initialize request is sent as the first request from the client to the server.++Request++ method: 'initialize'+ params: InitializeParams defined as follows:++interface InitializeParams {+ /**+ * The process Id of the parent process that started+ * the server. Is null if the process has not been started by another process.+ * If the parent process is not alive then the server should exit (see exit notification) its process.+ */+ processId: number | null;++ /**+ * The rootPath of the workspace. Is null+ * if no folder is open.+ *+ * @deprecated in favour of rootUri.+ */+ rootPath?: string | null;++ /**+ * The rootUri of the workspace. Is null if no+ * folder is open. If both `rootPath` and `rootUri` are set+ * `rootUri` wins.+ */+ rootUri: DocumentUri | null;++ /**+ * User provided initialization options.+ */+ initializationOptions?: any;++ /**+ * The capabilities provided by the client (editor or tool)+ */+ capabilities: ClientCapabilities;++ /**+ * The initial trace setting. If omitted trace is disabled ('off').+ */+ trace?: 'off' | 'messages' | 'verbose';+}+-}++data Trace = TraceOff | TraceMessages | TraceVerbose+ deriving (Show, Read, Eq)++instance A.ToJSON Trace where+ toJSON TraceOff = A.String (T.pack "off")+ toJSON TraceMessages = A.String (T.pack "messages")+ toJSON TraceVerbose = A.String (T.pack "verbose")++instance A.FromJSON Trace where+ parseJSON (A.String s) = case T.unpack s of+ "off" -> return TraceOff+ "messages" -> return TraceMessages+ "verbose" -> return TraceVerbose+ _ -> mempty+ parseJSON _ = mempty++data InitializeParams =+ InitializeParams {+ _processId :: Maybe Int+ , _rootPath :: Maybe Text -- ^ Deprecated in favour of _rootUri+ , _rootUri :: Maybe Uri+ , _initializationOptions :: Maybe A.Value+ , _capabilities :: ClientCapabilities+ , _trace :: Maybe Trace+ } deriving (Show, Read, Eq)+++$(deriveJSON lspOptions ''InitializeParams)+makeFieldsNoPrefix ''InitializeParams++-- ---------------------------------------------------------------------+-- Initialize Response+-- ---------------------------------------------------------------------+{-++ error.data:++interface InitializeError {+ /**+ * Indicates whether the client should retry to send the+ * initilize request after showing the message provided+ * in the ResponseError.+ */+ retry: boolean;+-+-}+data InitializeError =+ InitializeError+ { _retry :: Bool+ } deriving (Read, Show, Eq)++$(deriveJSON lspOptions ''InitializeError)+makeFieldsNoPrefix ''InitializeError++-- ---------------------------------------------------------------------+{-+The server can signal the following capabilities:++/**+ * Defines how the host (editor) should sync document changes to the language server.+ */+enum TextDocumentSyncKind {+ /**+ * Documents should not be synced at all.+ */+ None = 0,+ /**+ * Documents are synced by always sending the full content of the document.+ */+ Full = 1,+ /**+ * Documents are synced by sending the full content on open. After that only incremental+ * updates to the document are sent.+ */+ Incremental = 2+}+-}++-- ^ Note: Omitting this parameter from the capabilities is effectively a fourth+-- state, where DidSave events are generated without sending document contents.+data TextDocumentSyncKind = TdSyncNone+ | TdSyncFull+ | TdSyncIncremental+ deriving (Read,Eq,Show)++instance A.ToJSON TextDocumentSyncKind where+ toJSON TdSyncNone = A.Number 0+ toJSON TdSyncFull = A.Number 1+ toJSON TdSyncIncremental = A.Number 2++instance A.FromJSON TextDocumentSyncKind where+ parseJSON (A.Number 0) = pure TdSyncNone+ parseJSON (A.Number 1) = pure TdSyncFull+ parseJSON (A.Number 2) = pure TdSyncIncremental+ parseJSON _ = mempty++-- ---------------------------------------------------------------------+{-+/**+ * Completion options.+ */+interface CompletionOptions {+ /**+ * The server provides support to resolve additional information for a completion item.+ */+ resolveProvider?: boolean;++ /**+ * The characters that trigger completion automatically.+ */+ triggerCharacters?: string[];+}+-}++data CompletionOptions =+ CompletionOptions+ { _resolveProvider :: Maybe Bool+ , _triggerCharacters :: Maybe [String]+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions {omitNothingFields = True } ''CompletionOptions)+makeFieldsNoPrefix ''CompletionOptions++-- ---------------------------------------------------------------------+{-+/**+ * Signature help options.+ */+interface SignatureHelpOptions {+ /**+ * The characters that trigger signature help automatically.+ */+ triggerCharacters?: string[];+-}++data SignatureHelpOptions =+ SignatureHelpOptions+ { _triggerCharacters :: Maybe [String]+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''SignatureHelpOptions)+makeFieldsNoPrefix ''SignatureHelpOptions++-- ---------------------------------------------------------------------+{-+/**+ * Code Lens options.+ */+interface CodeLensOptions {+ /**+ * Code lens has a resolve provider as well.+ */+ resolveProvider?: boolean;+}+-}++data CodeLensOptions =+ CodeLensOptions+ { _resolveProvider :: Maybe Bool+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''CodeLensOptions)+makeFieldsNoPrefix ''CodeLensOptions++-- ---------------------------------------------------------------------+{-+/**+ * Format document on type options+ */+interface DocumentOnTypeFormattingOptions {+ /**+ * A character on which formatting should be triggered, like `}`.+ */+ firstTriggerCharacter: string;+ /**+ * More trigger characters.+ */+ moreTriggerCharacter?: string[]+}+-}+data DocumentOnTypeFormattingOptions =+ DocumentOnTypeFormattingOptions+ { _firstTriggerCharacter :: Text+ , _moreTriggerCharacter :: Maybe [String]+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''DocumentOnTypeFormattingOptions)+makeFieldsNoPrefix ''DocumentOnTypeFormattingOptions++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++/**+ * Document link options+ */+export interface DocumentLinkOptions {+ /**+ * Document links have a resolve provider as well.+ */+ resolveProvider?: boolean;+}+-}++data DocumentLinkOptions =+ DocumentLinkOptions+ { -- |Document links have a resolve provider as well.+ _resolveProvider :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''DocumentLinkOptions)+makeFieldsNoPrefix ''DocumentLinkOptions++-- ---------------------------------------------------------------------++{-+New in 3.0+-----------++/**+ * Execute command options.+ */+export interface ExecuteCommandOptions {+ /**+ * The commands to be executed on the server+ */+ commands: string[]+}+-}++data ExecuteCommandOptions =+ ExecuteCommandOptions+ { -- | The commands to be executed on the server+ _commands :: List Text+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''ExecuteCommandOptions)+makeFieldsNoPrefix ''ExecuteCommandOptions++-- ---------------------------------------------------------------------+{-+New in 3.0+----------+/**+ * Save options.+ */+export interface SaveOptions {+ /**+ * The client is supposed to include the content on save.+ */+ includeText?: boolean;+}+-}+data SaveOptions =+ SaveOptions+ { -- |The client is supposed to include the content on save.+ _includeText :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''SaveOptions)+makeFieldsNoPrefix ''SaveOptions++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++export interface TextDocumentSyncOptions {+ /**+ * Open and close notifications are sent to the server.+ */+ openClose?: boolean;+ /**+ * Change notificatins are sent to the server. See TextDocumentSyncKind.None, TextDocumentSyncKind.Full+ * and TextDocumentSyncKindIncremental.+ */+ change?: number;+ /**+ * Will save notifications are sent to the server.+ */+ willSave?: boolean;+ /**+ * Will save wait until requests are sent to the server.+ */+ willSaveWaitUntil?: boolean;+ /**+ * Save notifications are sent to the server.+ */+ save?: SaveOptions;+}+-}++data TextDocumentSyncOptions =+ TextDocumentSyncOptions+ { -- | Open and close notifications are sent to the server.+ _openClose :: Maybe Bool++ -- | Change notificatins are sent to the server. See+ -- TextDocumentSyncKind.None, TextDocumentSyncKind.Full and+ -- TextDocumentSyncKindIncremental.+ , _change :: Maybe TextDocumentSyncKind++ -- | Will save notifications are sent to the server.+ , _willSave :: Maybe Bool++ -- | Will save wait until requests are sent to the server.+ , _willSaveWaitUntil :: Maybe Bool++ -- |Save notifications are sent to the server.+ , _save :: Maybe SaveOptions+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''TextDocumentSyncOptions)+makeFieldsNoPrefix ''TextDocumentSyncOptions++-- ---------------------------------------------------------------------+{-++Extended in 3.0+---------------++interface ServerCapabilities {+ /**+ * Defines how text documents are synced. Is either a detailed structure defining each notification or+ * for backwards compatibility the TextDocumentSyncKind number.+ */+ textDocumentSync?: TextDocumentSyncOptions | number;+ /**+ * The server provides hover support.+ */+ hoverProvider?: boolean;+ /**+ * The server provides completion support.+ */+ completionProvider?: CompletionOptions;+ /**+ * The server provides signature help support.+ */+ signatureHelpProvider?: SignatureHelpOptions;+ /**+ * The server provides goto definition support.+ */+ definitionProvider?: boolean;+ /**+ * The server provides find references support.+ */+ referencesProvider?: boolean;+ /**+ * The server provides document highlight support.+ */+ documentHighlightProvider?: boolean;+ /**+ * The server provides document symbol support.+ */+ documentSymbolProvider?: boolean;+ /**+ * The server provides workspace symbol support.+ */+ workspaceSymbolProvider?: boolean;+ /**+ * The server provides code actions.+ */+ codeActionProvider?: boolean;+ /**+ * The server provides code lens.+ */+ codeLensProvider?: CodeLensOptions;+ /**+ * The server provides document formatting.+ */+ documentFormattingProvider?: boolean;+ /**+ * The server provides document range formatting.+ */+ documentRangeFormattingProvider?: boolean;+ /**+ * The server provides document formatting on typing.+ */+ documentOnTypeFormattingProvider?: DocumentOnTypeFormattingOptions;+ /**+ * The server provides rename support.+ */+ renameProvider?: boolean;+ /**+ * The server provides document link support.+ */+ documentLinkProvider?: DocumentLinkOptions;+ /**+ * The server provides execute command support.+ */+ executeCommandProvider?: ExecuteCommandOptions;+ /**+ * Experimental server capabilities.+ */+ experimental?: any;+}+-}++data InitializeResponseCapabilitiesInner =+ InitializeResponseCapabilitiesInner+ { _textDocumentSync :: Maybe TextDocumentSyncKind+ , _hoverProvider :: Maybe Bool+ , _completionProvider :: Maybe CompletionOptions+ , _signatureHelpProvider :: Maybe SignatureHelpOptions+ , _definitionProvider :: Maybe Bool+ , _referencesProvider :: Maybe Bool+ , _documentHighlightProvider :: Maybe Bool+ , _documentSymbolProvider :: Maybe Bool+ , _workspaceSymbolProvider :: Maybe Bool+ , _codeActionProvider :: Maybe Bool+ , _codeLensProvider :: Maybe CodeLensOptions+ , _documentFormattingProvider :: Maybe Bool+ , _documentRangeFormattingProvider :: Maybe Bool+ , _documentOnTypeFormattingProvider :: Maybe DocumentOnTypeFormattingOptions+ , _renameProvider :: Maybe Bool+ -- Following are new in 3.0+ , _documentLinkProvider :: Maybe DocumentLinkOptions+ , _executeCommandProvider :: Maybe ExecuteCommandOptions+ , _experimental :: Maybe A.Value+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''InitializeResponseCapabilitiesInner)+makeFieldsNoPrefix ''InitializeResponseCapabilitiesInner+++-- ---------------------------------------------------------------------+-- |+-- Information about the capabilities of a language server+--+data InitializeResponseCapabilities =+ InitializeResponseCapabilities {+ _capabilities :: InitializeResponseCapabilitiesInner+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''InitializeResponseCapabilities)+makeFieldsNoPrefix ''InitializeResponseCapabilities++-- ---------------------------------------------------------------------++type InitializeResponse = ResponseMessage InitializeResponseCapabilities++type InitializeRequest = RequestMessage ClientMethod InitializeParams InitializeResponseCapabilities++{-+ error.code:++/**+ * Known error codes for an `InitializeError`;+ */+export namespace InitializeError {+ /**+ * If the protocol version provided by the client can't be handled by the server.+ * @deprecated This initialize error got replaced by client capabilities. There is+ * no version handshake in version 3.0x+ */+ export const unknownProtocolVersion: number = 1;+}++ error.data:++interface InitializeError {+ /**+ * Indicates whether the client execute the following retry logic:+ * (1) show the message provided by the ResponseError to the user+ * (2) user selects retry or cancel+ * (3) if user selected retry the initialize method is sent again.+ */+ retry: boolean;+}+-}++-- ---------------------------------------------------------------------++{-+New in 3.0+----------+Initialized Notification++The initialized notification is sent from the client to the server after the+client is fully initialized and is able to listen to arbritary requests and+notifications sent from the server.++Notification:++ method: 'initialized'+ params: void++-}++data InitializedParams =+ InitializedParams+ {+ } deriving (Show, Read, Eq)++instance A.FromJSON InitializedParams where+ parseJSON (A.Object _) = pure InitializedParams+ parseJSON _ = mempty++instance A.ToJSON InitializedParams where+ toJSON InitializedParams = A.Object mempty++type InitializedNotification = NotificationMessage ClientMethod (Maybe InitializedParams)++-- ---------------------------------------------------------------------+{-+Shutdown Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#shutdown-request++The shutdown request is sent from the client to the server. It asks the server+to shut down, but to not exit (otherwise the response might not be delivered+correctly to the client). There is a separate exit notification that asks the+server to exit.++Request++ method: 'shutdown'+ params: undefined++Response++ result: undefined+ error: code and message set in case an exception happens during shutdown request.+++-}++type ShutdownRequest = RequestMessage ClientMethod (Maybe A.Value) Text+type ShutdownResponse = ResponseMessage Text++-- ---------------------------------------------------------------------+{-+Exit Notification++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#exit-notification++A notification to ask the server to exit its process.++Notification++ method: 'exit'++-}++-- |+-- Notification from the server to actually exit now, after shutdown acked+--+data ExitNotificationParams =+ ExitNotificationParams+ {+ } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions ''ExitNotificationParams)++type ExitNotification = NotificationMessage ClientMethod (Maybe ExitNotificationParams)++-- ---------------------------------------------------------------------+{-+ShowMessage Notification++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#showmessage-notification++The show message notification is sent from a server to a client to ask the+client to display a particular message in the user interface.++Notification:++ method: 'window/showMessage'+ params: ShowMessageParams defined as follows:++interface ShowMessageParams {+ /**+ * The message type. See {@link MessageType}.+ */+ type: number;++ /**+ * The actual message.+ */+ message: string;+}++Where the type is defined as follows:++enum MessageType {+ /**+ * An error message.+ */+ Error = 1,+ /**+ * A warning message.+ */+ Warning = 2,+ /**+ * An information message.+ */+ Info = 3,+ /**+ * A log message.+ */+ Log = 4+}+-}+data MessageType = MtError -- ^ Error = 1,+ | MtWarning -- ^ Warning = 2,+ | MtInfo -- ^ Info = 3,+ | MtLog -- ^ Log = 4+ deriving (Eq,Ord,Show,Read,Enum)++instance A.ToJSON MessageType where+ toJSON MtError = A.Number 1+ toJSON MtWarning = A.Number 2+ toJSON MtInfo = A.Number 3+ toJSON MtLog = A.Number 4++instance A.FromJSON MessageType where+ parseJSON (A.Number 1) = pure MtError+ parseJSON (A.Number 2) = pure MtWarning+ parseJSON (A.Number 3) = pure MtInfo+ parseJSON (A.Number 4) = pure MtLog+ parseJSON _ = mempty++-- ---------------------------------------+++data ShowMessageParams =+ ShowMessageParams {+ _xtype :: MessageType+ , _message :: Text+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions{ fieldLabelModifier = customModifier } ''ShowMessageParams)+makeFieldsNoPrefix ''ShowMessageParams++type ShowMessageNotification = NotificationMessage ServerMethod ShowMessageParams++-- ---------------------------------------------------------------------+{-+ShowMessage Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#showmessage-request++ New: The show message request is sent from a server to a client to ask the+ client to display a particular message in the user interface. In addition to+ the show message notification the request allows to pass actions and to wait+ for an answer from the client.++Request:++ method: 'window/showMessageRequest'+ params: ShowMessageRequestParams defined as follows:++Response:++ result: the selected MessageActionItem+ error: code and message set in case an exception happens during showing a message.++interface ShowMessageRequestParams {+ /**+ * The message type. See {@link MessageType}+ */+ type: number;++ /**+ * The actual message+ */+ message: string;++ /**+ * The message action items to present.+ */+ actions?: MessageActionItem[];+}++Where the MessageActionItem is defined as follows:++interface MessageActionItem {+ /**+ * A short title like 'Retry', 'Open Log' etc.+ */+ title: string;+}+-}++data MessageActionItem =+ MessageActionItem+ { _title :: Text+ } deriving (Show,Read,Eq)++$(deriveJSON lspOptions ''MessageActionItem)+makeFieldsNoPrefix ''MessageActionItem+++data ShowMessageRequestParams =+ ShowMessageRequestParams+ { _xtype :: MessageType+ , _message :: Text+ , _actions :: Maybe [MessageActionItem]+ } deriving (Show,Read,Eq)++$(deriveJSON lspOptions{ fieldLabelModifier = customModifier } ''ShowMessageRequestParams)+makeFieldsNoPrefix ''ShowMessageRequestParams++type ShowMessageRequest = RequestMessage ServerMethod ShowMessageRequestParams Text+type ShowMessageResponse = ResponseMessage Text++-- ---------------------------------------------------------------------+{-+LogMessage Notification++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#logmessage-notification++The log message notification is sent from the server to the client to ask the+client to log a particular message.++Notification:++ method: 'window/logMessage'+ params: LogMessageParams defined as follows:++interface LogMessageParams {+ /**+ * The message type. See {@link MessageType}+ */+ type: number;++ /**+ * The actual message+ */+ message: string;+}++Where type is defined as above.+-}++data LogMessageParams =+ LogMessageParams {+ _xtype :: MessageType+ , _message :: Text+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions{ fieldLabelModifier = customModifier } ''LogMessageParams)+makeFieldsNoPrefix ''LogMessageParams+++type LogMessageNotification = NotificationMessage ServerMethod LogMessageParams++-- ---------------------------------------------------------------------+{-+Telemetry Notification++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#telemetry-notification++ New: The telemetry notification is sent from the server to the client to ask+ the client to log a telemetry event.++Notification:++ method: 'telemetry/event'+ params: 'any'+-}+++type TelemetryNotification = NotificationMessage ServerMethod A.Value++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++Register Capability++The client/registerCapability request is sent from the server to the client to+register for a new capability on the client side. Not all clients need to+support dynamic capability registration. A client opts in via the+ClientCapabilities.dynamicRegistration property.++Request:++ method: 'client/registerCapability'+ params: RegistrationParams++Where RegistrationParams are defined as follows:++/**+ * General paramters to to regsiter for a capability.+ */+export interface Registration {+ /**+ * The id used to register the request. The id can be used to deregister+ * the request again.+ */+ id: string;++ /**+ * The method / capability to register for.+ */+ method: string;++ /**+ * Options necessary for the registration.+ */+ registerOptions?: any;+}++export interface RegistrationParams {+ registrations: Registration[];+}+-}++data Registration =+ Registration+ { -- |The id used to register the request. The id can be used to deregister+ -- the request again.+ _id :: Text++ -- | The method / capability to register for.+ , _method :: ClientMethod++ -- | Options necessary for the registration.+ , _registerOptions :: Maybe A.Value+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''Registration)+makeFieldsNoPrefix ''Registration++data RegistrationParams =+ RegistrationParams+ { _registrations :: List Registration+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''RegistrationParams)+makeFieldsNoPrefix ''RegistrationParams++-- |Note: originates at the server+type RegisterCapabilityRequest = RequestMessage ServerMethod RegistrationParams ()++-- -------------------------------------++{-+Since most of the registration options require to specify a document selector+there is a base interface that can be used.++export interface TextDocumentRegistrationOptions {+ /**+ * A document selector to identify the scope of the registration. If set to null+ * the document selector provided on the client side will be used.+ */+ documentSelector: DocumentSelector | null;+}+-}++data TextDocumentRegistrationOptions =+ TextDocumentRegistrationOptions+ { _documentSelector :: Maybe DocumentSelector+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''TextDocumentRegistrationOptions)+makeFieldsNoPrefix ''TextDocumentRegistrationOptions++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++Unregister Capability++The client/unregisterCapability request is sent from the server to the client to+unregister a previously register capability.++Request:++ method: 'client/unregisterCapability'+ params: UnregistrationParams++Where UnregistrationParams are defined as follows:++/**+ * General parameters to unregister a capability.+ */+export interface Unregistration {+ /**+ * The id used to unregister the request or notification. Usually an id+ * provided during the register request.+ */+ id: string;++ /**+ * The method / capability to unregister for.+ */+ method: string;+}++export interface UnregistrationParams {+ unregisterations: Unregistration[];+}+-}++data Unregistration =+ Unregistration+ { -- | The id used to unregister the request or notification. Usually an id+ -- provided during the register request.+ _id :: Text++ -- |The method / capability to unregister for.+ , _method :: Text+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''Unregistration)+makeFieldsNoPrefix ''Unregistration++data UnregistrationParams =+ UnregistrationParams+ { _unregistrations :: List Unregistration+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''UnregistrationParams)+makeFieldsNoPrefix ''UnregistrationParams++type UnregisterCapabilityRequest = RequestMessage ServerMethod UnregistrationParams ()++-- ---------------------------------------------------------------------+{-+DidChangeConfiguration Notification++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#didchangeconfiguration-notification++A notification sent from the client to the server to signal the change of+configuration settings.++Notification:++ method: 'workspace/didChangeConfiguration',+ params: DidChangeConfigurationParams defined as follows:++interface DidChangeConfigurationParams {+ /**+ * The actual changed settings+ */+ settings: any;+}+-}++data DidChangeConfigurationParams =+ DidChangeConfigurationParams {+ _settings :: A.Value+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''DidChangeConfigurationParams)+makeFieldsNoPrefix ''DidChangeConfigurationParams+++type DidChangeConfigurationNotification = NotificationMessage ClientMethod DidChangeConfigurationParams++-- ---------------------------------------------------------------------+{-+DidOpenTextDocument Notification++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#didopentextdocument-notification++The document open notification is sent from the client to the server to signal+newly opened text documents. The document's truth is now managed by the client+and the server must not try to read the document's truth using the document's+uri.++Notification:++ method: 'textDocument/didOpen'+ params: DidOpenTextDocumentParams defined as follows:++interface DidOpenTextDocumentParams {+ /**+ * The document that was opened.+ */+ textDocument: TextDocumentItem;+}++Registration Options: TextDocumentRegistrationOptions+-}++data DidOpenTextDocumentParams =+ DidOpenTextDocumentParams {+ _textDocument :: TextDocumentItem+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''DidOpenTextDocumentParams)+makeFieldsNoPrefix ''DidOpenTextDocumentParams++type DidOpenTextDocumentNotification = NotificationMessage ClientMethod DidOpenTextDocumentParams++-- ---------------------------------------------------------------------+{-+DidChangeTextDocument Notification++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#didchangetextdocument-notification++ Changed: The document change notification is sent from the client to the+ server to signal changes to a text document. In 2.0 the shape of the params+ has changed to include proper version numbers and language ids.++Notification:++ method: 'textDocument/didChange'+ params: DidChangeTextDocumentParams defined as follows:++interface DidChangeTextDocumentParams {+ /**+ * The document that did change. The version number points+ * to the version after all provided content changes have+ * been applied.+ */+ textDocument: VersionedTextDocumentIdentifier;++ /**+ * The actual content changes.+ */+ contentChanges: TextDocumentContentChangeEvent[];+}++/**+ * An event describing a change to a text document. If range and rangeLength are omitted+ * the new text is considered to be the full content of the document.+ */+interface TextDocumentContentChangeEvent {+ /**+ * The range of the document that changed.+ */+ range?: Range;++ /**+ * The length of the range that got replaced.+ */+ rangeLength?: number;++ /**+ * The new text of the document.+ */+ text: string;+}+-}+data TextDocumentContentChangeEvent =+ TextDocumentContentChangeEvent+ { _range :: Maybe Range+ , _rangeLength :: Maybe Int+ , _text :: Text+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions { omitNothingFields = True } ''TextDocumentContentChangeEvent)+makeFieldsNoPrefix ''TextDocumentContentChangeEvent++-- -------------------------------------++data DidChangeTextDocumentParams =+ DidChangeTextDocumentParams+ { _textDocument :: VersionedTextDocumentIdentifier+ , _contentChanges :: List TextDocumentContentChangeEvent+ } deriving (Show,Read,Eq)++$(deriveJSON lspOptions ''DidChangeTextDocumentParams)+makeFieldsNoPrefix ''DidChangeTextDocumentParams++type DidChangeTextDocumentNotification = NotificationMessage ClientMethod DidChangeTextDocumentParams+{-+New in 3.0+----------++Registration Options: TextDocumentChangeRegistrationOptions defined as follows:++/**+ * Descibe options to be used when registered for text document change events.+ */+export interface TextDocumentChangeRegistrationOptions extends TextDocumentRegistrationOptions {+ /**+ * How documents are synced to the server. See TextDocumentSyncKind.Full+ * and TextDocumentSyncKindIncremental.+ */+ syncKind: number;+}+-}++data TextDocumentChangeRegistrationOptions =+ TextDocumentChangeRegistrationOptions+ { _documentSelector :: Maybe DocumentSelector+ , _syncKind :: TextDocumentSyncKind+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''TextDocumentChangeRegistrationOptions)+makeFieldsNoPrefix ''TextDocumentChangeRegistrationOptions++-- ---------------------------------------------------------------------+{-++New in 3.0+----------++WillSaveTextDocument Notification++The document will save notification is sent from the client to the server before+the document is actually saved.++Notification:++ method: 'textDocument/willSave'+ params: WillSaveTextDocumentParams defined as follows:++/**+ * The parameters send in a will save text document notification.+ */+export interface WillSaveTextDocumentParams {+ /**+ * The document that will be saved.+ */+ textDocument: TextDocumentIdentifier;++ /**+ * The 'TextDocumentSaveReason'.+ */+ reason: number;+}++/**+ * Represents reasons why a text document is saved.+ */+export namespace TextDocumentSaveReason {++ /**+ * Manually triggered, e.g. by the user pressing save, by starting debugging,+ * or by an API call.+ */+ export const Manual = 1;++ /**+ * Automatic after a delay.+ */+ export const AfterDelay = 2;++ /**+ * When the editor lost focus.+ */+ export const FocusOut = 3;+}+Registration Options: TextDocumentRegistrationOptions+-}++data TextDocumentSaveReason+ = SaveManual+ -- ^ Manually triggered, e.g. by the user pressing save, by starting+ -- debugging, or by an API call.+ | SaveAfterDelay -- ^ Automatic after a delay+ | SaveFocusOut -- ^ When the editor lost focus+ deriving (Show, Read, Eq)++instance A.ToJSON TextDocumentSaveReason where+ toJSON SaveManual = A.Number 1+ toJSON SaveAfterDelay = A.Number 2+ toJSON SaveFocusOut = A.Number 3++instance A.FromJSON TextDocumentSaveReason where+ parseJSON (A.Number 1) = pure SaveManual+ parseJSON (A.Number 2) = pure SaveAfterDelay+ parseJSON (A.Number 3) = pure SaveFocusOut+ parseJSON _ = mempty++data WillSaveTextDocumentParams =+ WillSaveTextDocumentParams+ { _textDocument :: TextDocumentIdentifier+ , _reason :: TextDocumentSaveReason+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''WillSaveTextDocumentParams)+makeFieldsNoPrefix ''WillSaveTextDocumentParams++type WillSaveTextDocumentNotification = NotificationMessage ClientMethod WillSaveTextDocumentParams++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++WillSaveWaitUntilTextDocument Request++The document will save request is sent from the client to the server before the+document is actually saved. The request can return an array of TextEdits which+will be applied to the text document before it is saved. Please note that+clients might drop results if computing the text edits took too long or if a+server constantly fails on this request. This is done to keep the save fast and+reliable.++Request:++ method: 'textDocument/willSaveWaitUntil'+ params: WillSaveTextDocumentParams++Response:++ result: TextEdit[]+ error: code and message set in case an exception happens during the willSaveWaitUntil request.++Registration Options: TextDocumentRegistrationOptions+-}++type WillSaveWaitUntilTextDocumentRequest = RequestMessage ClientMethod WillSaveTextDocumentParams (List TextEdit)+type WillSaveWaitUntilTextDocumentResponse = ResponseMessage (List TextEdit)++-- ---------------------------------------------------------------------+{-+DidSaveTextDocument Notification++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#didsavetextdocument-notification++ New: The document save notification is sent from the client to the server+ when the document was saved in the client.++ method: 'textDocument/didSave'+ params: DidSaveTextDocumentParams defined as follows:++interface DidSaveTextDocumentParams {+ /**+ * The document that was saved.+ */+ textDocument: TextDocumentIdentifier;+}+-}+data DidSaveTextDocumentParams =+ DidSaveTextDocumentParams+ { _textDocument :: TextDocumentIdentifier+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''DidSaveTextDocumentParams)+makeFieldsNoPrefix ''DidSaveTextDocumentParams++type DidSaveTextDocumentNotification = NotificationMessage ClientMethod DidSaveTextDocumentParams++++-- ---------------------------------------------------------------------+{-+DidCloseTextDocument Notification++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#didclosetextdocument-notification++The document close notification is sent from the client to the server when the+document got closed in the client. The document's truth now exists where the+document's uri points to (e.g. if the document's uri is a file uri the truth now+exists on disk).++ Changed: In 2.0 the params are of type DidCloseTextDocumentParams which+ contains a reference to a text document.++Notification:++ method: 'textDocument/didClose'+ params: DidCloseTextDocumentParams defined as follows:++interface DidCloseTextDocumentParams {+ /**+ * The document that was closed.+ */+ textDocument: TextDocumentIdentifier;+}+-}+data DidCloseTextDocumentParams =+ DidCloseTextDocumentParams+ { _textDocument :: TextDocumentIdentifier+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''DidCloseTextDocumentParams)+makeFieldsNoPrefix ''DidCloseTextDocumentParams+++type DidCloseTextDocumentNotification = NotificationMessage ClientMethod DidCloseTextDocumentParams++-- ---------------------------------------------------------------------+{-+DidChangeWatchedFiles Notification++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#didchangewatchedfiles-notification++The watched files notification is sent from the client to the server when the+client detects changes to files watched by the language client.++Notification:++ method: 'workspace/didChangeWatchedFiles'+ params: DidChangeWatchedFilesParams defined as follows:++interface DidChangeWatchedFilesParams {+ /**+ * The actual file events.+ */+ changes: FileEvent[];+}++Where FileEvents are described as follows:++/**+ * The file event type.+ */+enum FileChangeType {+ /**+ * The file got created.+ */+ Created = 1,+ /**+ * The file got changed.+ */+ Changed = 2,+ /**+ * The file got deleted.+ */+ Deleted = 3+}++/**+ * An event describing a file change.+ */+interface FileEvent {+ /**+ * The file's URI.+ */+ uri: string;+ /**+ * The change type.+ */+ type: number;+-}+data FileChangeType = FcCreated+ | FcChanged+ | FcDeleted+ deriving (Read,Show,Eq)++instance A.ToJSON FileChangeType where+ toJSON FcCreated = A.Number 1+ toJSON FcChanged = A.Number 2+ toJSON FcDeleted = A.Number 3++instance A.FromJSON FileChangeType where+ parseJSON (A.Number 1) = pure FcCreated+ parseJSON (A.Number 2) = pure FcChanged+ parseJSON (A.Number 3) = pure FcDeleted+ parseJSON _ = mempty+++-- -------------------------------------++data FileEvent =+ FileEvent+ { _uri :: Uri+ , _xtype :: FileChangeType+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions{ fieldLabelModifier = customModifier } ''FileEvent)+makeFieldsNoPrefix ''FileEvent++data DidChangeWatchedFilesParams =+ DidChangeWatchedFilesParams+ { _params :: List FileEvent+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''DidChangeWatchedFilesParams)+makeFieldsNoPrefix ''DidChangeWatchedFilesParams+++type DidChangeWatchedFilesNotification = NotificationMessage ClientMethod DidChangeWatchedFilesParams++-- ---------------------------------------------------------------------+{-+PublishDiagnostics Notification++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#publishdiagnostics-notification++Diagnostics notification are sent from the server to the client to signal+results of validation runs.++Notification++ method: 'textDocument/publishDiagnostics'+ params: PublishDiagnosticsParams defined as follows:++interface PublishDiagnosticsParams {+ /**+ * The URI for which diagnostic information is reported.+ */+ uri: string;++ /**+ * An array of diagnostic information items.+ */+ diagnostics: Diagnostic[];+}+-}++data PublishDiagnosticsParams =+ PublishDiagnosticsParams+ { _uri :: Uri+ , _diagnostics :: List Diagnostic+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''PublishDiagnosticsParams)+makeFieldsNoPrefix ''PublishDiagnosticsParams+++type PublishDiagnosticsNotification = NotificationMessage ServerMethod PublishDiagnosticsParams++-- ---------------------------------------------------------------------+{-+Completion Request++The Completion request is sent from the client to the server to compute+completion items at a given cursor position. Completion items are presented in+the IntelliSense user interface. If computing full completion items is+expensive, servers can additionally provide a handler for the completion item+resolve request ('completionItem/resolve'). This request is sent when a+completion item is selected in the user interface. A typically use case is for+example: the 'textDocument/completion' request doesn't fill in the documentation+property for returned completion items since it is expensive to compute. When+the item is selected in the user interface then a 'completionItem/resolve'+request is sent with the selected completion item as a param. The returned+completion item should have the documentation property filled in.++ Changed: In 2.0 the request uses TextDocumentPositionParams with a proper+ textDocument and position property. In 1.0 the uri of the referenced text+ document was inlined into the params object.++Request++ method: 'textDocument/completion'+ params: TextDocumentPositionParams+-}++-- -------------------------------------++{-++Response++ result: CompletionItem[] | CompletionList++/**+ * Represents a collection of [completion items](#CompletionItem) to be presented+ * in the editor.+ */+interface CompletionList {+ /**+ * This list it not complete. Further typing should result in recomputing+ * this list.+ */+ isIncomplete: boolean;+ /**+ * The completion items.+ */+ items: CompletionItem[];+}+++New in 3.0 : InsertTextFormat++/**+ * Defines whether the insert text in a completion item should be interpreted as+ * plain text or a snippet.+ */+namespace InsertTextFormat {+ /**+ * The primary text to be inserted is treated as a plain string.+ */+ export const PlainText = 1;++ /**+ * The primary text to be inserted is treated as a snippet.+ *+ * A snippet can define tab stops and placeholders with `$1`, `$2`+ * and `${3:foo}`. `$0` defines the final tab stop, it defaults to+ * the end of the snippet. Placeholders with equal identifiers are linked,+ * that is typing in one will update others too.+ *+ * See also: https://github.com/Microsoft/vscode/blob/master/src/vs/editor/contrib/snippet/common/snippet.md+ */+ export const Snippet = 2;+}++++interface CompletionItem {+ /**+ * The label of this completion item. By default+ * also the text that is inserted when selecting+ * this completion.+ */+ label: string;+ /**+ * The kind of this completion item. Based of the kind+ * an icon is chosen by the editor.+ */+ kind?: number;+ /**+ * A human-readable string with additional information+ * about this item, like type or symbol information.+ */+ detail?: string;+ /**+ * A human-readable string that represents a doc-comment.+ */+ documentation?: string;+ /**+ * A string that shoud be used when comparing this item+ * with other items. When `falsy` the label is used.+ */+ sortText?: string;+ /**+ * A string that should be used when filtering a set of+ * completion items. When `falsy` the label is used.+ */+ filterText?: string;+ /**+ * A string that should be inserted a document when selecting+ * this completion. When `falsy` the label is used.+ */+ insertText?: string;+ -- Following field is new in 3.0+ /**+ * The format of the insert text. The format applies to both the `insertText` property+ * and the `newText` property of a provided `textEdit`.+ */+ insertTextFormat?: InsertTextFormat;+ /**+ * An edit which is applied to a document when selecting this completion. When an edit is provided the value of+ * `insertText` is ignored.+ *+ * *Note:* The range of the edit must be a single line range and it must contain the position at which completion+ * has been requested.+ */++ textEdit?: TextEdit;++ -- Following field is new in 3.0+ /**+ * An optional array of additional text edits that are applied when+ * selecting this completion. Edits must not overlap with the main edit+ * nor with themselves.+ */+ additionalTextEdits?: TextEdit[];+ -- Following field is new in 3.0+ /**+ * An optional command that is executed *after* inserting this completion. *Note* that+ * additional modifications to the current document should be described with the+ * additionalTextEdits-property.+ */++ command?: Command;+ /**+ * An data entry field that is preserved on a completion item between+ * a completion and a completion resolve request.+ */++ data?: any+}++Where CompletionItemKind is defined as follows:++/**+ * The kind of a completion entry.+ */+enum CompletionItemKind {+ Text = 1,+ Method = 2,+ Function = 3,+ Constructor = 4,+ Field = 5,+ Variable = 6,+ Class = 7,+ Interface = 8,+ Module = 9,+ Property = 10,+ Unit = 11,+ Value = 12,+ Enum = 13,+ Keyword = 14,+ Snippet = 15,+ Color = 16,+ File = 17,+ Reference = 18+}++ error: code and message set in case an exception happens during the completion request.+-}++-- -------------------------------------++data InsertTextFormat+ = PlainText -- ^The primary text to be inserted is treated as a plain string.+ | Snippet+ -- ^ The primary text to be inserted is treated as a snippet.+ --+ -- A snippet can define tab stops and placeholders with `$1`, `$2`+ -- and `${3:foo}`. `$0` defines the final tab stop, it defaults to+ -- the end of the snippet. Placeholders with equal identifiers are linked,+ -- that is typing in one will update others too.+ --+ -- See also: https://github.com/Microsoft/vscode/blob/master/src/vs/editor/contrib/snippet/common/snippet.md+ deriving (Show, Read, Eq)++instance A.ToJSON InsertTextFormat where+ toJSON PlainText = A.Number 1+ toJSON Snippet = A.Number 2++instance A.FromJSON InsertTextFormat where+ parseJSON (A.Number 1) = pure PlainText+ parseJSON (A.Number 2) = pure Snippet+ parseJSON _ = mempty++-- -------------------------------------++data CompletionItemKind = CiText+ | CiMethod+ | CiFunction+ | CiConstructor+ | CiField+ | CiVariable+ | CiClass+ | CiInterface+ | CiModule+ | CiProperty+ | CiUnit+ | CiValue+ | CiEnum+ | CiKeyword+ | CiSnippet+ | CiColor+ | CiFile+ | CiReference+ deriving (Read,Show,Eq,Ord)++instance A.ToJSON CompletionItemKind where+ toJSON CiText = A.Number 1+ toJSON CiMethod = A.Number 2+ toJSON CiFunction = A.Number 3+ toJSON CiConstructor = A.Number 4+ toJSON CiField = A.Number 5+ toJSON CiVariable = A.Number 6+ toJSON CiClass = A.Number 7+ toJSON CiInterface = A.Number 8+ toJSON CiModule = A.Number 9+ toJSON CiProperty = A.Number 10+ toJSON CiUnit = A.Number 11+ toJSON CiValue = A.Number 12+ toJSON CiEnum = A.Number 13+ toJSON CiKeyword = A.Number 14+ toJSON CiSnippet = A.Number 15+ toJSON CiColor = A.Number 16+ toJSON CiFile = A.Number 17+ toJSON CiReference = A.Number 18++instance A.FromJSON CompletionItemKind where+ parseJSON (A.Number 1) = pure CiText+ parseJSON (A.Number 2) = pure CiMethod+ parseJSON (A.Number 3) = pure CiFunction+ parseJSON (A.Number 4) = pure CiConstructor+ parseJSON (A.Number 5) = pure CiField+ parseJSON (A.Number 6) = pure CiVariable+ parseJSON (A.Number 7) = pure CiClass+ parseJSON (A.Number 8) = pure CiInterface+ parseJSON (A.Number 9) = pure CiModule+ parseJSON (A.Number 10) = pure CiProperty+ parseJSON (A.Number 11) = pure CiUnit+ parseJSON (A.Number 12) = pure CiValue+ parseJSON (A.Number 13) = pure CiEnum+ parseJSON (A.Number 14) = pure CiKeyword+ parseJSON (A.Number 15) = pure CiSnippet+ parseJSON (A.Number 16) = pure CiColor+ parseJSON (A.Number 17) = pure CiFile+ parseJSON (A.Number 18) = pure CiReference+ parseJSON _ = mempty+++-- -------------------------------------++data CompletionItem =+ CompletionItem+ { _label :: Text -- ^ The label of this completion item. By default also+ -- the text that is inserted when selecting this+ -- completion.+ , _kind :: Maybe CompletionItemKind+ , _detail :: Maybe Text -- ^ A human-readable string with additional+ -- information about this item, like type or+ -- symbol information.+ , _documentation :: Maybe Text -- ^ A human-readable string that represents+ -- a doc-comment.+ , _sortText :: Maybe Text -- ^ A string that should be used when filtering+ -- a set of completion items. When `falsy` the+ -- label is used.+ , _filterText :: Maybe Text -- ^ A string that should be used when+ -- filtering a set of completion items. When+ -- `falsy` the label is used.+ , _insertText :: Maybe Text -- ^ A string that should be inserted a+ -- document when selecting this completion.+ -- When `falsy` the label is used.+ , _insertTextFormat :: Maybe InsertTextFormat+ -- ^ The format of the insert text. The format applies to both the+ -- `insertText` property and the `newText` property of a provided+ -- `textEdit`.+ , _textEdit :: Maybe TextEdit+ -- ^ An edit which is applied to a document when selecting this+ -- completion. When an edit is provided the value of `insertText` is+ -- ignored.+ --+ -- *Note:* The range of the edit must be a single line range and it+ -- must contain the position at which completion has been requested.+ , _additionalTextEdits :: Maybe (List TextEdit)+ -- ^ An optional array of additional text edits that are applied when+ -- selecting this completion. Edits must not overlap with the main edit+ -- nor with themselves.+ , _command :: Maybe Command+ -- ^ An optional command that is executed *after* inserting this+ -- completion. *Note* that additional modifications to the current+ -- document should be described with the additionalTextEdits-property.+ , _xdata :: Maybe A.Value -- ^ An data entry field that is preserved on a+ -- completion item between a completion and a+ -- completion resolve request.+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions{ fieldLabelModifier = customModifier } ''CompletionItem)+makeFieldsNoPrefix ''CompletionItem++data CompletionListType =+ CompletionListType+ { _isIncomplete :: Bool+ , _items :: List CompletionItem+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''CompletionListType)+makeFieldsNoPrefix ''CompletionListType+++data CompletionResponseResult+ = CompletionList CompletionListType+ | Completions (List CompletionItem)+ deriving (Read,Show,Eq)++$(deriveJSON defaultOptions { fieldLabelModifier = rdrop (length ("CompletionResponseResult"::String)), sumEncoding = UntaggedValue } ''CompletionResponseResult)++type CompletionResponse = ResponseMessage CompletionResponseResult+type CompletionRequest = RequestMessage ClientMethod TextDocumentPositionParams CompletionResponseResult++-- -------------------------------------+{-+New in 3.0+-----------+Registration Options: CompletionRegistrationOptions options defined as follows:++export interface CompletionRegistrationOptions extends TextDocumentRegistrationOptions {+ /**+ * The characters that trigger completion automatically.+ */+ triggerCharacters?: string[];++ /**+ * The server provides support to resolve additional+ * information for a completion item.+ */+ resolveProvider?: boolean;+}+-}++data CompletionRegistrationOptions =+ CompletionRegistrationOptions+ { _documentSelector :: Maybe DocumentSelector+ , _triggerCharacters :: Maybe (List String)+ , _resolveProvider :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''CompletionRegistrationOptions)+makeFieldsNoPrefix ''CompletionRegistrationOptions++-- ---------------------------------------------------------------------+{-+Completion Item Resolve Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#completion-item-resolve-request++The request is sent from the client to the server to resolve additional+information for a given completion item.++Request++ method: 'completionItem/resolve'+ params: CompletionItem++Response++ result: CompletionItem+ error: code and message set in case an exception happens during the completion resolve request.+-}++type CompletionItemResolveRequest = RequestMessage ClientMethod CompletionItem CompletionItem+type CompletionItemResolveResponse = ResponseMessage CompletionItem++-- ---------------------------------------------------------------------+{-+Hover Request++The hover request is sent from the client to the server to request hover+information at a given text document position.++ Changed: In 2.0 the request uses TextDocumentPositionParams with a proper+ textDocument and position property. In 1.0 the uri of the referenced text+ document was inlined into the params object.++Request++ method: 'textDocument/hover'+ params: TextDocumentPositionParams++Response++ result: Hover defined as follows:++/**+ * The result of a hove request.+ */+interface Hover {+ /**+ * The hover's content+ */+ contents: MarkedString | MarkedString[];++ /**+ * An optional range+ */+ range?: Range;+}++Where MarkedString is defined as follows:+/**+ * MarkedString can be used to render human readable text. It is either a markdown string+ * or a code-block that provides a language and a code snippet. The language identifier+ * is sematically equal to the optional language identifier in fenced code blocks in GitHub+ * issues. See https://help.github.com/articles/creating-and-highlighting-code-blocks/#syntax-highlighting+ *+ * The pair of a language and a value is an equivalent to markdown:+ * ```${language}+ * ${value}+ * ```+ *+ * Note that markdown strings will be sanitized - that means html will be escaped.+ */+type MarkedString = string | { language: string; value: string };++ error: code and message set in case an exception happens during the hover+ request.++Registration Options: TextDocumentRegistrationOptions++-}++data LanguageString =+ LanguageString+ { _language :: Text+ , _value :: Text+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''LanguageString)+makeFieldsNoPrefix ''LanguageString++data MarkedString =+ PlainString T.Text+ | CodeString LanguageString+ deriving (Eq,Read,Show)++instance ToJSON MarkedString where+ toJSON (PlainString x) = toJSON x+ toJSON (CodeString x) = toJSON x+instance FromJSON MarkedString where+ parseJSON (A.String t) = pure $ PlainString t+ parseJSON o = CodeString <$> parseJSON o++data Hover =+ Hover+ { _contents :: List MarkedString+ , _range :: Maybe Range+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''Hover)+makeFieldsNoPrefix ''Hover+++type HoverRequest = RequestMessage ClientMethod TextDocumentPositionParams Hover+type HoverResponse = ResponseMessage Hover++-- ---------------------------------------------------------------------+{-+Signature Help Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#signature-help-request++The signature help request is sent from the client to the server to request+signature information at a given cursor position.++ Changed: In 2.0 the request uses TextDocumentPositionParams with proper+ textDocument and position properties. In 1.0 the uri of the referenced text+ document was inlined into the params object.++Request++ method: 'textDocument/signatureHelp'+ params: TextDocumentPositionParams++Response++ result: SignatureHelp defined as follows:++/**+ * Signature help represents the signature of something+ * callable. There can be multiple signature but only one+ * active and only one active parameter.+ */+interface SignatureHelp {+ /**+ * One or more signatures.+ */+ signatures: SignatureInformation[];++ /**+ * The active signature.+ */+ activeSignature?: number;++ /**+ * The active parameter of the active signature.+ */+ activeParameter?: number;+}++/**+ * Represents the signature of something callable. A signature+ * can have a label, like a function-name, a doc-comment, and+ * a set of parameters.+ */+interface SignatureInformation {+ /**+ * The label of this signature. Will be shown in+ * the UI.+ */+ label: string;++ /**+ * The human-readable doc-comment of this signature. Will be shown+ * in the UI but can be omitted.+ */+ documentation?: string;++ /**+ * The parameters of this signature.+ */+ parameters?: ParameterInformation[];+}++/**+ * Represents a parameter of a callable-signature. A parameter can+ * have a label and a doc-comment.+ */+interface ParameterInformation {+ /**+ * The label of this signature. Will be shown in+ * the UI.+ */+ label: string;++ /**+ * The human-readable doc-comment of this signature. Will be shown+ * in the UI but can be omitted.+ */+ documentation?: string;+}++ error: code and message set in case an exception happens during the+ signature help request.+-}+++data ParameterInformation =+ ParameterInformation+ { _label :: Text+ , _documentation :: Maybe Text+ } deriving (Read,Show,Eq)+$(deriveJSON lspOptions ''ParameterInformation)+makeFieldsNoPrefix ''ParameterInformation+++-- -------------------------------------++data SignatureInformation =+ SignatureInformation+ { _label :: Text+ , _documentation :: Maybe Text+ , _parameters :: Maybe [ParameterInformation]+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''SignatureInformation)+makeFieldsNoPrefix ''SignatureInformation++data SignatureHelp =+ SignatureHelp+ { _signatures :: List SignatureInformation+ , _activeSignature :: Maybe Int -- ^ The active signature+ , _activeParameter :: Maybe Int -- ^ The active parameter of the active signature+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''SignatureHelp)+makeFieldsNoPrefix ''SignatureHelp++type SignatureHelpRequest = RequestMessage ClientMethod TextDocumentPositionParams SignatureHelp+type SignatureHelpResponse = ResponseMessage SignatureHelp++-- -------------------------------------+{-+New in 3.0+----------+Registration Options: SignatureHelpRegistrationOptions defined as follows:++export interface SignatureHelpRegistrationOptions extends TextDocumentRegistrationOptions {+ /**+ * The characters that trigger signature help+ * automatically.+ */+ triggerCharacters?: string[];+}+-}++data SignatureHelpRegistrationOptions =+ SignatureHelpRegistrationOptions+ { _documentSelector :: Maybe DocumentSelector+ , _triggerCharacters :: Maybe (List String)+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''SignatureHelpRegistrationOptions)+makeFieldsNoPrefix ''SignatureHelpRegistrationOptions++-- ---------------------------------------------------------------------+{-+Goto Definition Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#goto-definition-request++The goto definition request is sent from the client to the server to resolve the+definition location of a symbol at a given text document position.++ Changed: In 2.0 the request uses TextDocumentPositionParams with proper+ textDocument and position properties. In 1.0 the uri of the referenced text+ document was inlined into the params object.++Request++ method: 'textDocument/definition'+ params: TextDocumentPositionParams++Response:++ result: Location | Location[]+ error: code and message set in case an exception happens during the definition request.+++-}++-- {"jsonrpc":"2.0","id":1,"method":"textDocument/definition","params":{"textDocument":{"uri":"file:///tmp/Foo.hs"},"position":{"line":1,"character":8}}}++type DefinitionRequest = RequestMessage ClientMethod TextDocumentPositionParams Location+type DefinitionResponse = ResponseMessage Location++-- ---------------------------------------------------------------------++{-+Find References Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#find-references-request++The references request is sent from the client to the server to resolve+project-wide references for the symbol denoted by the given text document+position.++ Changed: In 2.0 the request uses TextDocumentPositionParams with proper+ textDocument and position properties. In 1.0 the uri of the referenced text+ document was inlined into the params object.++Request++ method: 'textDocument/references'+ params: ReferenceParams defined as follows:++interface ReferenceParams extends TextDocumentPositionParams {+ context: ReferenceContext+}++interface ReferenceContext {+ /**+ * Include the declaration of the current symbol.+ */+ includeDeclaration: boolean;+}++Response:++ result: Location[]+ error: code and message set in case an exception happens during the+ reference request.+-}++data ReferenceContext =+ ReferenceContext+ { _includeDeclaration :: Bool+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''ReferenceContext)+makeFieldsNoPrefix ''ReferenceContext+++data ReferenceParams =+ ReferenceParams+ { _textDocument :: TextDocumentIdentifier+ , _position :: Position+ , _context :: ReferenceContext+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''ReferenceParams)+makeFieldsNoPrefix ''ReferenceParams+++type ReferencesRequest = RequestMessage ClientMethod ReferenceParams (List Location)+type ReferencesResponse = ResponseMessage (List Location)++-- ---------------------------------------------------------------------+{-+Document Highlights Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#document-highlights-request++The document highlight request is sent from the client to the server to resolve+a document highlights for a given text document position. For programming+languages this usually highlights all references to the symbol scoped to this+file. However we kept 'textDocument/documentHighlight' and+'textDocument/references' separate requests since the first one is allowed to be+more fuzzy. Symbol matches usually have a DocumentHighlightKind of Read or Write+whereas fuzzy or textual matches use Textas the kind.++ Changed: In 2.0 the request uses TextDocumentPositionParams with proper+ textDocument and position properties. In 1.0 the uri of the referenced text+ document was inlined into the params object.++Request++ method: 'textDocument/documentHighlight'+ params: TextDocumentPositionParams++Response++ result: DocumentHighlight[] defined as follows:++/**+ * A document highlight is a range inside a text document which deserves+ * special attention. Usually a document highlight is visualized by changing+ * the background color of its range.+ *+ */+interface DocumentHighlight {+ /**+ * The range this highlight applies to.+ */+ range: Range;++ /**+ * The highlight kind, default is DocumentHighlightKind.Text.+ */+ kind?: number;+}++/**+ * A document highlight kind.+ */+enum DocumentHighlightKind {+ /**+ * A textual occurrance.+ */+ Text = 1,++ /**+ * Read-access of a symbol, like reading a variable.+ */+ Read = 2,++ /**+ * Write-access of a symbol, like writing to a variable.+ */+ Write = 3+}++ error: code and message set in case an exception happens during the document+ highlight request.++Registration Options: TextDocumentRegistrationOptions++-}++data DocumentHighlightKind = HkText | HkRead | HkWrite+ deriving (Read,Show,Eq)++instance A.ToJSON DocumentHighlightKind where+ toJSON HkText = A.Number 1+ toJSON HkRead = A.Number 2+ toJSON HkWrite = A.Number 3++instance A.FromJSON DocumentHighlightKind where+ parseJSON (A.Number 1) = pure HkText+ parseJSON (A.Number 2) = pure HkRead+ parseJSON (A.Number 3) = pure HkWrite+ parseJSON _ = mempty++-- -------------------------------------++data DocumentHighlight =+ DocumentHighlight+ { _range :: Range+ , _kind :: Maybe DocumentHighlightKind+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''DocumentHighlight)+makeFieldsNoPrefix ''DocumentHighlight++type DocumentHighlightRequest = RequestMessage ClientMethod TextDocumentPositionParams (List DocumentHighlight)+type DocumentHighlightsResponse = ResponseMessage (List DocumentHighlight)++-- ---------------------------------------------------------------------+{-+Document Symbols Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#document-symbols-request++The document symbol request is sent from the client to the server to list all+symbols found in a given text document.++ Changed: In 2.0 the request uses DocumentSymbolParams instead of a single+ uri.++Request++ method: 'textDocument/documentSymbol'+ params: DocumentSymbolParams defined as follows:++interface DocumentSymbolParams {+ /**+ * The text document.+ */+ textDocument: TextDocumentIdentifier;+}++Response++ result: SymbolInformation[] defined as follows:++/**+ * Represents information about programming constructs like variables, classes,+ * interfaces etc.+ */+interface SymbolInformation {+ /**+ * The name of this symbol.+ */+ name: string;++ /**+ * The kind of this symbol.+ */+ kind: number;++ /**+ * The location of this symbol.+ */+ location: Location;++ /**+ * The name of the symbol containing this symbol.+ */+ containerName?: string;+}++Where the kind is defined like this:++/**+ * A symbol kind.+ */+export enum SymbolKind {+ File = 1,+ Module = 2,+ Namespace = 3,+ Package = 4,+ Class = 5,+ Method = 6,+ Property = 7,+ Field = 8,+ Constructor = 9,+ Enum = 10,+ Interface = 11,+ Function = 12,+ Variable = 13,+ Constant = 14,+ Text = 15,+ Number = 16,+ Boolean = 17,+ Array = 18,+}++ error: code and message set in case an exception happens during the document+ symbol request.++Registration Options: TextDocumentRegistrationOptions+-}++data DocumentSymbolParams =+ DocumentSymbolParams+ { _textDocument :: TextDocumentIdentifier+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''DocumentSymbolParams)+makeFieldsNoPrefix ''DocumentSymbolParams++-- -------------------------------------++data SymbolKind+ = SkFile+ | SkModule+ | SkNamespace+ | SkPackage+ | SkClass+ | SkMethod+ | SkProperty+ | SkField+ | SkConstructor+ | SkEnum+ | SkInterface+ | SkFunction+ | SkVariable+ | SkConstant+ | SkString+ | SkNumber+ | SkBoolean+ | SkArray+ deriving (Read,Show,Eq)++instance A.ToJSON SymbolKind where+ toJSON SkFile = A.Number 1+ toJSON SkModule = A.Number 2+ toJSON SkNamespace = A.Number 3+ toJSON SkPackage = A.Number 4+ toJSON SkClass = A.Number 5+ toJSON SkMethod = A.Number 6+ toJSON SkProperty = A.Number 7+ toJSON SkField = A.Number 8+ toJSON SkConstructor = A.Number 9+ toJSON SkEnum = A.Number 10+ toJSON SkInterface = A.Number 11+ toJSON SkFunction = A.Number 12+ toJSON SkVariable = A.Number 13+ toJSON SkConstant = A.Number 14+ toJSON SkString = A.Number 15+ toJSON SkNumber = A.Number 16+ toJSON SkBoolean = A.Number 17+ toJSON SkArray = A.Number 18++instance A.FromJSON SymbolKind where+ parseJSON (A.Number 1) = pure SkFile+ parseJSON (A.Number 2) = pure SkModule+ parseJSON (A.Number 3) = pure SkNamespace+ parseJSON (A.Number 4) = pure SkPackage+ parseJSON (A.Number 5) = pure SkClass+ parseJSON (A.Number 6) = pure SkMethod+ parseJSON (A.Number 7) = pure SkProperty+ parseJSON (A.Number 8) = pure SkField+ parseJSON (A.Number 9) = pure SkConstructor+ parseJSON (A.Number 10) = pure SkEnum+ parseJSON (A.Number 11) = pure SkInterface+ parseJSON (A.Number 12) = pure SkFunction+ parseJSON (A.Number 13) = pure SkVariable+ parseJSON (A.Number 14) = pure SkConstant+ parseJSON (A.Number 15) = pure SkString+ parseJSON (A.Number 16) = pure SkNumber+ parseJSON (A.Number 17) = pure SkBoolean+ parseJSON (A.Number 18) = pure SkArray+ parseJSON _ = mempty+++-- ---------------------------------------------------------------------++data SymbolInformation =+ SymbolInformation+ { _name :: Text+ , _kind :: SymbolKind+ , _location :: Location+ , _containerName :: Maybe Text -- ^The name of the symbol containing this+ -- symbol.+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''SymbolInformation)+makeFieldsNoPrefix ''SymbolInformation+++-- -------------------------------------++type DocumentSymbolRequest = RequestMessage ClientMethod DocumentSymbolParams (List SymbolInformation)+type DocumentSymbolsResponse = ResponseMessage (List SymbolInformation)++-- ---------------------------------------------------------------------+{-+Workspace Symbols Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#workspace-symbols-request++The workspace symbol request is sent from the client to the server to list+project-wide symbols matching the query string.++Request++ method: 'workspace/symbol'+ params: WorkspaceSymbolParams defined as follows:++/**+ * The parameters of a Workspace Symbol Request.+ */+interface WorkspaceSymbolParams {+ /**+ * A non-empty query string+ */+ query: string;+}++Response++ result: SymbolInformation[] as defined above.+ error: code and message set in case an exception happens during the+ workspace symbol request.+-}++data WorkspaceSymbolParams =+ WorkspaceSymbolParams+ { _query :: Text+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''WorkspaceSymbolParams)+makeFieldsNoPrefix ''WorkspaceSymbolParams++type WorkspaceSymbolRequest = RequestMessage ClientMethod WorkspaceSymbolParams (List SymbolInformation)+type WorkspaceSymbolsResponse = ResponseMessage (List SymbolInformation)++-- ---------------------------------------------------------------------+{-+Code Action Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#code-action-request++The code action request is sent from the client to the server to compute+commands for a given text document and range. The request is triggered when the+user moves the cursor into a problem marker in the editor or presses the+lightbulb associated with a marker.++Request++ method: 'textDocument/codeAction'+ params: CodeActionParams defined as follows:++/**+ * Params for the CodeActionRequest+ */+interface CodeActionParams {+ /**+ * The document in which the command was invoked.+ */+ textDocument: TextDocumentIdentifier;++ /**+ * The range for which the command was invoked.+ */+ range: Range;++ /**+ * Context carrying additional information.+ */+ context: CodeActionContext;+}++/**+ * Contains additional diagnostic information about the context in which+ * a code action is run.+ */+interface CodeActionContext {+ /**+ * An array of diagnostics.+ */+ diagnostics: Diagnostic[];+}++Response++ result: Command[] defined as follows:+ error: code and message set in case an exception happens during the code+ action request.++-}++data CodeActionContext =+ CodeActionContext+ { _diagnostics :: List Diagnostic+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''CodeActionContext)+makeFieldsNoPrefix ''CodeActionContext+++data CodeActionParams =+ CodeActionParams+ { _textDocument :: TextDocumentIdentifier+ , _range :: Range+ , _context :: CodeActionContext+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''CodeActionParams)+makeFieldsNoPrefix ''CodeActionParams+++type CodeActionRequest = RequestMessage ClientMethod CodeActionParams (List Command)+type CodeActionResponse = ResponseMessage (List Command)++-- ---------------------------------------------------------------------+{-+Code Lens Request++The code lens request is sent from the client to the server to compute code+lenses for a given text document.++ Changed: In 2.0 the request uses CodeLensParams instead of a single uri.++Request++ method: 'textDocument/codeLens'+ params: CodeLensParams defined as follows:++interface CodeLensParams {+ /**+ * The document to request code lens for.+ */+ textDocument: TextDocumentIdentifier;+}++Response++ result: CodeLens[] defined as follows:++/**+ * A code lens represents a command that should be shown along with+ * source text, like the number of references, a way to run tests, etc.+ *+ * A code lens is _unresolved_ when no command is associated to it. For performance+ * reasons the creation of a code lens and resolving should be done in two stages.+ */+interface CodeLens {+ /**+ * The range in which this code lens is valid. Should only span a single line.+ */+ range: Range;++ /**+ * The command this code lens represents.+ */+ command?: Command;++ /**+ * A data entry field that is preserved on a code lens item between+ * a code lens and a code lens resolve request.+ */+ data?: any+}++ error: code and message set in case an exception happens during the code+ lens request.+-}++data CodeLensParams =+ CodeLensParams+ { _textDocument :: TextDocumentIdentifier+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''CodeLensParams)+makeFieldsNoPrefix ''CodeLensParams+++-- -------------------------------------++data CodeLens =+ CodeLens+ { _range :: Range+ , _command :: Maybe Command+ , _xdata :: Maybe A.Value+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions{ fieldLabelModifier = customModifier } ''CodeLens)+makeFieldsNoPrefix ''CodeLens+++type CodeLensRequest = RequestMessage ClientMethod CodeLensParams (List CodeLens)+type CodeLensResponse = ResponseMessage (List CodeLens)++-- -------------------------------------+{-+Registration Options: CodeLensRegistrationOptions defined as follows:++export interface CodeLensRegistrationOptions extends TextDocumentRegistrationOptions {+ /**+ * Code lens has a resolve provider as well.+ */+ resolveProvider?: boolean;+}+-}++data CodeLensRegistrationOptions =+ CodeLensRegistrationOptions+ { _documentSelector :: Maybe DocumentSelector+ , _resolveProvider :: Maybe Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''CodeLensRegistrationOptions)+makeFieldsNoPrefix ''CodeLensRegistrationOptions++-- ---------------------------------------------------------------------+{-+Code Lens Resolve Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#code-lens-resolve-request++The code lens resolve request is sent from the client to the server to resolve+the command for a given code lens item.++Request++ method: 'codeLens/resolve'+ params: CodeLens++Response++ result: CodeLens+ error: code and message set in case an exception happens during the code+ lens resolve request.+++-}++type CodeLensResolveRequest = RequestMessage ClientMethod CodeLens (List CodeLens)+type CodeLensResolveResponse = ResponseMessage (List CodeLens)++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++Document Link Request++The document links request is sent from the client to the server to request the+location of links in a document.++Request:++ method: 'textDocument/documentLink'+ params: DocumentLinkParams, defined as follows++interface DocumentLinkParams {+ /**+ * The document to provide document links for.+ */+ textDocument: TextDocumentIdentifier;+}++Response:++ result: An array of DocumentLink, or null.++/**+ * A document link is a range in a text document that links to an internal or external resource, like another+ * text document or a web site.+ */+interface DocumentLink {+ /**+ * The range this link applies to.+ */+ range: Range;+ /**+ * The uri this link points to. If missing a resolve request is sent later.+ */+ target?: DocumentUri;+}++ error: code and message set in case an exception happens during the document link request.++Registration Options: DocumentLinkRegistrationOptions defined as follows:++export interface DocumentLinkRegistrationOptions extends TextDocumentRegistrationOptions {+ /**+ * Document links have a resolve provider as well.+ */+ resolveProvider?: boolean;+}+-}++data DocumentLinkParams =+ DocumentLinkParams+ { _textDocument :: TextDocumentIdentifier+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''DocumentLinkParams)+makeFieldsNoPrefix ''DocumentLinkParams++data DocumentLink =+ DocumentLink+ { _range :: Range+ , _target :: Maybe Text+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''DocumentLink)+makeFieldsNoPrefix ''DocumentLink++type DocumentLinkRequest = RequestMessage ClientMethod DocumentLinkParams (List DocumentLink)+type DocumentLinkResponse = ResponseMessage (List DocumentLink)++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++Document Link Resolve Request++The document link resolve request is sent from the client to the server to resolve the target of a given document link.++Request:++ method: 'documentLink/resolve'+ params: DocumentLink++Response:++ result: DocumentLink+ error: code and message set in case an exception happens during the document link resolve request.++-}++type DocumentLinkResolveRequest = RequestMessage ClientMethod DocumentLink DocumentLink+type DocumentLinkResolveResponse = ResponseMessage DocumentLink++-- ---------------------------------------------------------------------+{-+Document Formatting Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#document-formatting-request++The document formatting request is sent from the server to the client to format+a whole document.++Request++ method: 'textDocument/formatting'+ params: DocumentFormattingParams defined as follows++interface DocumentFormattingParams {+ /**+ * The document to format.+ */+ textDocument: TextDocumentIdentifier;++ /**+ * The format options.+ */+ options: FormattingOptions;+}++/**+ * Value-object describing what options formatting should use.+ */+interface FormattingOptions {+ /**+ * Size of a tab in spaces.+ */+ tabSize: number;++ /**+ * Prefer spaces over tabs.+ */+ insertSpaces: boolean;++ /**+ * Signature for further properties.+ */+ [key: string]: boolean | number | string;+}++Response++ result: TextEdit[] describing the modification to the document to be+ formatted.+ error: code and message set in case an exception happens during the+ formatting request.++Registration Options: TextDocumentRegistrationOptions+-}++data FormattingOptions =+ FormattingOptions+ { _tabSize :: Int+ , _insertSpaces :: Bool -- ^ Prefer spaces over tabs+ -- Note: May be more properties+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''FormattingOptions)+makeFieldsNoPrefix ''FormattingOptions++data DocumentFormattingParams =+ DocumentFormattingParams+ { _textDocument :: TextDocumentIdentifier+ , _options :: FormattingOptions+ } deriving (Show,Read,Eq)++$(deriveJSON lspOptions ''DocumentFormattingParams)+makeFieldsNoPrefix ''DocumentFormattingParams++type DocumentFormattingRequest = RequestMessage ClientMethod DocumentFormattingParams (List TextEdit)+type DocumentFormattingResponse = ResponseMessage (List TextEdit)++-- ---------------------------------------------------------------------+{-+Document Range Formatting Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#document-range-formatting-request++The document range formatting request is sent from the client to the server to+format a given range in a document.++Request++ method: 'textDocument/rangeFormatting',+ params: DocumentRangeFormattingParams defined as follows++interface DocumentRangeFormattingParams {+ /**+ * The document to format.+ */+ textDocument: TextDocumentIdentifier;++ /**+ * The range to format+ */+ range: Range;++ /**+ * The format options+ */+ options: FormattingOptions;+}++Response++ result: TextEdit[] describing the modification to the document to be+ formatted.+ error: code and message set in case an exception happens during the range+ formatting request.+-}++data DocumentRangeFormattingParams =+ DocumentRangeFormattingParams+ { _textDocument :: TextDocumentIdentifier+ , _range :: Range+ , _options :: FormattingOptions+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''DocumentRangeFormattingParams)+makeFieldsNoPrefix ''DocumentRangeFormattingParams++type DocumentRangeFormattingRequest = RequestMessage ClientMethod DocumentRangeFormattingParams (List TextEdit)+type DocumentRangeFormattingResponse = ResponseMessage (List TextEdit)++-- ---------------------------------------------------------------------+{-+Document on Type Formatting Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#document-on-type-formatting-request++The document on type formatting request is sent from the client to the server to+format parts of the document during typing.++Request++ method: 'textDocument/onTypeFormatting'+ params: DocumentOnTypeFormattingParams defined as follows++interface DocumentOnTypeFormattingParams {+ /**+ * The document to format.+ */+ textDocument: TextDocumentIdentifier;++ /**+ * The position at which this request was sent.+ */+ position: Position;++ /**+ * The character that has been typed.+ */+ ch: string;++ /**+ * The format options.+ */+ options: FormattingOptions;+}++Response++ result: TextEdit[] describing the modification to the document.+ error: code and message set in case an exception happens during the range+ formatting request.++Registration Options: DocumentOnTypeFormattingRegistrationOptions defined as follows:++export interface DocumentOnTypeFormattingRegistrationOptions extends TextDocumentRegistrationOptions {+ /**+ * A character on which formatting should be triggered, like `}`.+ */+ firstTriggerCharacter: string;+ /**+ * More trigger characters.+ */+ moreTriggerCharacter?: string[]+}+-}++data DocumentOnTypeFormattingParams =+ DocumentOnTypeFormattingParams+ { _textDocument :: TextDocumentIdentifier+ , _position :: Position+ , _ch :: Text+ , _options :: FormattingOptions+ } deriving (Read,Show,Eq)++$(deriveJSON lspOptions ''DocumentOnTypeFormattingParams)+makeFieldsNoPrefix ''DocumentOnTypeFormattingParams++type DocumentOnTypeFormattingRequest = RequestMessage ClientMethod DocumentOnTypeFormattingParams (List TextEdit)+type DocumentOnTypeFormattingResponse = ResponseMessage (List TextEdit)++data DocumentOnTypeFormattingRegistrationOptions =+ DocumentOnTypeFormattingRegistrationOptions+ { _firstTriggerCharacter :: Text+ , _moreTriggerCharacter :: Maybe (List String)+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''DocumentOnTypeFormattingRegistrationOptions)++-- ---------------------------------------------------------------------+{-+Rename Request++https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#rename-request++The rename request is sent from the client to the server to perform a+workspace-wide rename of a symbol.++Request++ method: 'textDocument/rename'+ params: RenameParams defined as follows++interface RenameParams {+ /**+ * The document to format.+ */+ textDocument: TextDocumentIdentifier;++ /**+ * The position at which this request was sent.+ */+ position: Position;++ /**+ * The new name of the symbol. If the given name is not valid the+ * request must return a [ResponseError](#ResponseError) with an+ * appropriate message set.+ */+ newName: string;+}++Response++ result: WorkspaceEdit describing the modification to the workspace.+ error: code and message set in case an exception happens during the rename+ request.++Registration Options: TextDocumentRegistrationOptions++-}+data RenameParams =+ RenameParams+ { _textDocument :: TextDocumentIdentifier+ , _position :: Position+ , _newName :: Text+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''RenameParams)+makeFieldsNoPrefix ''RenameParams+++-- {\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"textDocument/rename\",\"params\":{\"textDocument\":{\"uri\":\"file:///home/alanz/mysrc/github/alanz/haskell-lsp/src/HieVscode.hs\"},\"position\":{\"line\":37,\"character\":17},\"newName\":\"getArgs'\"}}++type RenameRequest = RequestMessage ClientMethod RenameParams WorkspaceEdit+type RenameResponse = ResponseMessage WorkspaceEdit++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++Execute a command++The workspace/executeCommand request is sent from the client to the server to+trigger command execution on the server. In most cases the server creates a+WorkspaceEdit structure and applies the changes to the workspace using the+request workspace/applyEdit which is sent from the server to the client.++Request:++ method: 'workspace/executeCommand'+ params: ExecuteCommandParams defined as follows:++export interface ExecuteCommandParams {++ /**+ * The identifier of the actual command handler.+ */+ command: string;+ /**+ * Arguments that the command should be invoked with.+ */+ arguments?: any[];+}++The arguments are typically specified when a command is returned from the server+to the client. Example requests that return a command are+textDocument/codeAction or textDocument/codeLens.++Response:++ result: any+ error: code and message set in case an exception happens during the request.++Registration Options: ExecuteCommandRegistrationOptions defined as follows:++/**+ * Execute command registration options.+ */+export interface ExecuteCommandRegistrationOptions {+ /**+ * The commands to be executed on the server+ */+ commands: string[]+}+-}++data ExecuteCommandParams =+ ExecuteCommandParams+ { _command :: Text+ , _arguments :: Maybe (List A.Value)+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''ExecuteCommandParams)+makeFieldsNoPrefix ''ExecuteCommandParams++type ExecuteCommandRequest = RequestMessage ClientMethod ExecuteCommandParams A.Value+type ExecuteCommandResponse = ResponseMessage A.Value++data ExecuteCommandRegistrationOptions =+ ExecuteCommandRegistrationOptions+ { _commands :: List Text+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''ExecuteCommandRegistrationOptions)+makeFieldsNoPrefix ''ExecuteCommandRegistrationOptions++-- ---------------------------------------------------------------------+{-+New in 3.0+----------++Applies a WorkspaceEdit++The workspace/applyEdit request is sent from the server to the client to modify+resource on the client side.++Request:++ method: 'workspace/applyEdit'+ params: ApplyWorkspaceEditParams defined as follows:++export interface ApplyWorkspaceEditParams {+ /**+ * The edits to apply.+ */+ edit: WorkspaceEdit;+}++Response:++ result: ApplyWorkspaceEditResponse defined as follows:++export interface ApplyWorkspaceEditResponse {+ /**+ * Indicates whether the edit was applied or not.+ */+ applied: boolean;+}++ error: code and message set in case an exception happens during the request.++-}+data ApplyWorkspaceEditParams =+ ApplyWorkspaceEditParams+ { _edit :: WorkspaceEdit+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''ApplyWorkspaceEditParams)+makeFieldsNoPrefix ''ApplyWorkspaceEditParams++data ApplyWorkspaceEditResponseBody =+ ApplyWorkspaceEditResponseBody+ { _applied :: Bool+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''ApplyWorkspaceEditResponseBody)+makeFieldsNoPrefix ''ApplyWorkspaceEditResponseBody++-- | Sent from the server to the client+type ApplyWorkspaceEditRequest = RequestMessage ServerMethod ApplyWorkspaceEditParams ApplyWorkspaceEditResponseBody+type ApplyWorkspaceEditResponse = ResponseMessage ApplyWorkspaceEditResponseBody++-- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%++-- ---------------------------------------------------------------------++data TraceNotificationParams =+ TraceNotificationParams {+ _value :: Text+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''TraceNotificationParams)+makeFieldsNoPrefix ''TraceNotificationParams+++data TraceNotification =+ TraceNotification {+ _params :: TraceNotificationParams+ } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''TraceNotification)+makeFieldsNoPrefix ''TraceNotification++++-- ---------------------------------------------------------------------
+ src/Language/Haskell/LSP/Utility.hs view
@@ -0,0 +1,59 @@+module Language.Haskell.LSP.Utility where+++-- Based on Phoityne.VSCode.Utility++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE+import Language.Haskell.LSP.Constant+import System.Log.Logger++-- ---------------------------------------------------------------------+{-# ANN module ("HLint: ignore Eta reduce" :: String) #-}+{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+-- ---------------------------------------------------------------------++-- |+-- UTF8文字列をByteStringへの変換+--+str2bs :: String -> BS.ByteString+str2bs = TE.encodeUtf8 . T.pack++-- |+-- ByteStringをUTF8文字列への変換+--+bs2str :: BS.ByteString -> String+bs2str = T.unpack. TE.decodeUtf8++-- |+-- UTF8文字列をLazyByteStringへの変換+--+str2lbs :: String -> LBS.ByteString+str2lbs = TLE.encodeUtf8 . TL.pack++-- |+-- LazyByteStringをUTF8文字列への変換+--+lbs2str :: LBS.ByteString -> String+lbs2str = TL.unpack. TLE.decodeUtf8+++-- |+--+rdrop :: Int -> [a] -> [a]+rdrop cnt = reverse . drop cnt . reverse++-- ---------------------------------------------------------------------++logs :: String -> IO ()+logs s = debugM _LOG_NAME s++logm :: B.ByteString -> IO ()+logm str = logs (lbs2str str)+
+ src/Language/Haskell/LSP/VFS.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-++Manage the J.TextDocumentDidChange messages to keep a local copy of the files+in the client workspace, so that tools at the server can operate on them.+-}+module Language.Haskell.LSP.VFS+ (+ VFS+ , VirtualFile(..)+ , openVFS+ , changeVFS+ , closeVFS++ -- * for tests+ , sortChanges+ , deleteChars , addChars+ , changeChars+ , yiSplitAt+ ) where++import Data.Text ( Text )+import Data.List+import qualified Data.Map as Map+import qualified Language.Haskell.LSP.TH.DataTypesJSON as J+import Language.Haskell.LSP.Utility+import qualified Yi.Rope as Yi++-- ---------------------------------------------------------------------+{-# ANN module ("hlint: ignore Eta reduce" :: String) #-}+{-# ANN module ("hlint: ignore Redundant do" :: String) #-}+-- ---------------------------------------------------------------------++data VirtualFile =+ VirtualFile {+ _version :: Int+ , _text :: Yi.YiString+ } deriving (Show)++type VFS = Map.Map J.Uri VirtualFile++-- ---------------------------------------------------------------------++openVFS :: VFS -> J.DidOpenTextDocumentNotification -> IO VFS+openVFS vfs (J.NotificationMessage _ _ params) = do+ let J.DidOpenTextDocumentParams+ (J.TextDocumentItem uri _ version text) = params+ return $ Map.insert uri (VirtualFile version (Yi.fromText text)) vfs++-- ---------------------------------------------------------------------++changeVFS :: VFS -> J.DidChangeTextDocumentNotification -> IO VFS+changeVFS vfs (J.NotificationMessage _ _ params) = do+ let+ J.DidChangeTextDocumentParams vid (J.List changes) = params+ J.VersionedTextDocumentIdentifier uri version = vid+ case Map.lookup uri vfs of+ Just (VirtualFile _ str) -> do+ let str' = applyChanges str changes+ return $ Map.insert uri (VirtualFile version str') vfs+ Nothing -> do+ logs $ "haskell-lsp:changeVfs:can't find uri:" ++ show uri+ return vfs++-- ---------------------------------------------------------------------++closeVFS :: VFS -> J.DidCloseTextDocumentNotification -> IO VFS+closeVFS vfs (J.NotificationMessage _ _ params) = do+ let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier uri) = params+ return $ Map.delete uri vfs++-- ---------------------------------------------------------------------+{-++data TextDocumentContentChangeEvent =+ TextDocumentContentChangeEvent+ { _range :: Maybe Range+ , _rangeLength :: Maybe Int+ , _text :: String+ } deriving (Read,Show,Eq)+-}++-- | Apply the list of changes, in descending order of range. Assuming no overlaps.+applyChanges :: Yi.YiString -> [J.TextDocumentContentChangeEvent] -> Yi.YiString+applyChanges str changes' = r+ where+ changes = sortChanges changes'+ r = foldl' applyChange str changes++-- ---------------------------------------------------------------------++applyChange :: Yi.YiString -> J.TextDocumentContentChangeEvent -> Yi.YiString+applyChange _ (J.TextDocumentContentChangeEvent Nothing Nothing str)+ = Yi.fromText str+applyChange str (J.TextDocumentContentChangeEvent (Just (J.Range fm _to)) (Just len) txt) =+ if txt == ""+ then -- delete len chars from fm+ deleteChars str fm len+ else -- add or change, based on length+ if len == 0+ then addChars str fm txt+ -- Note: changChars comes from applyEdit, emacs will split it into a+ -- delete and an add+ else changeChars str fm len txt+applyChange str (J.TextDocumentContentChangeEvent (Just (J.Range _fm _to)) Nothing _txt)+ -- TODO: This case may occur in the wild, need to convert to-fm into a length.+ -- Or encode a specific addChar function+ = str+applyChange str (J.TextDocumentContentChangeEvent Nothing (Just _) _txt)+ = str++-- ---------------------------------------------------------------------++deleteChars :: Yi.YiString -> J.Position -> Int -> Yi.YiString+deleteChars str (J.Position l c) len = str'+ where+ (before,after) = Yi.splitAtLine l str+ -- after contains the area we care about, starting with the selected line.+ -- Due to LSP zero-based coordinates+ beforeOnLine = Yi.take c after+ after' = Yi.drop (c + len) after+ str' = Yi.append before (Yi.append beforeOnLine after')++-- ---------------------------------------------------------------------++addChars :: Yi.YiString -> J.Position -> Text -> Yi.YiString+addChars str (J.Position l c) new = str'+ where+ (before,after) = Yi.splitAtLine l str+ -- after contains the area we care about, starting with the selected line.+ -- Due to LSP zero-based coordinates+ beforeOnLine = Yi.take c after+ after' = Yi.drop c after+ str' = Yi.concat [before, beforeOnLine, (Yi.fromText new), after']++-- ---------------------------------------------------------------------++changeChars :: Yi.YiString -> J.Position -> Int -> Text -> Yi.YiString+changeChars str (J.Position ls cs) len new = str'+ where+ (before,after) = yiSplitAt ls cs str+ after' = Yi.drop len after++ str' = Yi.concat [before, (Yi.fromText new), after']++-- changeChars :: Yi.YiString -> J.Position -> J.Position -> String -> Yi.YiString+-- changeChars str (J.Position ls cs) (J.Position le ce) new = str'+-- where+-- (before,_after) = yiSplitAt ls cs str+-- (_before,after) = yiSplitAt le ce str++-- str' = Yi.concat [before, (Yi.fromString new), after]+-- -- str' = Yi.concat [before]+-- -- str' = Yi.concat [_before]++-- ---------------------------------------------------------------------++yiSplitAt :: Int -> Int -> Yi.YiString -> (Yi.YiString, Yi.YiString)+yiSplitAt l c str = (before,after)+ where+ (b,a) = Yi.splitAtLine l str+ before = Yi.concat [b,Yi.take c a]+ after = Yi.drop c a+++-- ---------------------------------------------------------------------++sortChanges :: [J.TextDocumentContentChangeEvent] -> [J.TextDocumentContentChangeEvent]+sortChanges changes = changes'+ where+ myComp (J.TextDocumentContentChangeEvent (Just r1) _ _)+ (J.TextDocumentContentChangeEvent (Just r2) _ _)+ = compare r2 r1 -- want descending order+ myComp _ _ = EQ+ changes' = sortBy myComp changes++-- ---------------------------------------------------------------------
+ test/DiagnosticsSpec.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE OverloadedStrings #-}+module DiagnosticsSpec where+++import qualified Data.Map as Map+-- import qualified Data.Text as T+import Data.Text ( Text )+import Language.Haskell.LSP.Diagnostics+import qualified Language.Haskell.LSP.TH.DataTypesJSON as J++import Test.Hspec++-- ---------------------------------------------------------------------++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "Diagnostics functions" diagnosticsSpec++-- -- |Used when running from ghci, and it sets the current directory to ./tests+-- tt :: IO ()+-- tt = do+-- cd ".."+-- hspec spec++-- ---------------------------------------------------------------------++mkDiagnostic :: Maybe J.DiagnosticSource -> Text -> J.Diagnostic+mkDiagnostic ms str = J.Diagnostic (J.Range (J.Position 0 1) (J.Position 3 0)) Nothing Nothing ms str++-- ---------------------------------------------------------------------++diagnosticsSpec :: Spec+diagnosticsSpec = do+ describe "constructs a new store" $ do+ it "constructs a store with no doc version and a single source" $ do+ let+ diags =+ [ mkDiagnostic (Just "hlint") "a"+ , mkDiagnostic (Just "hlint") "b"+ ]+ (updateDiagnostics Map.empty (J.Uri "uri") Nothing (partitionBySource diags)) `shouldBe`+ Map.fromList+ [ ((J.Uri "uri"),StoreItem Nothing $ Map.fromList [(Just "hlint", reverse diags) ] )+ ]++ -- ---------------------------------++ it "constructs a store with no doc version and multiple sources" $ do+ let+ diags =+ [ mkDiagnostic (Just "hlint") "a"+ , mkDiagnostic (Just "ghcmod") "b"+ ]+ (updateDiagnostics Map.empty (J.Uri "uri") Nothing (partitionBySource diags)) `shouldBe`+ Map.fromList+ [ ((J.Uri "uri"),StoreItem Nothing $ Map.fromList+ [(Just "hlint", [mkDiagnostic (Just "hlint") "a"])+ ,(Just "ghcmod", [mkDiagnostic (Just "ghcmod") "b"])+ ])+ ]++ -- ---------------------------------++ it "constructs a store with doc version and multiple sources" $ do+ let+ diags =+ [ mkDiagnostic (Just "hlint") "a"+ , mkDiagnostic (Just "ghcmod") "b"+ ]+ (updateDiagnostics Map.empty (J.Uri "uri") (Just 1) (partitionBySource diags)) `shouldBe`+ Map.fromList+ [ ((J.Uri "uri"),StoreItem (Just 1) $ Map.fromList+ [(Just "hlint", [mkDiagnostic (Just "hlint") "a"])+ ,(Just "ghcmod", [mkDiagnostic (Just "ghcmod") "b"])+ ])+ ]++ -- ---------------------------------++ describe "updates a store for same document version" $ do+ it "updates a store without a document version, single source only" $ do+ let+ diags1 =+ [ mkDiagnostic (Just "hlint") "a1"+ , mkDiagnostic (Just "hlint") "b1"+ ]+ diags2 =+ [ mkDiagnostic (Just "hlint") "a2"+ ]+ let origStore = updateDiagnostics Map.empty (J.Uri "uri") Nothing (partitionBySource diags1)+ (updateDiagnostics origStore (J.Uri "uri") Nothing (partitionBySource diags2)) `shouldBe`+ Map.fromList+ [ ((J.Uri "uri"),StoreItem Nothing $ Map.fromList [(Just "hlint", diags2) ] )+ ]++ -- ---------------------------------++ it "updates just one source of a 2 source store" $ do+ let+ diags1 =+ [ mkDiagnostic (Just "hlint") "a1"+ , mkDiagnostic (Just "ghcmod") "b1"+ ]+ diags2 =+ [ mkDiagnostic (Just "hlint") "a2"+ ]+ let origStore = updateDiagnostics Map.empty (J.Uri "uri") Nothing (partitionBySource diags1)+ (updateDiagnostics origStore (J.Uri "uri") Nothing (partitionBySource diags2)) `shouldBe`+ Map.fromList+ [ ((J.Uri "uri"),StoreItem Nothing $ Map.fromList+ [(Just "hlint", [mkDiagnostic (Just "hlint") "a2"])+ ,(Just "ghcmod", [mkDiagnostic (Just "ghcmod") "b1"])+ ] )+ ]++ -- ---------------------------------++ it "updates just one source of a 2 source store, with empty diags" $ do+ let+ diags1 =+ [ mkDiagnostic (Just "hlint") "a1"+ , mkDiagnostic (Just "ghcmod") "b1"+ ]+ let origStore = updateDiagnostics Map.empty (J.Uri "uri") Nothing (partitionBySource diags1)+ (updateDiagnostics origStore (J.Uri "uri") Nothing (Map.fromList [(Just "ghcmod", [])])) `shouldBe`+ Map.fromList+ [ ((J.Uri "uri"),StoreItem Nothing $ Map.fromList+ [(Just "ghcmod", [])+ ,(Just "hlint", [mkDiagnostic (Just "hlint") "a1"])+ ] )+ ]+++ -- ---------------------------------++ describe "updates a store for a new document version" $ do+ it "updates a store without a document version, single source only" $ do+ let+ diags1 =+ [ mkDiagnostic (Just "hlint") "a1"+ , mkDiagnostic (Just "hlint") "b1"+ ]+ diags2 =+ [ mkDiagnostic (Just "hlint") "a2"+ ]+ let origStore = updateDiagnostics Map.empty (J.Uri "uri") (Just 1) (partitionBySource diags1)+ (updateDiagnostics origStore (J.Uri "uri") (Just 2) (partitionBySource diags2)) `shouldBe`+ Map.fromList+ [ ((J.Uri "uri"),StoreItem (Just 2) $ Map.fromList [(Just "hlint", diags2) ] )+ ]++ -- ---------------------------------++ it "updates a store for a new doc version, removing all priot sources" $ do+ let+ diags1 =+ [ mkDiagnostic (Just "hlint") "a1"+ , mkDiagnostic (Just "ghcmod") "b1"+ ]+ diags2 =+ [ mkDiagnostic (Just "hlint") "a2"+ ]+ let origStore = updateDiagnostics Map.empty (J.Uri "uri") (Just 1) (partitionBySource diags1)+ (updateDiagnostics origStore (J.Uri "uri") (Just 2) (partitionBySource diags2)) `shouldBe`+ Map.fromList+ [ ((J.Uri "uri"),StoreItem (Just 2) $ Map.fromList+ [(Just "hlint", [mkDiagnostic (Just "hlint") "a2"])+ ] )+ ]++ -- ---------------------------------++ describe "retrieves all the diagnostics for a given uri" $ do++ it "gets diagnostics for multiple sources" $ do+ let+ diags =+ [ mkDiagnostic (Just "hlint") "a"+ , mkDiagnostic (Just "ghcmod") "b"+ ]+ let ds = updateDiagnostics Map.empty (J.Uri "uri") (Just 1) (partitionBySource diags)+ (getDiagnosticParamsFor ds (J.Uri "uri")) `shouldBe`+ Just (J.PublishDiagnosticsParams (J.Uri "uri") (J.List $ reverse diags))++ -- ---------------------------------
+ test/Main.hs view
@@ -0,0 +1,22 @@+module Main where+++-- import Test.Hspec.Formatters.Jenkins+import Test.Hspec.Runner+import qualified Spec++-- ---------------------------------------------------------------------++main :: IO ()+main = hspec Spec.spec++-- main :: IO ()+-- main = do+-- summary <- withFile "results.xml" WriteMode $ \h -> do+-- let c = defaultConfig+-- { configFormatter = xmlFormatter+-- , configHandle = h+-- }+-- hspecWith c Spec.spec+-- unless (summaryFailures summary == 0) $+-- exitFailure
+ test/MethodSpec.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedStrings #-}+module MethodSpec where+++import Control.Monad+import qualified Data.Aeson as J+import qualified Language.Haskell.LSP.TH.DataTypesJSON as J+import Test.Hspec+import qualified Data.Text as T++-- ---------------------------------------------------------------------++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "Method enum aeson instance consistency" diagnosticsSpec++-- ---------------------------------------------------------------------++clientMethods :: [T.Text]+clientMethods = [+ -- General+ "initialize"+ ,"initialized"+ ,"shutdown"+ ,"exit"+ ,"$/cancelRequest"+ -- Workspace+ ,"workspace/didChangeConfiguration"+ ,"workspace/didChangeWatchedFiles"+ ,"workspace/symbol"+ ,"workspace/executeCommand"+ -- Document+ ,"textDocument/didOpen"+ ,"textDocument/didChange"+ ,"textDocument/willSave"+ ,"textDocument/willSaveWaitUntil"+ ,"textDocument/didSave"+ ,"textDocument/didClose"+ ,"textDocument/completion"+ ,"completionItem/resolve"+ ,"textDocument/hover"+ ,"textDocument/signatureHelp"+ ,"textDocument/references"+ ,"textDocument/documentHighlight"+ ,"textDocument/documentSymbol"+ ,"textDocument/formatting"+ ,"textDocument/rangeFormatting"+ ,"textDocument/onTypeFormatting"+ ,"textDocument/definition"+ ,"textDocument/codeAction"+ ,"textDocument/codeLens"+ ,"codeLens/resolve"+ ,"textDocument/documentLink"+ ,"documentLink/resolve"+ ,"textDocument/rename"+ ]++serverMethods :: [T.Text]+serverMethods = [+ -- Window+ "window/showMessage"+ ,"window/showMessageRequest"+ ,"window/logMessage"+ ,"telemetry/event"+ -- Client+ ,"client/registerCapability"+ ,"client/unregisterCapability"+ -- Workspace+ ,"workspace/applyEdit"+ -- Document+ ,"textDocument/publishDiagnostics"+ ]++diagnosticsSpec :: Spec+diagnosticsSpec = do+ describe "Client Methods" $ do+ it "maintains roundtrip consistency" $ do+ forM_ clientMethods $ \m -> do+ (J.toJSON <$> (J.fromJSON (J.String m) :: J.Result J.ClientMethod))+ `shouldBe` (J.Success $ J.String m)+ describe "Server Methods" $ do+ it "maintains roundtrip consistency" $ do+ forM_ serverMethods $ \m -> do+ (J.toJSON <$> (J.fromJSON (J.String m) :: J.Result J.ServerMethod))+ `shouldBe` (J.Success $ J.String m)++ -- ---------------------------------
+ test/Spec.hs view
@@ -0,0 +1,9 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}+{-++See https://github.com/hspec/hspec/tree/master/hspec-discover#readme+to understand this module++Or http://hspec.github.io/hspec-discover.html++-}
+ test/VspSpec.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE OverloadedStrings #-}+module VspSpec where+++import Language.Haskell.LSP.VFS+import qualified Language.Haskell.LSP.TH.DataTypesJSON as J+import qualified Yi.Rope as Yi++import Test.Hspec++-- ---------------------------------------------------------------------++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "VSP functions" vspSpec++-- -- |Used when running from ghci, and it sets the current directory to ./tests+-- tt :: IO ()+-- tt = do+-- cd ".."+-- hspec spec++-- ---------------------------------------------------------------------+++mkRange :: Int -> Int -> Int -> Int -> Maybe J.Range+mkRange ls cs le ce = Just $ J.Range (J.Position ls cs) (J.Position le ce)++-- ---------------------------------------------------------------------++vspSpec :: Spec+vspSpec = do+ describe "sorts changes" $ do+ it "sorts changes that all have ranges" $ do+ let+ unsorted =+ [ (J.TextDocumentContentChangeEvent (mkRange 1 0 2 0) Nothing "")+ , (J.TextDocumentContentChangeEvent (mkRange 2 0 3 0) Nothing "")+ ]+ (sortChanges unsorted) `shouldBe`+ [ (J.TextDocumentContentChangeEvent (mkRange 2 0 3 0) Nothing "")+ , (J.TextDocumentContentChangeEvent (mkRange 1 0 2 0) Nothing "")+ ]++ -- ---------------------------------++ describe "deletes characters" $ do+ it "deletes characters within a line" $ do+ -- based on vscode log+ let+ orig = unlines+ [ "abcdg"+ , "module Foo where"+ , "-- fooo"+ , "foo :: Int"+ ]+ new = deleteChars (Yi.fromString orig) (J.Position 2 1) 4+ lines (Yi.toString new) `shouldBe`+ [ "abcdg"+ , "module Foo where"+ , "-oo"+ , "foo :: Int"+ ]++ -- ---------------------------------++ it "deletes one line" $ do+ -- based on vscode log+ let+ orig = unlines+ [ "abcdg"+ , "module Foo where"+ , "-- fooo"+ , "foo :: Int"+ ]+ new = deleteChars (Yi.fromString orig) (J.Position 2 0) 8+ lines (Yi.toString new) `shouldBe`+ [ "abcdg"+ , "module Foo where"+ , "foo :: Int"+ ]+ -- ---------------------------------++ it "deletes two lines" $ do+ -- based on vscode log+ let+ orig = unlines+ [ "module Foo where"+ , "-- fooo"+ , "foo :: Int"+ , "foo = bb"+ ]+ new = deleteChars (Yi.fromString orig) (J.Position 1 0) 19+ lines (Yi.toString new) `shouldBe`+ [ "module Foo where"+ , "foo = bb"+ ]++ -- ---------------------------------++ describe "adds characters" $ do+ it "adds one line" $ do+ -- based on vscode log+ let+ orig = unlines+ [ "abcdg"+ , "module Foo where"+ , "foo :: Int"+ ]+ new = addChars (Yi.fromString orig) (J.Position 1 16) "\n-- fooo"+ lines (Yi.toString new) `shouldBe`+ [ "abcdg"+ , "module Foo where"+ , "-- fooo"+ , "foo :: Int"+ ]++ -- ---------------------------------++ it "adds two lines" $ do+ -- based on vscode log+ let+ orig = unlines+ [ "module Foo where"+ , "foo = bb"+ ]+ new = addChars (Yi.fromString orig) (J.Position 1 8) "\n-- fooo\nfoo :: Int"+ lines (Yi.toString new) `shouldBe`+ [ "module Foo where"+ , "foo = bb"+ , "-- fooo"+ , "foo :: Int"+ ]++ -- ---------------------------------++ describe "changes characters" $ do+ it "removes end of a line" $ do+ -- based on vscode log+ let+ orig = unlines+ [ "module Foo where"+ , "-- fooo"+ , "foo :: Int"+ , "foo = bb"+ , ""+ , "bb = 5"+ , ""+ , "baz = do"+ , " putStrLn \"hello world\""+ ]+ -- new = changeChars (Yi.fromString orig) (J.Position 7 0) (J.Position 7 8) "baz ="+ new = changeChars (Yi.fromString orig) (J.Position 7 0) 8 "baz ="+ lines (Yi.toString new) `shouldBe`+ [ "module Foo where"+ , "-- fooo"+ , "foo :: Int"+ , "foo = bb"+ , ""+ , "bb = 5"+ , ""+ , "baz ="+ , " putStrLn \"hello world\""+ ]