diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 000000000..bfadaf423 --- /dev/null +++ b/.gitattributes @@ -0,0 +1 @@ +lsp-types/generated linguist-generated=true diff --git a/cabal.project b/cabal.project index 4ffb13028..3239e7e4a 100644 --- a/cabal.project +++ b/cabal.project @@ -6,7 +6,7 @@ packages: package lsp flags: +demo -index-state: 2023-01-01T00:00:00Z +index-state: 2023-05-18T00:00:00Z tests: True benchmarks: True diff --git a/lsp-test/ChangeLog.md b/lsp-test/ChangeLog.md index c667c2772..3a4b3f8ed 100644 --- a/lsp-test/ChangeLog.md +++ b/lsp-test/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for lsp-test +## 0.15.0.0 + +* Support `lsp-types-2.0.0.0` and `lsp-2.0.0.0`. + ## 0.14.1.0 * Compatibility with new `lsp-types` major version. diff --git a/lsp-test/bench/SimpleBench.hs b/lsp-test/bench/SimpleBench.hs index 72d868e2e..9c2897e73 100644 --- a/lsp-test/bench/SimpleBench.hs +++ b/lsp-test/bench/SimpleBench.hs @@ -1,13 +1,16 @@ {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE GADTs, OverloadedStrings #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DuplicateRecordFields #-} module Main where import Language.LSP.Server import qualified Language.LSP.Test as Test -import Language.LSP.Types +import Language.LSP.Protocol.Types hiding (options, range, start, end) +import Language.LSP.Protocol.Message import Control.Monad.IO.Class import Control.Monad -import System.Process +import System.Process hiding (env) import System.Environment import System.Time.Extra import Control.Concurrent @@ -15,16 +18,16 @@ import Data.IORef handlers :: Handlers (LspM ()) handlers = mconcat - [ requestHandler STextDocumentHover $ \req responder -> do - let RequestMessage _ _ _ (HoverParams _doc pos _workDone) = req + [ requestHandler SMethod_TextDocumentHover $ \req responder -> do + let TRequestMessage _ _ _ (HoverParams _doc pos _workDone) = req Position _l _c' = pos rsp = Hover ms (Just range) - ms = HoverContents $ markedUpContent "lsp-demo-simple-server" "Hello world" + ms = InL $ mkMarkdown "Hello world" range = Range pos pos - responder (Right $ Just rsp) - , requestHandler STextDocumentDefinition $ \req responder -> do - let RequestMessage _ _ _ (DefinitionParams (TextDocumentIdentifier doc) pos _ _) = req - responder (Right $ InL $ Location doc $ Range pos pos) + responder (Right $ InL rsp) + , requestHandler SMethod_TextDocumentDefinition $ \req responder -> do + let TRequestMessage _ _ _ (DefinitionParams (TextDocumentIdentifier doc) pos _ _) = req + responder (Right $ InL $ Definition $ InL $ Location doc $ Range pos pos) ] server :: ServerDefinition () @@ -44,19 +47,19 @@ main = do n <- read . head <$> getArgs - forkIO $ void $ runServerWithHandles mempty mempty hinRead houtWrite server + _ <- forkIO $ void $ runServerWithHandles mempty mempty hinRead houtWrite server liftIO $ putStrLn $ "Starting " <> show n <> " rounds" - i <- newIORef 0 + i <- newIORef (0 :: Integer) Test.runSessionWithHandles hinWrite houtRead Test.defaultConfig Test.fullCaps "." $ do start <- liftIO offsetTime replicateM_ n $ do - n <- liftIO $ readIORef i - liftIO $ when (n `mod` 1000 == 0) $ putStrLn $ show n - ResponseMessage{_result=Right (Just _)} <- Test.request STextDocumentHover $ + v <- liftIO $ readIORef i + liftIO $ when (v `mod` 1000 == 0) $ putStrLn $ show v + TResponseMessage{_result=Right (InL _)} <- Test.request SMethod_TextDocumentHover $ HoverParams (TextDocumentIdentifier $ Uri "test") (Position 1 100) Nothing - ResponseMessage{_result=Right (InL _)} <- Test.request STextDocumentDefinition $ + TResponseMessage{_result=Right (InL _)} <- Test.request SMethod_TextDocumentDefinition $ DefinitionParams (TextDocumentIdentifier $ Uri "test") (Position 1000 100) Nothing Nothing liftIO $ modifyIORef' i (+1) diff --git a/lsp-test/example/Test.hs b/lsp-test/example/Test.hs index 7763edb70..72cbd5a16 100644 --- a/lsp-test/example/Test.hs +++ b/lsp-test/example/Test.hs @@ -2,7 +2,8 @@ import Control.Applicative.Combinators import Control.Monad.IO.Class import Language.LSP.Test -import Language.LSP.Types +import Language.LSP.Protocol.Types +import Language.LSP.Protocol.Message main = runSession "lsp-demo-reactor-server" fullCaps "test/data/" $ do doc <- openDoc "Rename.hs" "haskell" @@ -11,7 +12,7 @@ main = runSession "lsp-demo-reactor-server" fullCaps "test/data/" $ do skipManyTill loggingNotification (count 1 publishDiagnosticsNotification) -- Send requests and notifications and receive responses - rsp <- request STextDocumentDocumentSymbol $ + rsp <- request SMethod_TextDocumentDocumentSymbol $ DocumentSymbolParams Nothing Nothing doc liftIO $ print rsp diff --git a/lsp-test/func-test/FuncTest.hs b/lsp-test/func-test/FuncTest.hs index 46016423a..7620b9ec3 100644 --- a/lsp-test/func-test/FuncTest.hs +++ b/lsp-test/func-test/FuncTest.hs @@ -4,8 +4,8 @@ module Main where import Language.LSP.Server import qualified Language.LSP.Test as Test -import Language.LSP.Types -import Language.LSP.Types.Lens hiding (options) +import Language.LSP.Protocol.Types hiding (options, error) +import Language.LSP.Protocol.Message hiding (options, error) import Control.Monad.IO.Class import System.IO import Control.Monad @@ -41,7 +41,7 @@ main = hspec $ do handlers :: MVar () -> Handlers (LspM ()) handlers killVar = - notificationHandler SInitialized $ \noti -> do + notificationHandler SMethod_Initialized $ \noti -> do tid <- withRunInIO $ \runInIO -> forkIO $ runInIO $ withProgress "Doing something" NotCancellable $ \updater -> @@ -55,20 +55,16 @@ main = hspec $ do Test.runSessionWithHandles hinWrite houtRead Test.defaultConfig Test.fullCaps "." $ do -- First make sure that we get a $/progress begin notification skipManyTill Test.anyMessage $ do - x <- Test.message SProgress - let isBegin (Begin _) = True - isBegin _ = False - guard $ isBegin $ x ^. params . value + x <- Test.message SMethod_Progress + guard $ has (params . value . _workDoneProgressBegin) x -- Then kill the thread liftIO $ putMVar killVar () -- Then make sure we still get a $/progress end notification skipManyTill Test.anyMessage $ do - x <- Test.message SProgress - let isEnd (End _) = True - isEnd _ = False - guard $ isEnd $ x ^. params . value + x <- Test.message SMethod_Progress + guard $ has (params . value . _workDoneProgressEnd) x describe "workspace folders" $ it "keeps track of open workspace folders" $ do @@ -77,9 +73,9 @@ main = hspec $ do countVar <- newMVar 0 - let wf0 = WorkspaceFolder "one" "Starter workspace" - wf1 = WorkspaceFolder "/foo/bar" "My workspace" - wf2 = WorkspaceFolder "/foo/baz" "My other workspace" + let wf0 = WorkspaceFolder (filePathToUri "one") "Starter workspace" + wf1 = WorkspaceFolder (filePathToUri "/foo/bar") "My workspace" + wf2 = WorkspaceFolder (filePathToUri "/foo/baz") "My other workspace" definition = ServerDefinition { onConfigurationChange = const $ const $ Right () @@ -92,10 +88,10 @@ main = hspec $ do handlers :: Handlers (LspM ()) handlers = mconcat - [ notificationHandler SInitialized $ \noti -> do + [ notificationHandler SMethod_Initialized $ \noti -> do wfs <- fromJust <$> getWorkspaceFolders liftIO $ wfs `shouldContain` [wf0] - , notificationHandler SWorkspaceDidChangeWorkspaceFolders $ \noti -> do + , notificationHandler SMethod_WorkspaceDidChangeWorkspaceFolders $ \noti -> do i <- liftIO $ modifyMVar countVar (\i -> pure (i + 1, i)) wfs <- fromJust <$> getWorkspaceFolders liftIO $ case i of @@ -116,11 +112,9 @@ main = hspec $ do } changeFolders add rmv = - let addedFolders = List add - removedFolders = List rmv - ev = WorkspaceFoldersChangeEvent addedFolders removedFolders + let ev = WorkspaceFoldersChangeEvent add rmv ps = DidChangeWorkspaceFoldersParams ev - in Test.sendNotification SWorkspaceDidChangeWorkspaceFolders ps + in Test.sendNotification SMethod_WorkspaceDidChangeWorkspaceFolders ps Test.runSessionWithHandles hinWrite houtRead config Test.fullCaps "." $ do changeFolders [wf1] [] diff --git a/lsp-test/lsp-test.cabal b/lsp-test/lsp-test.cabal index 115d3a527..adead98fb 100644 --- a/lsp-test/lsp-test.cabal +++ b/lsp-test/lsp-test.cabal @@ -1,7 +1,7 @@ -cabal-version: 2.4 -name: lsp-test -version: 0.14.1.0 -synopsis: Functional test framework for LSP servers. +cabal-version: 2.4 +name: lsp-test +version: 0.15.0.0 +synopsis: Functional test framework for LSP servers. description: A test framework for writing tests against . @@ -10,126 +10,143 @@ description: To see examples of it in action, check out , and . -homepage: https://github.com/haskell/lsp/blob/master/lsp-test/README.md -license: BSD-3-Clause -license-file: LICENSE -author: Luke Lau -maintainer: luke_lau@icloud.com -bug-reports: https://github.com/haskell/lsp/issues -copyright: 2021 Luke Lau -category: Testing -build-type: Simple -extra-source-files: README.md - , ChangeLog.md - , test/data/**/*.hs -tested-with: GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1, GHC == 8.10.2 + +homepage: + https://github.com/haskell/lsp/blob/master/lsp-test/README.md + +license: BSD-3-Clause +license-file: LICENSE +author: Luke Lau +maintainer: luke_lau@icloud.com +bug-reports: https://github.com/haskell/lsp/issues +copyright: 2021 Luke Lau +category: Testing +build-type: Simple +extra-source-files: + ChangeLog.md + README.md + test/data/**/*.hs source-repository head type: git location: https://github.com/haskell/lsp library - hs-source-dirs: src - exposed-modules: Language.LSP.Test - reexported-modules: lsp-types:Language.LSP.Types - , lsp-types:Language.LSP.Types.Capabilities - , parser-combinators:Control.Applicative.Combinators - default-language: Haskell2010 - build-depends: base >= 4.10 && < 5 - , lsp-types == 1.5.* || == 1.6.* - , lsp == 1.5.* || == 1.6.* - , aeson - , time - , aeson-pretty - , ansi-terminal - , async >= 2.0 - , bytestring - , co-log-core - , conduit - , conduit-parse == 0.2.* - , containers >= 0.5.9 - , data-default - , Diff >= 0.3 - , directory - , exceptions - , filepath - , Glob >= 0.9 && < 0.11 - , lens - , mtl < 2.4 - , parser-combinators >= 1.2 - , process >= 1.6 - , text - , transformers - , unordered-containers - , some + hs-source-dirs: src + default-language: Haskell2010 + exposed-modules: Language.LSP.Test + reexported-modules: + lsp-types:Language.LSP.Protocol.Types + , lsp-types:Language.LSP.Protocol.Message + , lsp-types:Language.LSP.Protocol.Capabilities + , parser-combinators:Control.Applicative.Combinators + + build-depends: + , aeson + , aeson-pretty + , ansi-terminal + , async >=2.0 + , base >=4.10 && <5 + , bytestring + , co-log-core + , conduit + , conduit-parse ^>=0.2 + , containers >=0.5.9 + , data-default + , Diff >=0.3 + , directory + , exceptions + , filepath + , Glob >=0.9 && <0.11 + , lens + , lsp ^>=2.0 + , lsp-types ^>=2.0 + , mtl <2.4 + , parser-combinators >=1.2 + , process >=1.6 + , row-types + , some + , text + , time + , transformers + if os(windows) - build-depends: Win32 + build-depends: Win32 else - build-depends: unix - other-modules: Language.LSP.Test.Compat - Language.LSP.Test.Decoding - Language.LSP.Test.Exceptions - Language.LSP.Test.Files - Language.LSP.Test.Parsing - Language.LSP.Test.Server - Language.LSP.Test.Session - ghc-options: -W + build-depends: unix + + other-modules: + Language.LSP.Test.Compat + Language.LSP.Test.Decoding + Language.LSP.Test.Exceptions + Language.LSP.Test.Files + Language.LSP.Test.Parsing + Language.LSP.Test.Server + Language.LSP.Test.Session + + ghc-options: -W test-suite tests - type: exitcode-stdio-1.0 - main-is: Test.hs - other-modules: DummyServer - hs-source-dirs: test - ghc-options: -W - build-depends: base >= 4.10 && < 5 - , hspec - , lens - , lsp == 1.6.* - , lsp-test - , data-default - , aeson - , unordered-containers - , text - , directory - , filepath - , unliftio - , process - , mtl < 2.4 - , aeson - default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Test.hs + default-language: Haskell2010 + ghc-options: -W + other-modules: DummyServer + build-depends: + , aeson + , base >=4.10 && <5 + , containers + , data-default + , directory + , filepath + , hspec + , lens + , lsp ^>=2.0 + , lsp-test + , mtl <2.4 + , process + , text + , unliftio + test-suite func-test - main-is: FuncTest.hs - hs-source-dirs: func-test - type: exitcode-stdio-1.0 - build-depends: base - , lsp-test - , lsp - , process - , co-log-core - , lens - , unliftio - , hspec - default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: func-test + default-language: Haskell2010 + main-is: FuncTest.hs + build-depends: + , base + , co-log-core + , hspec + , lens + , lsp + , lsp-test + , process + , unliftio + test-suite example - main-is: Test.hs - hs-source-dirs: example - type: exitcode-stdio-1.0 - default-language: Haskell2010 - build-depends: base - , lsp-test - , parser-combinators - build-tool-depends: lsp:lsp-demo-reactor-server + type: exitcode-stdio-1.0 + hs-source-dirs: example + default-language: Haskell2010 + main-is: Test.hs + build-depends: + , base + , lsp-test + , parser-combinators + build-tool-depends: lsp:lsp-demo-reactor-server benchmark simple-bench - main-is: SimpleBench.hs - hs-source-dirs: bench - type: exitcode-stdio-1.0 - build-depends: base - , lsp-test - , lsp - , process - , extra - default-language: Haskell2010 - ghc-options: -Wall -O2 -eventlog -rtsopts + type: exitcode-stdio-1.0 + hs-source-dirs: bench + default-language: Haskell2010 + main-is: SimpleBench.hs + ghc-options: -Wall -O2 -eventlog -rtsopts + build-depends: + , base + , extra + , lsp + , lsp-test + , process + diff --git a/lsp-test/src/Language/LSP/Test.hs b/lsp-test/src/Language/LSP/Test.hs index 8d977f321..a0259e309 100644 --- a/lsp-test/src/Language/LSP/Test.hs +++ b/lsp-test/src/Language/LSP/Test.hs @@ -113,16 +113,16 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.IO as T -import Data.Aeson +import Data.Aeson hiding (Null) import Data.Default -import qualified Data.HashMap.Strict as HashMap import Data.List import Data.Maybe -import Language.LSP.Types -import Language.LSP.Types.Lens hiding - (id, capabilities, message, executeCommand, applyEdit, rename, to) -import qualified Language.LSP.Types.Lens as LSP -import qualified Language.LSP.Types.Capabilities as C +import Language.LSP.Protocol.Types + hiding (capabilities, message, executeCommand, applyEdit, rename, to, id) +import Language.LSP.Protocol.Message +import qualified Language.LSP.Protocol.Types as LSP +import qualified Language.LSP.Protocol.Message as LSP +import qualified Language.LSP.Protocol.Capabilities as C import Language.LSP.VFS import Language.LSP.Test.Compat import Language.LSP.Test.Decoding @@ -147,7 +147,7 @@ import Control.Monad.State (execState) -- > params = TextDocumentPositionParams doc -- > hover <- request STextdocumentHover params runSession :: String -- ^ The command to run the server. - -> C.ClientCapabilities -- ^ The capabilities that the client should declare. + -> ClientCapabilities -- ^ The capabilities that the client should declare. -> FilePath -- ^ The filepath to the root directory for the session. -> Session a -- ^ The session to run. -> IO a @@ -156,7 +156,7 @@ runSession = runSessionWithConfig def -- | Starts a new session with a custom configuration. runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session. -> String -- ^ The command to run the server. - -> C.ClientCapabilities -- ^ The capabilities that the client should declare. + -> ClientCapabilities -- ^ The capabilities that the client should declare. -> FilePath -- ^ The filepath to the root directory for the session. -> Session a -- ^ The session to run. -> IO a @@ -166,7 +166,7 @@ runSessionWithConfig = runSessionWithConfigCustomProcess id runSessionWithConfigCustomProcess :: (CreateProcess -> CreateProcess) -- ^ Tweak the 'CreateProcess' used to start the server. -> SessionConfig -- ^ Configuration options for the session. -> String -- ^ The command to run the server. - -> C.ClientCapabilities -- ^ The capabilities that the client should declare. + -> ClientCapabilities -- ^ The capabilities that the client should declare. -> FilePath -- ^ The filepath to the root directory for the session. -> Session a -- ^ The session to run. -> IO a @@ -188,7 +188,7 @@ runSessionWithConfigCustomProcess modifyCreateProcess config' serverExe caps roo runSessionWithHandles :: Handle -- ^ The input handle -> Handle -- ^ The output handle -> SessionConfig - -> C.ClientCapabilities -- ^ The capabilities that the client should declare. + -> ClientCapabilities -- ^ The capabilities that the client should declare. -> FilePath -- ^ The filepath to the root directory for the session. -> Session a -- ^ The session to run. -> IO a @@ -199,7 +199,7 @@ runSessionWithHandles' :: Maybe ProcessHandle -> Handle -- ^ The input handle -> Handle -- ^ The output handle -> SessionConfig - -> C.ClientCapabilities -- ^ The capabilities that the client should declare. + -> ClientCapabilities -- ^ The capabilities that the client should declare. -> FilePath -- ^ The filepath to the root directory for the session. -> Session a -- ^ The session to run. -> IO a @@ -212,21 +212,22 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio let initializeParams = InitializeParams Nothing -- Narrowing to Int32 here, but it's unlikely that a PID will -- be outside the range - (Just $ fromIntegral pid) + (InL $ fromIntegral pid) (Just lspTestClientInfo) (Just $ T.pack absRootDir) - (Just $ filePathToUri absRootDir) - (lspConfig config') + Nothing + (InL $ filePathToUri absRootDir) caps - (Just TraceOff) - (List <$> initialWorkspaceFolders config) + (lspConfig config') + (Just TraceValues_Off) + (fmap InL $ initialWorkspaceFolders config) runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do -- Wrap the session around initialize and shutdown calls - initReqId <- sendRequest SInitialize initializeParams + initReqId <- sendRequest SMethod_Initialize initializeParams -- Because messages can be sent in between the request and response, -- collect them and then... - (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId SInitialize initReqId) + (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId SMethod_Initialize initReqId) case initRspMsg ^. LSP.result of Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error) @@ -234,10 +235,10 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio initRspVar <- initRsp <$> ask liftIO $ putMVar initRspVar initRspMsg - sendNotification SInitialized (Just InitializedParams) + sendNotification SMethod_Initialized InitializedParams case lspConfig config of - Just cfg -> sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg) + Just cfg -> sendNotification SMethod_WorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg) Nothing -> return () -- ... relay them back to the user Session so they can match on them! @@ -251,7 +252,7 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio where -- | Asks the server to shutdown and exit politely exitServer :: Session () - exitServer = request_ SShutdown Empty >> sendNotification SExit Empty + exitServer = request_ SMethod_Shutdown Nothing >> sendNotification SMethod_Exit Nothing -- | Listens to the server output until the shutdown ACK, -- makes sure it matches the record and signals any semaphores @@ -264,17 +265,17 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio writeChan (messageChan context) (ServerMessage msg) case msg of - (FromServerRsp SShutdown _) -> return () + (FromServerRsp SMethod_Shutdown _) -> return () _ -> listenServer serverOut context -- | Is this message allowed to be sent by the server between the intialize -- request and response? -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize checkLegalBetweenMessage :: FromServerMessage -> Session () - checkLegalBetweenMessage (FromServerMess SWindowShowMessage _) = pure () - checkLegalBetweenMessage (FromServerMess SWindowLogMessage _) = pure () - checkLegalBetweenMessage (FromServerMess STelemetryEvent _) = pure () - checkLegalBetweenMessage (FromServerMess SWindowShowMessageRequest _) = pure () + checkLegalBetweenMessage (FromServerMess SMethod_WindowShowMessage _) = pure () + checkLegalBetweenMessage (FromServerMess SMethod_WindowLogMessage _) = pure () + checkLegalBetweenMessage (FromServerMess SMethod_TelemetryEvent _) = pure () + checkLegalBetweenMessage (FromServerMess SMethod_WindowShowMessageRequest _) = pure () checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg) -- | Check environment variables to override the config @@ -299,7 +300,7 @@ documentContents doc = do -- and returns the new content getDocumentEdit :: TextDocumentIdentifier -> Session T.Text getDocumentEdit doc = do - req <- message SWorkspaceApplyEdit + req <- message SMethod_WorkspaceApplyEdit unless (checkDocumentChanges req || checkChanges req) $ liftIO $ throw (IncorrectApplyEditRequest (show req)) @@ -314,7 +315,7 @@ getDocumentEdit doc = do Nothing -> False checkChanges req = let mMap = req ^. params . edit . changes - in maybe False (HashMap.member (doc ^. uri)) mMap + in maybe False (Map.member (doc ^. uri)) mMap -- | Sends a request to the server and waits for its response. -- Will skip any messages in between the request and the response @@ -322,11 +323,11 @@ getDocumentEdit doc = do -- rsp <- request STextDocumentDocumentSymbol params -- @ -- Note: will skip any messages in between the request and the response. -request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m) +request :: SClientMethod m -> MessageParams m -> Session (TResponseMessage m) request m = sendRequest m >=> skipManyTill anyMessage . responseForId m -- | The same as 'sendRequest', but discard the response. -request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session () +request_ :: SClientMethod (m :: Method ClientToServer Request) -> MessageParams m -> Session () request_ p = void . request p -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response. @@ -339,7 +340,7 @@ sendRequest method params = do modify $ \c -> c { curReqId = idn+1 } let id = IdInt idn - let mess = RequestMessage "2.0" id method params + let mess = TRequestMessage "2.0" id method params -- Update the request map reqMap <- requestMap <$> ask @@ -353,27 +354,27 @@ sendRequest method params = do return id -- | Sends a notification to the server. -sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method. +sendNotification :: SClientMethod (m :: Method ClientToServer Notification) -- ^ The notification method. -> MessageParams m -- ^ The notification parameters. -> Session () -- Open a virtual file if we send a did open text document notification -sendNotification STextDocumentDidOpen params = do - let n = NotificationMessage "2.0" STextDocumentDidOpen params +sendNotification SMethod_TextDocumentDidOpen params = do + let n = TNotificationMessage "2.0" SMethod_TextDocumentDidOpen params oldVFS <- vfs <$> get let newVFS = flip execState oldVFS $ openVFS mempty n modify (\s -> s { vfs = newVFS }) sendMessage n -- Close a virtual file if we send a close text document notification -sendNotification STextDocumentDidClose params = do - let n = NotificationMessage "2.0" STextDocumentDidClose params +sendNotification SMethod_TextDocumentDidClose params = do + let n = TNotificationMessage "2.0" SMethod_TextDocumentDidClose params oldVFS <- vfs <$> get let newVFS = flip execState oldVFS $ closeVFS mempty n modify (\s -> s { vfs = newVFS }) sendMessage n -sendNotification STextDocumentDidChange params = do - let n = NotificationMessage "2.0" STextDocumentDidChange params +sendNotification SMethod_TextDocumentDidChange params = do + let n = TNotificationMessage "2.0" SMethod_TextDocumentDidChange params oldVFS <- vfs <$> get let newVFS = flip execState oldVFS $ changeFromClientVFS mempty n modify (\s -> s { vfs = newVFS }) @@ -381,17 +382,17 @@ sendNotification STextDocumentDidChange params = do sendNotification method params = case splitClientMethod method of - IsClientNot -> sendMessage (NotificationMessage "2.0" method params) - IsClientEither -> sendMessage (NotMess $ NotificationMessage "2.0" method params) + IsClientNot -> sendMessage (TNotificationMessage "2.0" method params) + IsClientEither -> sendMessage (NotMess $ TNotificationMessage "2.0" method params) -- | Sends a response to the server. -sendResponse :: ToJSON (ResponseResult m) => ResponseMessage m -> Session () +sendResponse :: (ToJSON (MessageResult m), ToJSON (ErrorData m)) => TResponseMessage m -> Session () sendResponse = sendMessage -- | Returns the initialize response that was received from the server. -- The initialize requests and responses are not included the session, -- so if you need to test it use this. -initializeResponse :: Session (ResponseMessage Initialize) +initializeResponse :: Session (TResponseMessage Method_Initialize) initializeResponse = ask >>= (liftIO . readMVar) . initRsp -- | /Creates/ a new text document. This is different from 'openDoc' @@ -412,14 +413,16 @@ createDoc file languageId contents = do rootDir <- asks rootDir caps <- asks sessionCapabilities absFile <- liftIO $ canonicalizePath (rootDir file) - let pred :: SomeRegistration -> [Registration WorkspaceDidChangeWatchedFiles] - pred (SomeRegistration r@(Registration _ SWorkspaceDidChangeWatchedFiles _)) = [r] + let pred :: SomeRegistration -> [TRegistration Method_WorkspaceDidChangeWatchedFiles] + pred (SomeRegistration r@(TRegistration _ SMethod_WorkspaceDidChangeWatchedFiles _)) = [r] pred _ = mempty regs = concatMap pred $ Map.elems dynCaps watchHits :: FileSystemWatcher -> Bool - watchHits (FileSystemWatcher pattern kind) = + watchHits (FileSystemWatcher (GlobPattern (InL (Pattern pattern))) kind) = -- If WatchKind is excluded, defaults to all true as per spec - fileMatches (T.unpack pattern) && createHits (fromMaybe (WatchKind True True True) kind) + fileMatches (T.unpack pattern) && createHits (fromMaybe WatchKind_Create kind) + -- TODO: Relative patterns + watchHits _ = False fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs -- If the pattern is absolute then match against the absolute fp @@ -427,9 +430,10 @@ createDoc file languageId contents = do | isAbsolute pattern = absFile | otherwise = file - createHits (WatchKind create _ _) = create + createHits WatchKind_Create = True + createHits _ = False - regHits :: Registration WorkspaceDidChangeWatchedFiles -> Bool + regHits :: TRegistration Method_WorkspaceDidChangeWatchedFiles -> Bool regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. registerOptions . _Just . watchers) clientCapsSupports = @@ -438,8 +442,8 @@ createDoc file languageId contents = do shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs when shouldSend $ - sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $ - List [ FileEvent (filePathToUri (rootDir file)) FcCreated ] + sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $ + [ FileEvent (filePathToUri (rootDir file)) FileChangeType_Created ] openDoc' file languageId contents -- | Opens a text document that /exists on disk/, and sends a @@ -459,21 +463,21 @@ openDoc' file languageId contents = do let fp = rootDir context file uri = filePathToUri fp item = TextDocumentItem uri languageId 0 contents - sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item) + sendNotification SMethod_TextDocumentDidOpen (DidOpenTextDocumentParams item) pure $ TextDocumentIdentifier uri -- | Closes a text document and sends a textDocument/didOpen notification to the server. closeDoc :: TextDocumentIdentifier -> Session () closeDoc docId = do let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri)) - sendNotification STextDocumentDidClose params + sendNotification SMethod_TextDocumentDidClose params -- | Changes a text document and sends a textDocument/didOpen notification to the server. changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session () changeDoc docId changes = do verDoc <- getVersionedDoc docId - let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes) - sendNotification STextDocumentDidChange params + let params = DidChangeTextDocumentParams (verDoc & version +~ 1) changes + sendNotification SMethod_TextDocumentDidChange params -- | Gets the Uri for the file corrected to the session directory. getDocUri :: FilePath -> Session Uri @@ -485,8 +489,8 @@ getDocUri file = do -- | Waits for diagnostics to be published and returns them. waitForDiagnostics :: Session [Diagnostic] waitForDiagnostics = do - diagsNot <- skipManyTill anyMessage (message STextDocumentPublishDiagnostics) - let (List diags) = diagsNot ^. params . LSP.diagnostics + diagsNot <- skipManyTill anyMessage (message SMethod_TextDocumentPublishDiagnostics) + let diags = diagsNot ^. params . LSP.diagnostics return diags -- | The same as 'waitForDiagnostics', but will only match a specific @@ -507,27 +511,29 @@ waitForDiagnosticsSource src = do -- returned. noDiagnostics :: Session () noDiagnostics = do - diagsNot <- message STextDocumentPublishDiagnostics - when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics + diagsNot <- message SMethod_TextDocumentPublishDiagnostics + when (diagsNot ^. params . LSP.diagnostics /= []) $ liftIO $ throw UnexpectedDiagnostics -- | Returns the symbols in a document. -getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation]) +getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [SymbolInformation] [DocumentSymbol]) getDocumentSymbols doc = do - ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) + TResponseMessage _ rspLid res <- request SMethod_TextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) case res of - Right (InL (List xs)) -> return (Left xs) - Right (InR (List xs)) -> return (Right xs) - Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err) + Right (InL xs) -> return (Left xs) + Right (InR (InL xs)) -> return (Right xs) + Right (InR (InR _)) -> return (Right []) + Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) (toUntypedResponseError err)) -- | Returns the code actions in the specified range. getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction] getCodeActions doc range = do ctx <- getCodeActionContextInRange doc range - rsp <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc range ctx) + rsp <- request SMethod_TextDocumentCodeAction (CodeActionParams Nothing Nothing doc range ctx) case rsp ^. result of - Right (List xs) -> return xs - Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) error) + Right (InL xs) -> return xs + Right (InR _) -> return [] + Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) (toUntypedResponseError error)) -- | Returns all the code actions in a document by -- querying the code actions at each of the current @@ -541,11 +547,12 @@ getAllCodeActions doc = do where go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction] go ctx acc diag = do - ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. range) ctx) + TResponseMessage _ rspLid res <- request SMethod_TextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. range) ctx) case res of - Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e) - Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs) + Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) (toUntypedResponseError e)) + Right (InL cmdOrCAs) -> pure (acc ++ cmdOrCAs) + Right (InR _) -> pure acc getCodeActionContextInRange :: TextDocumentIdentifier -> Range -> Session CodeActionContext getCodeActionContextInRange doc caRange = do @@ -553,7 +560,7 @@ getCodeActionContextInRange doc caRange = do let diags = [ d | d@Diagnostic{_range=range} <- curDiags , overlappingRange caRange range ] - return $ CodeActionContext (List diags) Nothing + return $ CodeActionContext diags Nothing Nothing where overlappingRange :: Range -> Range -> Bool overlappingRange (Range s e) range = @@ -570,7 +577,7 @@ getCodeActionContextInRange doc caRange = do getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext getCodeActionContext doc = do curDiags <- getCurrentDiagnostics doc - return $ CodeActionContext (List curDiags) Nothing + return $ CodeActionContext curDiags Nothing Nothing -- | Returns the current diagnostics that have been sent to the client. -- Note that this does not wait for more to come in. @@ -586,7 +593,7 @@ executeCommand :: Command -> Session () executeCommand cmd = do let args = decode $ encode $ fromJust $ cmd ^. arguments execParams = ExecuteCommandParams Nothing (cmd ^. command) args - void $ sendRequest SWorkspaceExecuteCommand execParams + void $ sendRequest SMethod_WorkspaceExecuteCommand execParams -- | Executes a code action. -- Matching with the specification, if a code action @@ -600,15 +607,17 @@ executeCodeAction action = do where handleEdit :: WorkspaceEdit -> Session () handleEdit e = -- Its ok to pass in dummy parameters here as they aren't used - let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing e) - in updateState (FromServerMess SWorkspaceApplyEdit req) + let req = TRequestMessage "" (IdInt 0) SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing e) + in updateState (FromServerMess SMethod_WorkspaceApplyEdit req) -- | Adds the current version to the document, as tracked by the session. getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier getVersionedDoc (TextDocumentIdentifier uri) = do vfs <- vfs <$> get let ver = vfs ^? vfsMap . ix (toNormalizedUri uri) . to virtualFileVersion - return (VersionedTextDocumentIdentifier uri ver) + -- TODO: is this correct? Could return an OptionalVersionedTextDocumentIdentifier, + -- but that complicated callers... + return (VersionedTextDocumentIdentifier uri (fromMaybe 0 ver)) -- | Applys an edit to the document and returns the updated document version. applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier @@ -618,22 +627,18 @@ applyEdit doc edit = do caps <- asks sessionCapabilities - let supportsDocChanges = fromMaybe False $ do - let mWorkspace = caps ^. LSP.workspace - C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ _ <- mWorkspace - C.WorkspaceEditClientCapabilities mDocChanges _ _ _ _ <- mEdit - mDocChanges + let supportsDocChanges = fromMaybe False $ caps ^? LSP.workspace . _Just . LSP.workspaceEdit . _Just . documentChanges . _Just let wEdit = if supportsDocChanges then - let docEdit = TextDocumentEdit verDoc (List [InL edit]) - in WorkspaceEdit Nothing (Just (List [InL docEdit])) Nothing + let docEdit = TextDocumentEdit (review _versionedTextDocumentIdentifier verDoc) [InL edit] + in WorkspaceEdit Nothing (Just [InL docEdit]) Nothing else - let changes = HashMap.singleton (doc ^. uri) (List [edit]) + let changes = Map.singleton (doc ^. uri) [edit] in WorkspaceEdit (Just changes) Nothing Nothing - let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit) - updateState (FromServerMess SWorkspaceApplyEdit req) + let req = TRequestMessage "" (IdInt 0) SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit) + updateState (FromServerMess SMethod_WorkspaceApplyEdit req) -- version may have changed getVersionedDoc doc @@ -641,146 +646,139 @@ applyEdit doc edit = do -- | Returns the completions for the position in the document. getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem] getCompletions doc pos = do - rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing Nothing) + rsp <- request SMethod_TextDocumentCompletion (CompletionParams doc pos Nothing Nothing Nothing) case getResponseResult rsp of - InL (List items) -> return items - InR (CompletionList _ (List items)) -> return items + InL items -> return items + InR (InL c) -> return $ c ^. LSP.items + InR (InR _) -> return [] -- | Returns the references for the position in the document. getReferences :: TextDocumentIdentifier -- ^ The document to lookup in. -> Position -- ^ The position to lookup. -> Bool -- ^ Whether to include declarations as references. - -> Session (List Location) -- ^ The locations of the references. + -> Session [Location] -- ^ The locations of the references. getReferences doc pos inclDecl = let ctx = ReferenceContext inclDecl params = ReferenceParams doc pos Nothing Nothing ctx - in getResponseResult <$> request STextDocumentReferences params + in absorbNull . getResponseResult <$> request SMethod_TextDocumentReferences params -- | Returns the declarations(s) for the term at the specified position. getDeclarations :: TextDocumentIdentifier -- ^ The document the term is in. -> Position -- ^ The position the term is at. - -> Session ([Location] |? [LocationLink]) -getDeclarations = getDeclarationyRequest STextDocumentDeclaration DeclarationParams + -> Session (Declaration |? [DeclarationLink] |? Null) +getDeclarations doc pos = do + rsp <- request SMethod_TextDocumentDeclaration (DeclarationParams doc pos Nothing Nothing) + pure $ getResponseResult rsp -- | Returns the definition(s) for the term at the specified position. getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in. -> Position -- ^ The position the term is at. - -> Session ([Location] |? [LocationLink]) -getDefinitions = getDeclarationyRequest STextDocumentDefinition DefinitionParams + -> Session (Definition |? [DefinitionLink] |? Null) +getDefinitions doc pos = do + rsp <- request SMethod_TextDocumentDefinition (DefinitionParams doc pos Nothing Nothing) + pure $ getResponseResult rsp -- | Returns the type definition(s) for the term at the specified position. getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in. -> Position -- ^ The position the term is at. - -> Session ([Location] |? [LocationLink]) -getTypeDefinitions = getDeclarationyRequest STextDocumentTypeDefinition TypeDefinitionParams + -> Session (Definition |? [DefinitionLink] |? Null) +getTypeDefinitions doc pos = do + rsp <- request SMethod_TextDocumentTypeDefinition (TypeDefinitionParams doc pos Nothing Nothing) + pure $ getResponseResult rsp -- | Returns the type definition(s) for the term at the specified position. getImplementations :: TextDocumentIdentifier -- ^ The document the term is in. -> Position -- ^ The position the term is at. - -> Session ([Location] |? [LocationLink]) -getImplementations = getDeclarationyRequest STextDocumentImplementation ImplementationParams - - -getDeclarationyRequest :: (ResponseResult m ~ (Location |? (List Location |? List LocationLink))) - => SClientMethod m - -> (TextDocumentIdentifier - -> Position - -> Maybe ProgressToken - -> Maybe ProgressToken - -> MessageParams m) - -> TextDocumentIdentifier - -> Position - -> Session ([Location] |? [LocationLink]) -getDeclarationyRequest method paramCons doc pos = do - let params = paramCons doc pos Nothing Nothing - rsp <- request method params - case getResponseResult rsp of - InL loc -> pure (InL [loc]) - InR (InL (List locs)) -> pure (InL locs) - InR (InR (List locLinks)) -> pure (InR locLinks) + -> Session (Definition |? [DefinitionLink] |? Null) +getImplementations doc pos = do + rsp <- request SMethod_TextDocumentImplementation (ImplementationParams doc pos Nothing Nothing) + pure $ getResponseResult rsp -- | Renames the term at the specified position. rename :: TextDocumentIdentifier -> Position -> String -> Session () rename doc pos newName = do - let params = RenameParams doc pos Nothing (T.pack newName) - rsp <- request STextDocumentRename params + let params = RenameParams Nothing doc pos (T.pack newName) + rsp <- request SMethod_TextDocumentRename params let wEdit = getResponseResult rsp - req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit) - updateState (FromServerMess SWorkspaceApplyEdit req) + case nullToMaybe wEdit of + Just e -> do + let req = TRequestMessage "" (IdInt 0) SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing e) + updateState (FromServerMess SMethod_WorkspaceApplyEdit req) + Nothing -> pure () -- | Returns the hover information at the specified position. getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover) getHover doc pos = let params = HoverParams doc pos Nothing - in getResponseResult <$> request STextDocumentHover params + in nullToMaybe . getResponseResult <$> request SMethod_TextDocumentHover params -- | Returns the highlighted occurrences of the term at the specified position -getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight) +getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight] getHighlights doc pos = let params = DocumentHighlightParams doc pos Nothing Nothing - in getResponseResult <$> request STextDocumentDocumentHighlight params + in absorbNull . getResponseResult <$> request SMethod_TextDocumentDocumentHighlight params -- | Checks the response for errors and throws an exception if needed. -- Returns the result if successful. -getResponseResult :: ResponseMessage m -> ResponseResult m +getResponseResult :: (ToJSON (ErrorData m)) => TResponseMessage m -> MessageResult m getResponseResult rsp = case rsp ^. result of Right x -> x - Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) err + Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) (toUntypedResponseError err) -- | Applies formatting to the specified document. formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session () formatDoc doc opts = do let params = DocumentFormattingParams Nothing doc opts - edits <- getResponseResult <$> request STextDocumentFormatting params + edits <- absorbNull . getResponseResult <$> request SMethod_TextDocumentFormatting params applyTextEdits doc edits -- | Applies formatting to the specified range in a document. formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session () formatRange doc opts range = do let params = DocumentRangeFormattingParams Nothing doc range opts - edits <- getResponseResult <$> request STextDocumentRangeFormatting params + edits <- absorbNull . getResponseResult <$> request SMethod_TextDocumentRangeFormatting params applyTextEdits doc edits -applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session () +applyTextEdits :: TextDocumentIdentifier -> [TextEdit] -> Session () applyTextEdits doc edits = - let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing Nothing + let wEdit = WorkspaceEdit (Just (Map.singleton (doc ^. uri) edits)) Nothing Nothing -- Send a dummy message to updateState so it can do bookkeeping - req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit) - in updateState (FromServerMess SWorkspaceApplyEdit req) + req = TRequestMessage "" (IdInt 0) SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit) + in updateState (FromServerMess SMethod_WorkspaceApplyEdit req) -- | Returns the code lenses for the specified document. getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens] getCodeLenses tId = do - rsp <- request STextDocumentCodeLens (CodeLensParams Nothing Nothing tId) - case getResponseResult rsp of - List res -> pure res + rsp <- request SMethod_TextDocumentCodeLens (CodeLensParams Nothing Nothing tId) + pure $ absorbNull $ getResponseResult rsp -- | Pass a param and return the response from `prepareCallHierarchy` prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem] -prepareCallHierarchy = resolveRequestWithListResp STextDocumentPrepareCallHierarchy +prepareCallHierarchy = resolveRequestWithListResp SMethod_TextDocumentPrepareCallHierarchy incomingCalls :: CallHierarchyIncomingCallsParams -> Session [CallHierarchyIncomingCall] -incomingCalls = resolveRequestWithListResp SCallHierarchyIncomingCalls +incomingCalls = resolveRequestWithListResp SMethod_CallHierarchyIncomingCalls outgoingCalls :: CallHierarchyOutgoingCallsParams -> Session [CallHierarchyOutgoingCall] -outgoingCalls = resolveRequestWithListResp SCallHierarchyOutgoingCalls +outgoingCalls = resolveRequestWithListResp SMethod_CallHierarchyOutgoingCalls -- | Send a request and receive a response with list. -resolveRequestWithListResp :: (ResponseResult m ~ Maybe (List a)) - => SClientMethod m -> MessageParams m -> Session [a] +resolveRequestWithListResp :: forall (m :: Method ClientToServer Request) a + . (ToJSON (ErrorData m), MessageResult m ~ [a] |? Null) + => SMethod m + -> MessageParams m + -> Session [a] resolveRequestWithListResp method params = do rsp <- request method params - case getResponseResult rsp of - Nothing -> pure [] - Just (List x) -> pure x + pure $ absorbNull $ getResponseResult rsp -- | Pass a param and return the response from `prepareCallHierarchy` -getSemanticTokens :: TextDocumentIdentifier -> Session (Maybe SemanticTokens) +getSemanticTokens :: TextDocumentIdentifier -> Session (SemanticTokens |? Null) getSemanticTokens doc = do let params = SemanticTokensParams Nothing Nothing doc - rsp <- request STextDocumentSemanticTokensFull params + rsp <- request SMethod_TextDocumentSemanticTokensFull params pure $ getResponseResult rsp -- | Returns a list of capabilities that the server has requested to /dynamically/ diff --git a/lsp-test/src/Language/LSP/Test/Compat.hs b/lsp-test/src/Language/LSP/Test/Compat.hs index 8055d7c59..f92c416cb 100644 --- a/lsp-test/src/Language/LSP/Test/Compat.hs +++ b/lsp-test/src/Language/LSP/Test/Compat.hs @@ -1,13 +1,18 @@ -{-# LANGUAGE CPP, OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} -- For some reason ghc warns about not using -- Control.Monad.IO.Class but it's needed for -- MonadIO {-# OPTIONS_GHC -Wunused-imports #-} module Language.LSP.Test.Compat where +import Data.Row import Data.Maybe +import qualified Data.Text as T import System.IO -import Language.LSP.Types #if MIN_VERSION_process(1,6,3) -- We have to hide cleanupProcess for process-1.6.3.0 @@ -115,6 +120,5 @@ withCreateProcess c action = #endif - -lspTestClientInfo :: ClientInfo -lspTestClientInfo = ClientInfo "lsp-test" (Just CURRENT_PACKAGE_VERSION) +lspTestClientInfo :: Rec ("name" .== T.Text .+ "version" .== Maybe T.Text) +lspTestClientInfo = #name .== "lsp-test" .+ #version .== (Just CURRENT_PACKAGE_VERSION) diff --git a/lsp-test/src/Language/LSP/Test/Decoding.hs b/lsp-test/src/Language/LSP/Test/Decoding.hs index c5cefd632..2969eea5e 100644 --- a/lsp-test/src/Language/LSP/Test/Decoding.hs +++ b/lsp-test/src/Language/LSP/Test/Decoding.hs @@ -1,7 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeInType #-} module Language.LSP.Test.Decoding where @@ -17,8 +15,8 @@ import qualified Data.ByteString.Lazy.Char8 as B import Data.Maybe import System.IO import System.IO.Error -import Language.LSP.Types -import Language.LSP.Types.Lens +import Language.LSP.Protocol.Message hiding (error) +import Language.LSP.Protocol.Types import Language.LSP.Test.Exceptions import Data.IxMap @@ -51,7 +49,7 @@ getHeaders h = do | isEOFError e = throw UnexpectedServerTermination | otherwise = throw e -type RequestMap = IxMap LspId (SMethod :: Method FromClient Request -> Type ) +type RequestMap = IxMap LspId (SMethod :: Method ClientToServer Request -> Type ) newRequestMap :: RequestMap newRequestMap = emptyIxMap diff --git a/lsp-test/src/Language/LSP/Test/Exceptions.hs b/lsp-test/src/Language/LSP/Test/Exceptions.hs index de88a0898..ddfd122cf 100644 --- a/lsp-test/src/Language/LSP/Test/Exceptions.hs +++ b/lsp-test/src/Language/LSP/Test/Exceptions.hs @@ -1,7 +1,7 @@ module Language.LSP.Test.Exceptions where import Control.Exception -import Language.LSP.Types +import Language.LSP.Protocol.Message import Data.Aeson import Data.Aeson.Encode.Pretty import Data.Algorithm.Diff @@ -16,7 +16,7 @@ data SessionException = Timeout (Maybe FromServerMessage) | ReplayOutOfOrder FromServerMessage [FromServerMessage] | UnexpectedDiagnostics | IncorrectApplyEditRequest String - | UnexpectedResponseError SomeLspId ResponseError + | UnexpectedResponseError SomeLspId ResponseError | UnexpectedServerTermination | IllegalInitSequenceMessage FromServerMessage | MessageSendError Value IOError diff --git a/lsp-test/src/Language/LSP/Test/Files.hs b/lsp-test/src/Language/LSP/Test/Files.hs index d27511264..205c3163b 100644 --- a/lsp-test/src/Language/LSP/Test/Files.hs +++ b/lsp-test/src/Language/LSP/Test/Files.hs @@ -10,10 +10,10 @@ module Language.LSP.Test.Files ) where -import Language.LSP.Types -import Language.LSP.Types.Lens hiding (id) +import Language.LSP.Protocol.Message hiding (error) +import Language.LSP.Protocol.Types hiding (id) import Control.Lens -import qualified Data.HashMap.Strict as HM +import qualified Data.Map.Strict as M import qualified Data.Text as T import Data.Maybe import System.Directory @@ -38,9 +38,11 @@ swapFiles relCurBaseDir msgs = do return newMsgs rootDir :: [Event] -> FilePath -rootDir (ClientEv _ (FromClientMess SInitialize req):_) = +rootDir (ClientEv _ (FromClientMess SMethod_Initialize req):_) = fromMaybe (error "Couldn't find root dir") $ do - rootUri <- req ^. params .rootUri + rootUri <- case req ^. params . rootUri of + InL r -> Just r + InR _ -> error "Couldn't find root dir" uriToFilePath rootUri rootDir _ = error "Couldn't find initialize request in session" @@ -52,25 +54,26 @@ mapUris f event = where --TODO: Handle all other URIs that might need swapped - fromClientMsg (FromClientMess m@SInitialize r) = FromClientMess m $ params .~ transformInit (r ^. params) $ r - fromClientMsg (FromClientMess m@STextDocumentDidOpen n) = FromClientMess m $ swapUri (params . textDocument) n - fromClientMsg (FromClientMess m@STextDocumentDidChange n) = FromClientMess m $ swapUri (params . textDocument) n - fromClientMsg (FromClientMess m@STextDocumentWillSave n) = FromClientMess m $ swapUri (params . textDocument) n - fromClientMsg (FromClientMess m@STextDocumentDidSave n) = FromClientMess m $ swapUri (params . textDocument) n - fromClientMsg (FromClientMess m@STextDocumentDidClose n) = FromClientMess m $ swapUri (params . textDocument) n - fromClientMsg (FromClientMess m@STextDocumentDocumentSymbol n) = FromClientMess m $ swapUri (params . textDocument) n - fromClientMsg (FromClientMess m@STextDocumentRename n) = FromClientMess m $ swapUri (params . textDocument) n + fromClientMsg (FromClientMess m@SMethod_Initialize r) = FromClientMess m $ params .~ transformInit (r ^. params) $ r + fromClientMsg (FromClientMess m@SMethod_TextDocumentDidOpen n) = FromClientMess m $ swapUri (params . textDocument) n + fromClientMsg (FromClientMess m@SMethod_TextDocumentDidChange n) = FromClientMess m $ swapUri (params . textDocument) n + fromClientMsg (FromClientMess m@SMethod_TextDocumentWillSave n) = FromClientMess m $ swapUri (params . textDocument) n + fromClientMsg (FromClientMess m@SMethod_TextDocumentDidSave n) = FromClientMess m $ swapUri (params . textDocument) n + fromClientMsg (FromClientMess m@SMethod_TextDocumentDidClose n) = FromClientMess m $ swapUri (params . textDocument) n + fromClientMsg (FromClientMess m@SMethod_TextDocumentDocumentSymbol n) = FromClientMess m $ swapUri (params . textDocument) n + fromClientMsg (FromClientMess m@SMethod_TextDocumentRename n) = FromClientMess m $ swapUri (params . textDocument) n fromClientMsg x = x fromServerMsg :: FromServerMessage -> FromServerMessage - fromServerMsg (FromServerMess m@SWorkspaceApplyEdit r) = FromServerMess m $ params . edit .~ swapWorkspaceEdit (r ^. params . edit) $ r - fromServerMsg (FromServerMess m@STextDocumentPublishDiagnostics n) = FromServerMess m $ swapUri params n - fromServerMsg (FromServerRsp m@STextDocumentDocumentSymbol r) = - let swapUri' :: (List DocumentSymbol |? List SymbolInformation) -> List DocumentSymbol |? List SymbolInformation - swapUri' (InR si) = InR (swapUri location <$> si) - swapUri' (InL dss) = InL dss -- no file locations here - in FromServerRsp m $ r & result %~ (fmap swapUri') - fromServerMsg (FromServerRsp m@STextDocumentRename r) = FromServerRsp m $ r & result %~ (fmap swapWorkspaceEdit) + fromServerMsg (FromServerMess m@SMethod_WorkspaceApplyEdit r) = FromServerMess m $ params . edit .~ swapWorkspaceEdit (r ^. params . edit) $ r + fromServerMsg (FromServerMess m@SMethod_TextDocumentPublishDiagnostics n) = FromServerMess m $ swapUri params n + fromServerMsg (FromServerRsp m@SMethod_TextDocumentDocumentSymbol r) = + let swapUri' :: ([SymbolInformation] |? [DocumentSymbol] |? Null) -> [SymbolInformation] |? [DocumentSymbol] |? Null + swapUri' (InR (InL dss)) = InR $ InL dss -- no file locations here + swapUri' (InR (InR n)) = InR $ InR n + swapUri' (InL si) = InL (swapUri location <$> si) + in FromServerRsp m $ r & result . _Right %~ swapUri' + fromServerMsg (FromServerRsp m@SMethod_TextDocumentRename r) = FromServerRsp m $ r & result . _Right . _L %~ swapWorkspaceEdit fromServerMsg x = x swapWorkspaceEdit :: WorkspaceEdit -> WorkspaceEdit @@ -81,13 +84,11 @@ mapUris f event = -- for RenameFile, we swap `newUri` swapDocumentChangeUri (InR (InR (InL renameFile))) = InR $ InR $ InL $ newUri .~ f (renameFile ^. newUri) $ renameFile swapDocumentChangeUri (InR (InR (InR deleteFile))) = InR $ InR $ InR $ swapUri id deleteFile + in e & changes . _Just %~ swapKeys f + & documentChanges . _Just . traversed%~ swapDocumentChangeUri - newDocChanges = fmap (fmap swapDocumentChangeUri) $ e ^. documentChanges - newChanges = fmap (swapKeys f) $ e ^. changes - in WorkspaceEdit newChanges newDocChanges Nothing - - swapKeys :: (Uri -> Uri) -> HM.HashMap Uri b -> HM.HashMap Uri b - swapKeys f = HM.foldlWithKey' (\acc k v -> HM.insert (f k) v acc) HM.empty + swapKeys :: (Uri -> Uri) -> M.Map Uri b -> M.Map Uri b + swapKeys f = M.foldlWithKey' (\acc k v -> M.insert (f k) v acc) M.empty swapUri :: HasUri b Uri => Lens' a b -> a -> a swapUri lens x = @@ -97,9 +98,11 @@ mapUris f event = -- | Transforms rootUri/rootPath. transformInit :: InitializeParams -> InitializeParams transformInit x = - let newRootUri = fmap f (x ^. rootUri) - newRootPath = do - fp <- T.unpack <$> x ^. rootPath - let uri = filePathToUri fp - T.pack <$> uriToFilePath (f uri) - in (rootUri .~ newRootUri) $ (rootPath .~ newRootPath) x + let modifyRootPath p = + let fp = T.unpack p + uri = filePathToUri fp + in case uriToFilePath (f uri) of + Just fp -> T.pack fp + Nothing -> p + in x & rootUri . _L %~ f + & rootPath . _Just . _L %~ modifyRootPath diff --git a/lsp-test/src/Language/LSP/Test/Parsing.hs b/lsp-test/src/Language/LSP/Test/Parsing.hs index 43ac49fe5..c2a143024 100644 --- a/lsp-test/src/Language/LSP/Test/Parsing.hs +++ b/lsp-test/src/Language/LSP/Test/Parsing.hs @@ -35,8 +35,10 @@ import Data.Conduit.Parser hiding (named) import qualified Data.Conduit.Parser (named) import qualified Data.Text as T import Data.Typeable -import Language.LSP.Types +import Language.LSP.Protocol.Message hiding (error) import Language.LSP.Test.Session +import GHC.TypeLits (KnownSymbol, symbolVal) +import Data.GADT.Compare -- $receiving -- To receive a message, specify the method of the message to expect: @@ -115,8 +117,8 @@ named s (Session x) = Session (Data.Conduit.Parser.named s x) -- | Matches a request or a notification coming from the server. -- Doesn't match Custom Messages -message :: SServerMethod m -> Session (ServerMessage m) -message (SCustomMethod _) = error "message can't be used with CustomMethod, use customRequest or customNotification instead" +message :: SServerMethod m -> Session (TMessage m) +message (SMethod_CustomMethod _) = error "message can't be used with CustomMethod, use customRequest or customNotification instead" message m1 = named (T.pack $ "Request for: " <> show m1) $ satisfyMaybe $ \case FromServerMess m2 msg -> do res <- mEqServer m1 m2 @@ -125,23 +127,31 @@ message m1 = named (T.pack $ "Request for: " <> show m1) $ satisfyMaybe $ \case Left _f -> Nothing _ -> Nothing -customRequest :: T.Text -> Session (ServerMessage (CustomMethod :: Method FromServer Request)) -customRequest m = named m $ satisfyMaybe $ \case - FromServerMess m1 msg -> case splitServerMethod m1 of - IsServerEither -> case msg of - ReqMess _ | m1 == SCustomMethod m -> Just msg +customRequest :: KnownSymbol s => Proxy s -> Session (TMessage (Method_CustomMethod s :: Method ServerToClient Request)) +customRequest p = + let m = T.pack $ symbolVal p + in named m $ satisfyMaybe $ \case + FromServerMess m1 msg -> case splitServerMethod m1 of + IsServerEither -> case msg of + ReqMess _ -> case m1 `geq` SMethod_CustomMethod p of + Just Refl -> Just msg + _ -> Nothing + _ -> Nothing _ -> Nothing _ -> Nothing - _ -> Nothing -customNotification :: T.Text -> Session (ServerMessage (CustomMethod :: Method FromServer Notification)) -customNotification m = named m $ satisfyMaybe $ \case - FromServerMess m1 msg -> case splitServerMethod m1 of - IsServerEither -> case msg of - NotMess _ | m1 == SCustomMethod m -> Just msg +customNotification :: KnownSymbol s => Proxy s -> Session (TMessage (Method_CustomMethod s :: Method ServerToClient Notification)) +customNotification p = + let m = T.pack $ symbolVal p + in named m $ satisfyMaybe $ \case + FromServerMess m1 msg -> case splitServerMethod m1 of + IsServerEither -> case msg of + NotMess _ -> case m1 `geq` SMethod_CustomMethod p of + Just Refl -> Just msg + _ -> Nothing + _ -> Nothing _ -> Nothing _ -> Nothing - _ -> Nothing -- | Matches if the message is a notification. anyNotification :: Session FromServerMessage @@ -169,7 +179,7 @@ anyResponse = named "Any response" $ satisfy $ \case FromServerRsp _ _ -> True -- | Matches a response coming from the server. -response :: SMethod (m :: Method FromClient Request) -> Session (ResponseMessage m) +response :: SMethod (m :: Method ClientToServer Request) -> Session (TResponseMessage m) response m1 = named (T.pack $ "Response for: " <> show m1) $ satisfyMaybe $ \case FromServerRsp m2 msg -> do HRefl <- runEq mEqClient m1 m2 @@ -177,12 +187,12 @@ response m1 = named (T.pack $ "Response for: " <> show m1) $ satisfyMaybe $ \cas _ -> Nothing -- | Like 'response', but matches a response for a specific id. -responseForId :: SMethod (m :: Method FromClient Request) -> LspId m -> Session (ResponseMessage m) +responseForId :: SMethod (m :: Method ClientToServer Request) -> LspId m -> Session (TResponseMessage m) responseForId m lid = named (T.pack $ "Response for id: " ++ show lid) $ do satisfyMaybe $ \msg -> do case msg of FromServerMess _ _ -> Nothing - FromServerRsp m' rspMsg@(ResponseMessage _ lid' _) -> do + FromServerRsp m' rspMsg@(TResponseMessage _ lid' _) -> do HRefl <- runEq mEqClient m m' guard (Just lid == lid') pure rspMsg @@ -195,16 +205,16 @@ anyMessage = satisfy (const True) loggingNotification :: Session FromServerMessage loggingNotification = named "Logging notification" $ satisfy shouldSkip where - shouldSkip (FromServerMess SWindowLogMessage _) = True - shouldSkip (FromServerMess SWindowShowMessage _) = True - shouldSkip (FromServerMess SWindowShowMessageRequest _) = True - shouldSkip (FromServerMess SWindowShowDocument _) = True + shouldSkip (FromServerMess SMethod_WindowLogMessage _) = True + shouldSkip (FromServerMess SMethod_WindowShowMessage _) = True + shouldSkip (FromServerMess SMethod_WindowShowMessageRequest _) = True + shouldSkip (FromServerMess SMethod_WindowShowDocument _) = True shouldSkip _ = False -- | Matches a 'Language.LSP.Types.TextDocumentPublishDiagnostics' -- (textDocument/publishDiagnostics) notification. -publishDiagnosticsNotification :: Session (Message TextDocumentPublishDiagnostics) +publishDiagnosticsNotification :: Session (TMessage Method_TextDocumentPublishDiagnostics) publishDiagnosticsNotification = named "Publish diagnostics notification" $ satisfyMaybe $ \msg -> case msg of - FromServerMess STextDocumentPublishDiagnostics diags -> Just diags + FromServerMess SMethod_TextDocumentPublishDiagnostics diags -> Just diags _ -> Nothing diff --git a/lsp-test/src/Language/LSP/Test/Session.hs b/lsp-test/src/Language/LSP/Test/Session.hs index 27724a6e8..2e90e571d 100644 --- a/lsp-test/src/Language/LSP/Test/Session.hs +++ b/lsp-test/src/Language/LSP/Test/Session.hs @@ -5,6 +5,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} @@ -42,17 +43,15 @@ import Control.Lens hiding (List, Empty) import Control.Monad import Control.Monad.Catch (MonadThrow) import Control.Monad.Except -import Control.Monad.IO.Class #if __GLASGOW_HASKELL__ == 806 import Control.Monad.Fail #endif -import Control.Monad.Trans.Class import Control.Monad.Trans.Reader (ReaderT, runReaderT) import qualified Control.Monad.Trans.Reader as Reader (ask) import Control.Monad.Trans.State (StateT, runStateT, execState) import qualified Control.Monad.Trans.State as State import qualified Data.ByteString.Lazy.Char8 as B -import Data.Aeson hiding (Error) +import Data.Aeson hiding (Error, Null) import Data.Aeson.Encode.Pretty import Data.Conduit as Conduit import Data.Conduit.Parser as Parser @@ -63,13 +62,10 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.IO as T -import qualified Data.HashMap.Strict as HashMap import Data.Maybe import Data.Function -import Language.LSP.Types.Capabilities -import Language.LSP.Types -import Language.LSP.Types.Lens -import qualified Language.LSP.Types.Lens as LSP +import Language.LSP.Protocol.Types as LSP hiding (to) +import Language.LSP.Protocol.Message as LSP hiding (error) import Language.LSP.VFS import Language.LSP.Test.Compat import Language.LSP.Test.Decoding @@ -84,6 +80,7 @@ import System.Process (waitForProcess) import System.Timeout ( timeout ) import Data.IORef import Colog.Core (LogAction (..), WithSeverity (..), Severity (..)) +import Data.Row -- | A session representing one instance of launching and connecting to a server. -- @@ -142,7 +139,7 @@ data SessionContext = SessionContext -- Keep curTimeoutId in SessionContext, as its tied to messageChan , curTimeoutId :: IORef Int -- ^ The current timeout we are waiting on , requestMap :: MVar RequestMap - , initRsp :: MVar (ResponseMessage Initialize) + , initRsp :: MVar (TResponseMessage Method_Initialize) , config :: SessionConfig , sessionCapabilities :: ClientCapabilities } @@ -231,9 +228,9 @@ runSessionMonad context state (Session session) = runReaderT (runStateT conduit yield msg chanSource - isLogNotification (ServerMessage (FromServerMess SWindowShowMessage _)) = True - isLogNotification (ServerMessage (FromServerMess SWindowLogMessage _)) = True - isLogNotification (ServerMessage (FromServerMess SWindowShowDocument _)) = True + isLogNotification (ServerMessage (FromServerMess SMethod_WindowShowMessage _)) = True + isLogNotification (ServerMessage (FromServerMess SMethod_WindowLogMessage _)) = True + isLogNotification (ServerMessage (FromServerMess SMethod_WindowShowDocument _)) = True isLogNotification _ = False watchdog :: ConduitM SessionMessage FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) () @@ -307,10 +304,10 @@ updateStateC = awaitForever $ \msg -> do yield msg where respond :: (MonadIO m, HasReader SessionContext m) => FromServerMessage -> m () - respond (FromServerMess SWindowWorkDoneProgressCreate req) = - sendMessage $ ResponseMessage "2.0" (Just $ req ^. LSP.id) (Right Empty) - respond (FromServerMess SWorkspaceApplyEdit r) = do - sendMessage $ ResponseMessage "2.0" (Just $ r ^. LSP.id) (Right $ ApplyWorkspaceEditResponseBody True Nothing Nothing) + respond (FromServerMess SMethod_WindowWorkDoneProgressCreate req) = + sendMessage $ TResponseMessage "2.0" (Just $ req ^. LSP.id) (Right Null) + respond (FromServerMess SMethod_WorkspaceApplyEdit r) = do + sendMessage $ TResponseMessage "2.0" (Just $ r ^. LSP.id) (Right $ ApplyWorkspaceEditResult True Nothing Nothing) respond _ = pure () @@ -324,47 +321,50 @@ documentChangeUri (InR (InR (InR x))) = x ^. uri updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m) => FromServerMessage -> m () -updateState (FromServerMess SProgress req) = case req ^. params . value of - Begin _ -> +updateState (FromServerMess SMethod_Progress req) = case req ^. params . value of + v | Just _ <- v ^? _workDoneProgressBegin -> modify $ \s -> s { curProgressSessions = Set.insert (req ^. params . token) $ curProgressSessions s } - End _ -> + v | Just _ <- v ^? _workDoneProgressEnd -> modify $ \s -> s { curProgressSessions = Set.delete (req ^. params . token) $ curProgressSessions s } _ -> pure () -- Keep track of dynamic capability registration -updateState (FromServerMess SClientRegisterCapability req) = do - let List newRegs = (\sr@(SomeRegistration r) -> (r ^. LSP.id, sr)) <$> req ^. params . registrations +updateState (FromServerMess SMethod_ClientRegisterCapability req) = do + let + regs :: [SomeRegistration] + regs = req ^.. params . registrations . traversed . to toSomeRegistration . _Just + let newRegs = (\sr@(SomeRegistration r) -> (r ^. LSP.id, sr)) <$> regs modify $ \s -> s { curDynCaps = Map.union (Map.fromList newRegs) (curDynCaps s) } -updateState (FromServerMess SClientUnregisterCapability req) = do - let List unRegs = (^. LSP.id) <$> req ^. params . unregisterations +updateState (FromServerMess SMethod_ClientUnregisterCapability req) = do + let unRegs = (^. LSP.id) <$> req ^. params . unregisterations modify $ \s -> let newCurDynCaps = foldr' Map.delete (curDynCaps s) unRegs in s { curDynCaps = newCurDynCaps } -updateState (FromServerMess STextDocumentPublishDiagnostics n) = do - let List diags = n ^. params . diagnostics +updateState (FromServerMess SMethod_TextDocumentPublishDiagnostics n) = do + let diags = n ^. params . diagnostics doc = n ^. params . uri modify $ \s -> let newDiags = Map.insert (toNormalizedUri doc) diags (curDiagnostics s) in s { curDiagnostics = newDiags } -updateState (FromServerMess SWorkspaceApplyEdit r) = do +updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do -- First, prefer the versioned documentChanges field allChangeParams <- case r ^. params . edit . documentChanges of - Just (List cs) -> do + Just (cs) -> do mapM_ (checkIfNeedsOpened . documentChangeUri) cs -- replace the user provided version numbers with the VFS ones + 1 -- (technically we should check that the user versions match the VFS ones) - cs' <- traverseOf (traverse . _InL . textDocument) bumpNewestVersion cs + cs' <- traverseOf (traverse . _L . textDocument . _versionedTextDocumentIdentifier) bumpNewestVersion cs return $ mapMaybe getParamsFromDocumentChange cs' -- Then fall back to the changes field Nothing -> case r ^. params . edit . changes of Just cs -> do - mapM_ checkIfNeedsOpened (HashMap.keys cs) - concat <$> mapM (uncurry getChangeParams) (HashMap.toList cs) + mapM_ checkIfNeedsOpened (Map.keys cs) + concat <$> mapM (uncurry getChangeParams) (Map.toList cs) Nothing -> error "WorkspaceEdit contains neither documentChanges nor changes!" @@ -376,7 +376,7 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do mergedParams = map mergeParams groupedParams -- TODO: Don't do this when replaying a session - forM_ mergedParams (sendMessage . NotificationMessage "2.0" STextDocumentDidChange) + forM_ mergedParams (sendMessage . TNotificationMessage "2.0" SMethod_TextDocumentDidChange) -- Update VFS to new document versions let sortedVersions = map (sortBy (compare `on` (^. textDocument . version))) groupedParams @@ -385,7 +385,7 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do forM_ latestVersions $ \(VersionedTextDocumentIdentifier uri v) -> modify $ \s -> let oldVFS = vfs s - update (VirtualFile oldV file_ver t) = VirtualFile (fromMaybe oldV v) (file_ver +1) t + update (VirtualFile _ file_ver t) = VirtualFile v (file_ver +1) t newVFS = oldVFS & vfsMap . ix (toNormalizedUri uri) %~ update in s { vfs = newVFS } @@ -399,23 +399,24 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do let fp = fromJust $ uriToFilePath uri contents <- liftIO $ T.readFile fp let item = TextDocumentItem (filePathToUri fp) "" 0 contents - msg = NotificationMessage "2.0" STextDocumentDidOpen (DidOpenTextDocumentParams item) + msg = TNotificationMessage "2.0" SMethod_TextDocumentDidOpen (DidOpenTextDocumentParams item) sendMessage msg modifyM $ \s -> do let newVFS = flip execState (vfs s) $ openVFS logger msg return $ s { vfs = newVFS } - getParamsFromTextDocumentEdit :: TextDocumentEdit -> DidChangeTextDocumentParams - getParamsFromTextDocumentEdit (TextDocumentEdit docId (List edits)) = do - DidChangeTextDocumentParams docId (List $ map editToChangeEvent edits) + getParamsFromTextDocumentEdit :: TextDocumentEdit -> Maybe DidChangeTextDocumentParams + getParamsFromTextDocumentEdit (TextDocumentEdit docId edits) = + DidChangeTextDocumentParams <$> docId ^? _versionedTextDocumentIdentifier <*> pure (map editToChangeEvent edits) + -- TODO: move somewhere reusable editToChangeEvent :: TextEdit |? AnnotatedTextEdit -> TextDocumentContentChangeEvent - editToChangeEvent (InR e) = TextDocumentContentChangeEvent (Just $ e ^. range) Nothing (e ^. newText) - editToChangeEvent (InL e) = TextDocumentContentChangeEvent (Just $ e ^. range) Nothing (e ^. newText) + editToChangeEvent (InR e) = TextDocumentContentChangeEvent $ InL $ #range .== (e ^. range) .+ #rangeLength .== Nothing .+ #text .== (e ^. newText) + editToChangeEvent (InL e) = TextDocumentContentChangeEvent $ InL $ #range .== (e ^. range) .+ #rangeLength .== Nothing .+ #text .== (e ^. newText) getParamsFromDocumentChange :: DocumentChange -> Maybe DidChangeTextDocumentParams - getParamsFromDocumentChange (InL textDocumentEdit) = Just $ getParamsFromTextDocumentEdit textDocumentEdit + getParamsFromDocumentChange (InL textDocumentEdit) = getParamsFromTextDocumentEdit textDocumentEdit getParamsFromDocumentChange _ = Nothing bumpNewestVersion (VersionedTextDocumentIdentifier uri _) = @@ -426,18 +427,19 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do textDocumentVersions uri = do vfs <- vfs <$> get let curVer = fromMaybe 0 $ vfs ^? vfsMap . ix (toNormalizedUri uri) . lsp_version - pure $ map (VersionedTextDocumentIdentifier uri . Just) [curVer + 1..] + pure $ map (VersionedTextDocumentIdentifier uri) [curVer + 1..] textDocumentEdits uri edits = do vers <- textDocumentVersions uri - pure $ map (\(v, e) -> TextDocumentEdit v (List [InL e])) $ zip vers edits + pure $ map (\(v, e) -> TextDocumentEdit (review _versionedTextDocumentIdentifier v) [InL e]) $ zip vers edits - getChangeParams uri (List edits) = do - map <$> pure getParamsFromTextDocumentEdit <*> textDocumentEdits uri (reverse edits) + getChangeParams uri edits = do + edits <- textDocumentEdits uri (reverse edits) + pure $ catMaybes $ map getParamsFromTextDocumentEdit edits mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams mergeParams params = let events = concat (toList (map (toList . (^. contentChanges)) params)) - in DidChangeTextDocumentParams (head params ^. textDocument) (List events) + in DidChangeTextDocumentParams (head params ^. textDocument) events updateState _ = return () sendMessage :: (MonadIO m, HasReader SessionContext m, ToJSON a) => a -> m () diff --git a/lsp-test/test/DummyServer.hs b/lsp-test/test/DummyServer.hs index 237dddcec..ee44696d3 100644 --- a/lsp-test/test/DummyServer.hs +++ b/lsp-test/test/DummyServer.hs @@ -1,11 +1,13 @@ {-# LANGUAGE TypeInType #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE TypeApplications #-} module DummyServer where import Control.Monad import Control.Monad.Reader -import Data.Aeson hiding (defaultOptions) -import qualified Data.HashMap.Strict as HM +import Data.Aeson hiding (defaultOptions, Null) +import qualified Data.Map.Strict as M import Data.List (isSuffixOf) import Data.String import UnliftIO.Concurrent @@ -15,8 +17,9 @@ import UnliftIO import System.Directory import System.FilePath import System.Process -import Language.LSP.Types -import Data.Default +import Language.LSP.Protocol.Types hiding (options) +import Language.LSP.Protocol.Message hiding (error) +import Data.Proxy withDummyServer :: ((Handle, Handle) -> IO ()) -> IO () withDummyServer f = do @@ -31,7 +34,7 @@ withDummyServer f = do , staticHandlers = handlers , interpretHandler = \env -> Iso (\m -> runLspT env (runReaderT m handlerEnv)) liftIO - , options = defaultOptions {executeCommandCommands = Just ["doAnEdit"]} + , options = defaultOptions {optExecuteCommandCommands = Just ["doAnEdit"]} } bracket @@ -41,53 +44,54 @@ withDummyServer f = do data HandlerEnv = HandlerEnv - { relRegToken :: MVar (RegistrationToken WorkspaceDidChangeWatchedFiles) - , absRegToken :: MVar (RegistrationToken WorkspaceDidChangeWatchedFiles) + { relRegToken :: MVar (RegistrationToken Method_WorkspaceDidChangeWatchedFiles) + , absRegToken :: MVar (RegistrationToken Method_WorkspaceDidChangeWatchedFiles) } handlers :: Handlers (ReaderT HandlerEnv (LspM ())) handlers = mconcat - [ notificationHandler SInitialized $ + [ notificationHandler SMethod_Initialized $ \_noti -> - sendNotification SWindowLogMessage $ - LogMessageParams MtLog "initialized" - , requestHandler STextDocumentHover $ + sendNotification SMethod_WindowLogMessage $ + LogMessageParams MessageType_Log "initialized" + , requestHandler SMethod_TextDocumentHover $ \_req responder -> responder $ Right $ - Just $ - Hover (HoverContents (MarkupContent MkPlainText "hello")) Nothing - , requestHandler STextDocumentDocumentSymbol $ + InL $ + Hover (InL (MarkupContent MarkupKind_PlainText "hello")) Nothing + , requestHandler SMethod_TextDocumentDocumentSymbol $ \_req responder -> responder $ Right $ - InL $ - List - [ DocumentSymbol - "foo" - Nothing - SkObject - Nothing - Nothing - (mkRange 0 0 3 6) - (mkRange 0 0 3 6) - Nothing - ] - , notificationHandler STextDocumentDidOpen $ + InR $ InL + [ DocumentSymbol + "foo" + Nothing + SymbolKind_Object + Nothing + Nothing + (mkRange 0 0 3 6) + (mkRange 0 0 3 6) + Nothing + ] + , notificationHandler SMethod_TextDocumentDidOpen $ \noti -> do - let NotificationMessage _ _ (DidOpenTextDocumentParams doc) = noti + let TNotificationMessage _ _ (DidOpenTextDocumentParams doc) = noti TextDocumentItem uri _ _ _ = doc Just fp = uriToFilePath uri diag = Diagnostic (mkRange 0 0 0 1) - (Just DsWarning) + (Just DiagnosticSeverity_Warning) (Just (InL 42)) + Nothing (Just "dummy-server") "Here's a warning" Nothing Nothing + Nothing withRunInIO $ \runInIO -> do when (".hs" `isSuffixOf` fp) $ @@ -96,39 +100,37 @@ handlers = do threadDelay (2 * 10 ^ 6) runInIO $ - sendNotification STextDocumentPublishDiagnostics $ - PublishDiagnosticsParams uri Nothing (List [diag]) + sendNotification SMethod_TextDocumentPublishDiagnostics $ + PublishDiagnosticsParams uri Nothing [diag] -- also act as a registerer for workspace/didChangeWatchedFiles when (".register" `isSuffixOf` fp) $ do let regOpts = - DidChangeWatchedFilesRegistrationOptions $ - List - [ FileSystemWatcher - "*.watch" - (Just (WatchKind True True True)) - ] + DidChangeWatchedFilesRegistrationOptions + [ FileSystemWatcher + (GlobPattern $ InL $ Pattern "*.watch") + (Just WatchKind_Create) + ] Just token <- runInIO $ - registerCapability SWorkspaceDidChangeWatchedFiles regOpts $ + registerCapability SMethod_WorkspaceDidChangeWatchedFiles regOpts $ \_noti -> - sendNotification SWindowLogMessage $ - LogMessageParams MtLog "got workspace/didChangeWatchedFiles" + sendNotification SMethod_WindowLogMessage $ + LogMessageParams MessageType_Log "got workspace/didChangeWatchedFiles" runInIO $ asks relRegToken >>= \v -> putMVar v token when (".register.abs" `isSuffixOf` fp) $ do curDir <- getCurrentDirectory let regOpts = - DidChangeWatchedFilesRegistrationOptions $ - List - [ FileSystemWatcher - (fromString $ curDir "*.watch") - (Just (WatchKind True True True)) - ] + DidChangeWatchedFilesRegistrationOptions + [ FileSystemWatcher + (GlobPattern $ InL $ Pattern $ fromString $ curDir "*.watch") + (Just WatchKind_Create) + ] Just token <- runInIO $ - registerCapability SWorkspaceDidChangeWatchedFiles regOpts $ + registerCapability SMethod_WorkspaceDidChangeWatchedFiles regOpts $ \_noti -> - sendNotification SWindowLogMessage $ - LogMessageParams MtLog "got workspace/didChangeWatchedFiles" + sendNotification SMethod_WindowLogMessage $ + LogMessageParams MessageType_Log "got workspace/didChangeWatchedFiles" runInIO $ asks absRegToken >>= \v -> putMVar v token -- also act as an unregisterer for workspace/didChangeWatchedFiles when (".unregister" `isSuffixOf` fp) $ @@ -142,56 +144,58 @@ handlers = -- this handler is used by the -- "text document VFS / sends back didChange notifications (documentChanges)" test - , notificationHandler STextDocumentDidChange $ \noti -> do - let NotificationMessage _ _ params = noti - void $ sendNotification (SCustomMethod "custom/textDocument/didChange") (toJSON params) + , notificationHandler SMethod_TextDocumentDidChange $ \noti -> do + let TNotificationMessage _ _ params = noti + void $ sendNotification (SMethod_CustomMethod (Proxy @"custom/textDocument/didChange")) (toJSON params) - , requestHandler SWorkspaceExecuteCommand $ \req resp -> do + , requestHandler SMethod_WorkspaceExecuteCommand $ \req resp -> do case req of - RequestMessage _ _ _ (ExecuteCommandParams Nothing "doAnEdit" (Just (List [val]))) -> do + TRequestMessage _ _ _ (ExecuteCommandParams Nothing "doAnEdit" (Just [val])) -> do let Success docUri = fromJSON val - edit = List [TextEdit (mkRange 0 0 0 5) "howdy"] + edit = [TextEdit (mkRange 0 0 0 5) "howdy"] params = ApplyWorkspaceEditParams (Just "Howdy edit") $ - WorkspaceEdit (Just (HM.singleton docUri edit)) Nothing Nothing - resp $ Right Null - void $ sendRequest SWorkspaceApplyEdit params (const (pure ())) - RequestMessage _ _ _ (ExecuteCommandParams Nothing "doAVersionedEdit" (Just (List [val]))) -> do + WorkspaceEdit (Just (M.singleton docUri edit)) Nothing Nothing + resp $ Right $ InR $ Null + void $ sendRequest SMethod_WorkspaceApplyEdit params (const (pure ())) + TRequestMessage _ _ _ (ExecuteCommandParams Nothing "doAVersionedEdit" (Just [val])) -> do let Success versionedDocUri = fromJSON val - edit = List [InL (TextEdit (mkRange 0 0 0 5) "howdy")] + edit = [InL (TextEdit (mkRange 0 0 0 5) "howdy")] documentEdit = TextDocumentEdit versionedDocUri edit params = ApplyWorkspaceEditParams (Just "Howdy edit") $ - WorkspaceEdit Nothing (Just (List [InL documentEdit])) Nothing - resp $ Right Null - void $ sendRequest SWorkspaceApplyEdit params (const (pure ())) - RequestMessage _ _ _ (ExecuteCommandParams _ name _) -> + WorkspaceEdit Nothing (Just [InL documentEdit]) Nothing + resp $ Right $ InR Null + void $ sendRequest SMethod_WorkspaceApplyEdit params (const (pure ())) + TRequestMessage _ _ _ (ExecuteCommandParams _ name _) -> error $ "unsupported command: " <> show name - , requestHandler STextDocumentCodeAction $ \req resp -> do - let RequestMessage _ _ _ params = req + , requestHandler SMethod_TextDocumentCodeAction $ \req resp -> do + let TRequestMessage _ _ _ params = req CodeActionParams _ _ _ _ cactx = params - CodeActionContext diags _ = cactx + CodeActionContext diags _ _ = cactx codeActions = fmap diag2ca diags diag2ca d = CodeAction "Delete this" Nothing - (Just (List [d])) + (Just [d]) Nothing Nothing Nothing (Just (Command "" "deleteThis" Nothing)) Nothing - resp $ Right $ InR <$> codeActions - , requestHandler STextDocumentCompletion $ \_req resp -> do - let res = CompletionList True (List [item]) + resp $ Right $ InL $ InR <$> codeActions + , requestHandler SMethod_TextDocumentCompletion $ \_req resp -> do + let res = CompletionList True Nothing [item] item = CompletionItem "foo" - (Just CiConstant) - (Just (List [])) + Nothing + (Just CompletionItemKind_Constant) + (Just []) + Nothing Nothing Nothing Nothing @@ -206,15 +210,15 @@ handlers = Nothing Nothing Nothing - resp $ Right $ InR res - , requestHandler STextDocumentPrepareCallHierarchy $ \req resp -> do - let RequestMessage _ _ _ params = req + resp $ Right $ InR $ InL res + , requestHandler SMethod_TextDocumentPrepareCallHierarchy $ \req resp -> do + let TRequestMessage _ _ _ params = req CallHierarchyPrepareParams _ pos _ = params Position x y = pos item = CallHierarchyItem "foo" - SkMethod + SymbolKind_Method Nothing Nothing (Uri "") @@ -222,21 +226,21 @@ handlers = (Range (Position 2 3) (Position 4 5)) Nothing if x == 0 && y == 0 - then resp $ Right Nothing - else resp $ Right $ Just $ List [item] - , requestHandler SCallHierarchyIncomingCalls $ \req resp -> do - let RequestMessage _ _ _ params = req + then resp $ Right $ InR Null + else resp $ Right $ InL [item] + , requestHandler SMethod_CallHierarchyIncomingCalls $ \req resp -> do + let TRequestMessage _ _ _ params = req CallHierarchyIncomingCallsParams _ _ item = params - resp $ Right $ Just $ - List [CallHierarchyIncomingCall item (List [Range (Position 2 3) (Position 4 5)])] - , requestHandler SCallHierarchyOutgoingCalls $ \req resp -> do - let RequestMessage _ _ _ params = req + resp $ Right $ InL + [CallHierarchyIncomingCall item [Range (Position 2 3) (Position 4 5)]] + , requestHandler SMethod_CallHierarchyOutgoingCalls $ \req resp -> do + let TRequestMessage _ _ _ params = req CallHierarchyOutgoingCallsParams _ _ item = params - resp $ Right $ Just $ - List [CallHierarchyOutgoingCall item (List [Range (Position 4 5) (Position 2 3)])] - , requestHandler STextDocumentSemanticTokensFull $ \_req resp -> do - let tokens = makeSemanticTokens def [SemanticTokenAbsolute 0 1 2 SttType []] + resp $ Right $ InL + [CallHierarchyOutgoingCall item [Range (Position 4 5) (Position 2 3)]] + , requestHandler SMethod_TextDocumentSemanticTokensFull $ \_req resp -> do + let tokens = makeSemanticTokens defaultSemanticTokensLegend [SemanticTokenAbsolute 0 1 2 SemanticTokenTypes_Type []] case tokens of - Left t -> resp $ Left $ ResponseError InternalError t Nothing - Right tokens -> resp $ Right $ Just tokens + Left t -> resp $ Left $ TResponseError ErrorCodes_InternalError t Nothing + Right tokens -> resp $ Right $ InL tokens ] diff --git a/lsp-test/test/Test.hs b/lsp-test/test/Test.hs index d991aa1d0..a68b0e7dc 100644 --- a/lsp-test/test/Test.hs +++ b/lsp-test/test/Test.hs @@ -3,29 +3,27 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TypeApplications #-} import DummyServer import Test.Hspec import Data.Aeson import Data.Default -import qualified Data.HashMap.Strict as HM +import qualified Data.Map.Strict as M import Data.Either import Data.Maybe import qualified Data.Text as T import Data.Type.Equality +import Data.Proxy import Control.Applicative.Combinators import Control.Concurrent import Control.Monad.IO.Class import Control.Monad import Control.Lens hiding (List, Iso) import Language.LSP.Test -import Language.LSP.Types -import Language.LSP.Types.Lens hiding - (capabilities, message, rename, applyEdit) -import qualified Language.LSP.Types.Lens as LSP -import Language.LSP.Types.Capabilities as LSP +import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Types hiding (message, applyEdit) +import qualified Language.LSP.Protocol.Types as LSP import System.Directory import System.FilePath import System.Timeout @@ -47,7 +45,7 @@ main = hspec $ around withDummyServer $ do liftIO $ rsp ^. result `shouldSatisfy` isRight it "runSessionWithConfig" $ \(hin, hout) -> - runSessionWithHandles hin hout def didChangeCaps "." $ return () + runSessionWithHandles hin hout def fullCaps "." $ return () describe "withTimeout" $ do it "times out" $ \(hin, hout) -> @@ -56,7 +54,7 @@ main = hspec $ around withDummyServer $ do -- won't receive a request - will timeout -- incoming logging requests shouldn't increase the -- timeout - withTimeout 5 $ skipManyTill anyMessage (message SWorkspaceApplyEdit) + withTimeout 5 $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) -- wait just a bit longer than 5 seconds so we have time -- to open the document in timeout 6000000 sesh `shouldThrow` anySessionException @@ -96,7 +94,7 @@ main = hspec $ around withDummyServer $ do withTimeout 10 $ liftIO $ threadDelay 7000000 getDocumentSymbols doc -- should now timeout - skipManyTill anyMessage (message SWorkspaceApplyEdit) + skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) isTimeout (Timeout _) = True isTimeout _ = False in sesh `shouldThrow` isTimeout @@ -106,7 +104,7 @@ main = hspec $ around withDummyServer $ do it "throw on time out" $ \(hin, hout) -> let sesh = runSessionWithHandles hin hout (def {messageTimeout = 10}) fullCaps "." $ do skipMany loggingNotification - _ <- message SWorkspaceApplyEdit + _ <- message SMethod_WorkspaceApplyEdit return () in sesh `shouldThrow` anySessionException @@ -119,17 +117,17 @@ main = hspec $ around withDummyServer $ do describe "UnexpectedMessageException" $ do it "throws when there's an unexpected message" $ \(hin, hout) -> - let selector (UnexpectedMessage "Publish diagnostics notification" (FromServerMess SWindowLogMessage _)) = True + let selector (UnexpectedMessage "Publish diagnostics notification" (FromServerMess SMethod_WindowLogMessage _)) = True selector _ = False in runSessionWithHandles hin hout def fullCaps "." publishDiagnosticsNotification `shouldThrow` selector it "provides the correct types that were expected and received" $ \(hin, hout) -> - let selector (UnexpectedMessage "Response for: STextDocumentRename" (FromServerRsp STextDocumentDocumentSymbol _)) = True + let selector (UnexpectedMessage "Response for: SMethod_TextDocumentRename" (FromServerRsp SMethod_TextDocumentDocumentSymbol _)) = True selector _ = False sesh = do doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" - sendRequest STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) + sendRequest SMethod_TextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) skipMany anyNotification - response STextDocumentRename -- the wrong type + response SMethod_TextDocumentRename -- the wrong type in runSessionWithHandles hin hout def fullCaps "." sesh `shouldThrow` selector @@ -140,19 +138,19 @@ main = hspec $ around withDummyServer $ do VersionedTextDocumentIdentifier _ beforeVersion <- getVersionedDoc doc let args = toJSON (VersionedTextDocumentIdentifier (doc ^. uri) beforeVersion) - reqParams = ExecuteCommandParams Nothing "doAVersionedEdit" (Just (List [args])) + reqParams = ExecuteCommandParams Nothing "doAVersionedEdit" (Just [args]) - request_ SWorkspaceExecuteCommand reqParams + request_ SMethod_WorkspaceExecuteCommand reqParams - editReq <- message SWorkspaceApplyEdit + editReq <- message SMethod_WorkspaceApplyEdit liftIO $ do - let Just (List [InL(TextDocumentEdit vdoc (List [InL edit_]))]) = + let Just [InL(TextDocumentEdit vdoc [InL edit_])] = editReq ^. params . edit . documentChanges - vdoc `shouldBe` VersionedTextDocumentIdentifier (doc ^. uri) beforeVersion + vdoc `shouldBe` OptionalVersionedTextDocumentIdentifier (doc ^. uri) (InL beforeVersion) edit_ `shouldBe` TextEdit (Range (Position 0 0) (Position 0 5)) "howdy" - change <- customNotification "custom/textDocument/didChange" - let NotMess (NotificationMessage _ _ (c::Value)) = change + change <- customNotification (Proxy @"custom/textDocument/didChange") + let NotMess (TNotificationMessage _ _ (c::Value)) = change Success (DidChangeTextDocumentParams reportedVDoc _edit) = fromJSON c VersionedTextDocumentIdentifier _ reportedVersion = reportedVDoc @@ -169,13 +167,13 @@ main = hspec $ around withDummyServer $ do doc <- openDoc "test/data/refactor/Main.hs" "haskell" let args = toJSON (doc ^. uri) - reqParams = ExecuteCommandParams Nothing "doAnEdit" (Just (List [args])) - request_ SWorkspaceExecuteCommand reqParams + reqParams = ExecuteCommandParams Nothing "doAnEdit" (Just [args]) + request_ SMethod_WorkspaceExecuteCommand reqParams - editReq <- message SWorkspaceApplyEdit + editReq <- message SMethod_WorkspaceApplyEdit liftIO $ do let (Just cs) = editReq ^. params . edit . changes - [(u, List es)] = HM.toList cs + [(u, es)] = M.toList cs u `shouldBe` doc ^. uri es `shouldBe` [TextEdit (Range (Position 0 0) (Position 0 5)) "howdy"] contents <- documentContents doc @@ -187,8 +185,8 @@ main = hspec $ around withDummyServer $ do doc <- openDoc "test/data/refactor/Main.hs" "haskell" let args = toJSON (doc ^. uri) - reqParams = ExecuteCommandParams Nothing "doAnEdit" (Just (List [args])) - request_ SWorkspaceExecuteCommand reqParams + reqParams = ExecuteCommandParams Nothing "doAnEdit" (Just [args]) + request_ SMethod_WorkspaceExecuteCommand reqParams contents <- getDocumentEdit doc liftIO $ contents `shouldBe` "howdy:: IO Int\nmain = return (42)\n" @@ -217,19 +215,19 @@ main = hspec $ around withDummyServer $ do skipMany loggingNotification - Left (mainSymbol:_) <- getDocumentSymbols doc + Right (mainSymbol:_) <- getDocumentSymbols doc liftIO $ do mainSymbol ^. name `shouldBe` "foo" - mainSymbol ^. kind `shouldBe` SkObject + mainSymbol ^. kind `shouldBe` SymbolKind_Object mainSymbol ^. range `shouldBe` mkRange 0 0 3 6 describe "applyEdit" $ do - it "increments the version" $ \(hin, hout) -> runSessionWithHandles hin hout def docChangesCaps "." $ do + it "increments the version" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" - VersionedTextDocumentIdentifier _ (Just oldVersion) <- getVersionedDoc doc + VersionedTextDocumentIdentifier _ oldVersion <- getVersionedDoc doc let edit = TextEdit (Range (Position 1 1) (Position 1 3)) "foo" - VersionedTextDocumentIdentifier _ (Just newVersion) <- applyEdit doc edit + VersionedTextDocumentIdentifier _ newVersion <- applyEdit doc edit liftIO $ newVersion `shouldBe` oldVersion + 1 it "changes the document contents" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" @@ -277,7 +275,7 @@ main = hspec $ around withDummyServer $ do openDoc "test/data/Error.hs" "haskell" [diag] <- waitForDiagnosticsSource "dummy-server" liftIO $ do - diag ^. severity `shouldBe` Just DsWarning + diag ^. severity `shouldBe` Just DiagnosticSeverity_Warning diag ^. source `shouldBe` Just "dummy-server" -- describe "rename" $ do @@ -328,24 +326,24 @@ main = hspec $ around withDummyServer $ do describe "satisfy" $ it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do openDoc "test/data/Format.hs" "haskell" - let pred (FromServerMess SWindowLogMessage _) = True + let pred (FromServerMess SMethod_WindowLogMessage _) = True pred _ = False void $ satisfy pred describe "satisfyMaybe" $ do it "returns matched data on match" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do -- Wait for window/logMessage "initialized" from the server. - let pred (FromServerMess SWindowLogMessage _) = Just "match" :: Maybe String + let pred (FromServerMess SMethod_WindowLogMessage _) = Just "match" :: Maybe String pred _ = Nothing :: Maybe String result <- satisfyMaybe pred liftIO $ result `shouldBe` "match" it "doesn't return if no match" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do - let pred (FromServerMess STextDocumentPublishDiagnostics _) = Just "matched" :: Maybe String + let pred (FromServerMess SMethod_TextDocumentPublishDiagnostics _) = Just "matched" :: Maybe String pred _ = Nothing :: Maybe String -- We expect a window/logMessage from the server, but -- not a textDocument/publishDiagnostics. - result <- satisfyMaybe pred <|> (message SWindowLogMessage *> pure "no match") + result <- satisfyMaybe pred <|> (message SMethod_WindowLogMessage *> pure "no match") liftIO $ result `shouldBe` "no match" describe "ignoreLogNotifications" $ @@ -360,26 +358,26 @@ main = hspec $ around withDummyServer $ do loggingNotification -- initialized log message createDoc ".register" "haskell" "" - message SClientRegisterCapability + message SMethod_ClientRegisterCapability doc <- createDoc "Foo.watch" "haskell" "" - msg <- message SWindowLogMessage + msg <- message SMethod_WindowLogMessage liftIO $ msg ^. params . LSP.message `shouldBe` "got workspace/didChangeWatchedFiles" - [SomeRegistration (Registration _ regMethod regOpts)] <- getRegisteredCapabilities + [SomeRegistration (TRegistration _ regMethod regOpts)] <- getRegisteredCapabilities liftIO $ do - case regMethod `mEqClient` SWorkspaceDidChangeWatchedFiles of + case regMethod `mEqClient` SMethod_WorkspaceDidChangeWatchedFiles of Just (Right HRefl) -> - regOpts `shouldBe` (Just (DidChangeWatchedFilesRegistrationOptions $ List - [ FileSystemWatcher "*.watch" (Just (WatchKind True True True)) ])) + regOpts `shouldBe` (Just $ DidChangeWatchedFilesRegistrationOptions + [ FileSystemWatcher (GlobPattern $ InL $ Pattern "*.watch") (Just WatchKind_Create) ]) _ -> expectationFailure "Registration wasn't on workspace/didChangeWatchedFiles" -- now unregister it by sending a specific createDoc createDoc ".unregister" "haskell" "" - message SClientUnregisterCapability + message SMethod_ClientUnregisterCapability createDoc "Bar.watch" "haskell" "" - void $ sendRequest STextDocumentHover $ HoverParams doc (Position 0 0) Nothing + void $ sendRequest SMethod_TextDocumentHover $ HoverParams doc (Position 0 0) Nothing count 0 $ loggingNotification void $ anyResponse @@ -389,18 +387,18 @@ main = hspec $ around withDummyServer $ do loggingNotification -- initialized log message createDoc ".register.abs" "haskell" "" - message SClientRegisterCapability + message SMethod_ClientRegisterCapability doc <- createDoc (curDir "Foo.watch") "haskell" "" - msg <- message SWindowLogMessage + msg <- message SMethod_WindowLogMessage liftIO $ msg ^. params . LSP.message `shouldBe` "got workspace/didChangeWatchedFiles" -- now unregister it by sending a specific createDoc createDoc ".unregister.abs" "haskell" "" - message SClientUnregisterCapability + message SMethod_ClientUnregisterCapability createDoc (curDir "Bar.watch") "haskell" "" - void $ sendRequest STextDocumentHover $ HoverParams doc (Position 0 0) Nothing + void $ sendRequest SMethod_TextDocumentHover $ HoverParams doc (Position 0 0) Nothing count 0 $ loggingNotification void $ anyResponse @@ -408,7 +406,7 @@ main = hspec $ around withDummyServer $ do let workPos = Position 1 0 notWorkPos = Position 0 0 params pos = CallHierarchyPrepareParams (TextDocumentIdentifier (Uri "")) pos Nothing - item = CallHierarchyItem "foo" SkFunction Nothing Nothing (Uri "") + item = CallHierarchyItem "foo" SymbolKind_Function Nothing Nothing (Uri "") (Range (Position 1 2) (Position 3 4)) (Range (Position 1 2) (Position 3 4)) Nothing @@ -419,26 +417,14 @@ main = hspec $ around withDummyServer $ do rsp <- prepareCallHierarchy (params notWorkPos) liftIO $ rsp `shouldBe` [] it "incoming calls" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do - [CallHierarchyIncomingCall _ (List fromRanges)] <- incomingCalls (CallHierarchyIncomingCallsParams Nothing Nothing item) + [CallHierarchyIncomingCall _ fromRanges] <- incomingCalls (CallHierarchyIncomingCallsParams Nothing Nothing item) liftIO $ head fromRanges `shouldBe` Range (Position 2 3) (Position 4 5) it "outgoing calls" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do - [CallHierarchyOutgoingCall _ (List fromRanges)] <- outgoingCalls (CallHierarchyOutgoingCallsParams Nothing Nothing item) + [CallHierarchyOutgoingCall _ fromRanges] <- outgoingCalls (CallHierarchyOutgoingCallsParams Nothing Nothing item) liftIO $ head fromRanges `shouldBe` Range (Position 4 5) (Position 2 3) describe "semantic tokens" $ do it "full works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do let doc = TextDocumentIdentifier (Uri "") - Just toks <- getSemanticTokens doc - liftIO $ toks ^. xdata `shouldBe` List [0,1,2,1,0] - -didChangeCaps :: ClientCapabilities -didChangeCaps = def { _workspace = Just workspaceCaps } - where - workspaceCaps = def { _didChangeConfiguration = Just configCaps } - configCaps = DidChangeConfigurationClientCapabilities (Just True) - -docChangesCaps :: ClientCapabilities -docChangesCaps = def { _workspace = Just workspaceCaps } - where - workspaceCaps = def { _workspaceEdit = Just editCaps } - editCaps = WorkspaceEditClientCapabilities (Just True) Nothing Nothing Nothing Nothing + InL toks <- getSemanticTokens doc + liftIO $ toks ^. data_ `shouldBe` [0,1,2,1,0] diff --git a/lsp-types/ChangeLog.md b/lsp-types/ChangeLog.md index 042bcdeeb..018d53538 100644 --- a/lsp-types/ChangeLog.md +++ b/lsp-types/ChangeLog.md @@ -1,12 +1,23 @@ # Revision history for lsp-types +## 2.0.0.0 + +* Breaking change: major restructure to generate types and methods from the LSP metamodel. + * Full support for version 3.17 of the LSP specification, many accuracy fixes + * Generated types follow the spec very closely, e.g. using anonymous types, using `a |? Null` instead of `Maybe a` + * Anonymous record types in the spec are now represented using `row-types` + * Many constructors are now prefixed with their type names + * Documentation from the spec is transferred + * Three top level modules: `Types` (main protocol types), `Message` (messages and methods), `Capabilities` (capabilities) +* New typeclasses for handling LSP enumerations: `LspEnum` and `LspOpenEnum` + ## 1.6.0.0 * Add `isSubRangeOf` and `positionInRange` helper functions * Add `ServerCancelled`, `RequestFailed` and `ErrorCodeCustom` server error types * Fix "workspace/semanticTokens/refresh" to be a server method instead of a client method * Use a packed representation for `NormalizedFilePath` -* Add converions from `OsPath` to `NormalizedFilePath` in `Language.LSP.Types.Uri.OsPath` when using new enough `filepath` +* Add conversions from `OsPath` to `NormalizedFilePath` in `Language.LSP.Types.Uri.OsPath` when using new enough `filepath` ## 1.5.0.0 diff --git a/lsp-types/README.md b/lsp-types/README.md index 60b68fcd8..b38843594 100644 --- a/lsp-types/README.md +++ b/lsp-types/README.md @@ -7,6 +7,10 @@ It is part of the [lsp](https://github.com/haskell/lsp) family of packages, along with [lsp](https://hackage.haskell.org/package/lsp) and [lsp-test](https://hackage.haskell.org/package/lsp-test) +## Updating the generated code + +To update the generated code, run `cabal run generator` from the `lsp-types` directory. + ## Useful links - https://github.com/haskell/lsp diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Lens.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Lens.hs new file mode 100644 index 000000000..cbcd9bfb2 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Lens.hs @@ -0,0 +1,635 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Lens where + +import qualified Control.Lens.TH +import qualified Language.LSP.Protocol.Internal.Types.AnnotatedTextEdit +import qualified Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditParams +import qualified Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditResult +import qualified Language.LSP.Protocol.Internal.Types.BaseSymbolInformation +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCall +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCallsParams +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyItem +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyOptions +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCall +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCallsParams +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyPrepareParams +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.CancelParams +import qualified Language.LSP.Protocol.Internal.Types.ChangeAnnotation +import qualified Language.LSP.Protocol.Internal.Types.ClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.CodeAction +import qualified Language.LSP.Protocol.Internal.Types.CodeActionClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.CodeActionContext +import qualified Language.LSP.Protocol.Internal.Types.CodeActionOptions +import qualified Language.LSP.Protocol.Internal.Types.CodeActionParams +import qualified Language.LSP.Protocol.Internal.Types.CodeActionRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.CodeDescription +import qualified Language.LSP.Protocol.Internal.Types.CodeLens +import qualified Language.LSP.Protocol.Internal.Types.CodeLensClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.CodeLensOptions +import qualified Language.LSP.Protocol.Internal.Types.CodeLensParams +import qualified Language.LSP.Protocol.Internal.Types.CodeLensRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.CodeLensWorkspaceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.Color +import qualified Language.LSP.Protocol.Internal.Types.ColorInformation +import qualified Language.LSP.Protocol.Internal.Types.ColorPresentation +import qualified Language.LSP.Protocol.Internal.Types.ColorPresentationParams +import qualified Language.LSP.Protocol.Internal.Types.Command +import qualified Language.LSP.Protocol.Internal.Types.CompletionClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.CompletionContext +import qualified Language.LSP.Protocol.Internal.Types.CompletionItem +import qualified Language.LSP.Protocol.Internal.Types.CompletionItemLabelDetails +import qualified Language.LSP.Protocol.Internal.Types.CompletionList +import qualified Language.LSP.Protocol.Internal.Types.CompletionOptions +import qualified Language.LSP.Protocol.Internal.Types.CompletionParams +import qualified Language.LSP.Protocol.Internal.Types.CompletionRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.ConfigurationItem +import qualified Language.LSP.Protocol.Internal.Types.ConfigurationParams +import qualified Language.LSP.Protocol.Internal.Types.CreateFile +import qualified Language.LSP.Protocol.Internal.Types.CreateFileOptions +import qualified Language.LSP.Protocol.Internal.Types.CreateFilesParams +import qualified Language.LSP.Protocol.Internal.Types.DeclarationClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DeclarationOptions +import qualified Language.LSP.Protocol.Internal.Types.DeclarationParams +import qualified Language.LSP.Protocol.Internal.Types.DeclarationRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DefinitionClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DefinitionOptions +import qualified Language.LSP.Protocol.Internal.Types.DefinitionParams +import qualified Language.LSP.Protocol.Internal.Types.DefinitionRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DeleteFile +import qualified Language.LSP.Protocol.Internal.Types.DeleteFileOptions +import qualified Language.LSP.Protocol.Internal.Types.DeleteFilesParams +import qualified Language.LSP.Protocol.Internal.Types.Diagnostic +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticOptions +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticRelatedInformation +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticServerCancellationData +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticWorkspaceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DidChangeConfigurationClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DidChangeConfigurationParams +import qualified Language.LSP.Protocol.Internal.Types.DidChangeConfigurationRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DidChangeNotebookDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidChangeTextDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesParams +import qualified Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DidChangeWorkspaceFoldersParams +import qualified Language.LSP.Protocol.Internal.Types.DidCloseNotebookDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidCloseTextDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidOpenNotebookDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidOpenTextDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidSaveNotebookDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidSaveTextDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentColorClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentColorOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentColorParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentColorRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentDiagnosticParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReportPartialResult +import qualified Language.LSP.Protocol.Internal.Types.DocumentFormattingClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentFormattingOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentFormattingParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentFormattingRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentHighlight +import qualified Language.LSP.Protocol.Internal.Types.DocumentHighlightClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentHighlightOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentHighlightParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentHighlightRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentLink +import qualified Language.LSP.Protocol.Internal.Types.DocumentLinkClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentLinkOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentLinkParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentLinkRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentSymbol +import qualified Language.LSP.Protocol.Internal.Types.DocumentSymbolClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentSymbolOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentSymbolParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentSymbolRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.ExecuteCommandClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.ExecuteCommandOptions +import qualified Language.LSP.Protocol.Internal.Types.ExecuteCommandParams +import qualified Language.LSP.Protocol.Internal.Types.ExecuteCommandRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.ExecutionSummary +import qualified Language.LSP.Protocol.Internal.Types.FileCreate +import qualified Language.LSP.Protocol.Internal.Types.FileDelete +import qualified Language.LSP.Protocol.Internal.Types.FileEvent +import qualified Language.LSP.Protocol.Internal.Types.FileOperationClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.FileOperationFilter +import qualified Language.LSP.Protocol.Internal.Types.FileOperationOptions +import qualified Language.LSP.Protocol.Internal.Types.FileOperationPattern +import qualified Language.LSP.Protocol.Internal.Types.FileOperationPatternOptions +import qualified Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.FileRename +import qualified Language.LSP.Protocol.Internal.Types.FileSystemWatcher +import qualified Language.LSP.Protocol.Internal.Types.FoldingRange +import qualified Language.LSP.Protocol.Internal.Types.FoldingRangeClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.FoldingRangeOptions +import qualified Language.LSP.Protocol.Internal.Types.FoldingRangeParams +import qualified Language.LSP.Protocol.Internal.Types.FoldingRangeRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.FormattingOptions +import qualified Language.LSP.Protocol.Internal.Types.FullDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.GeneralClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.Hover +import qualified Language.LSP.Protocol.Internal.Types.HoverClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.HoverOptions +import qualified Language.LSP.Protocol.Internal.Types.HoverParams +import qualified Language.LSP.Protocol.Internal.Types.HoverRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.ImplementationClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.ImplementationOptions +import qualified Language.LSP.Protocol.Internal.Types.ImplementationParams +import qualified Language.LSP.Protocol.Internal.Types.ImplementationRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.InitializeError +import qualified Language.LSP.Protocol.Internal.Types.InitializeParams +import qualified Language.LSP.Protocol.Internal.Types.InitializeResult +import qualified Language.LSP.Protocol.Internal.Types.InitializedParams +import qualified Language.LSP.Protocol.Internal.Types.InlayHint +import qualified Language.LSP.Protocol.Internal.Types.InlayHintClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.InlayHintLabelPart +import qualified Language.LSP.Protocol.Internal.Types.InlayHintOptions +import qualified Language.LSP.Protocol.Internal.Types.InlayHintParams +import qualified Language.LSP.Protocol.Internal.Types.InlayHintRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.InlayHintWorkspaceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.InlineValueClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.InlineValueContext +import qualified Language.LSP.Protocol.Internal.Types.InlineValueEvaluatableExpression +import qualified Language.LSP.Protocol.Internal.Types.InlineValueOptions +import qualified Language.LSP.Protocol.Internal.Types.InlineValueParams +import qualified Language.LSP.Protocol.Internal.Types.InlineValueRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.InlineValueText +import qualified Language.LSP.Protocol.Internal.Types.InlineValueVariableLookup +import qualified Language.LSP.Protocol.Internal.Types.InlineValueWorkspaceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.InsertReplaceEdit +import qualified Language.LSP.Protocol.Internal.Types.LinkedEditingRangeClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.LinkedEditingRangeOptions +import qualified Language.LSP.Protocol.Internal.Types.LinkedEditingRangeParams +import qualified Language.LSP.Protocol.Internal.Types.LinkedEditingRangeRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.LinkedEditingRanges +import qualified Language.LSP.Protocol.Internal.Types.Location +import qualified Language.LSP.Protocol.Internal.Types.LocationLink +import qualified Language.LSP.Protocol.Internal.Types.LogMessageParams +import qualified Language.LSP.Protocol.Internal.Types.LogTraceParams +import qualified Language.LSP.Protocol.Internal.Types.MarkdownClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.MarkupContent +import qualified Language.LSP.Protocol.Internal.Types.MessageActionItem +import qualified Language.LSP.Protocol.Internal.Types.Moniker +import qualified Language.LSP.Protocol.Internal.Types.MonikerClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.MonikerOptions +import qualified Language.LSP.Protocol.Internal.Types.MonikerParams +import qualified Language.LSP.Protocol.Internal.Types.MonikerRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.NotebookCell +import qualified Language.LSP.Protocol.Internal.Types.NotebookCellArrayChange +import qualified Language.LSP.Protocol.Internal.Types.NotebookCellTextDocumentFilter +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocument +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentChangeEvent +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentIdentifier +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncOptions +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.OptionalVersionedTextDocumentIdentifier +import qualified Language.LSP.Protocol.Internal.Types.ParameterInformation +import qualified Language.LSP.Protocol.Internal.Types.PartialResultParams +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.PrepareRenameParams +import qualified Language.LSP.Protocol.Internal.Types.PreviousResultId +import qualified Language.LSP.Protocol.Internal.Types.ProgressParams +import qualified Language.LSP.Protocol.Internal.Types.PublishDiagnosticsClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.PublishDiagnosticsParams +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Internal.Types.ReferenceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.ReferenceContext +import qualified Language.LSP.Protocol.Internal.Types.ReferenceOptions +import qualified Language.LSP.Protocol.Internal.Types.ReferenceParams +import qualified Language.LSP.Protocol.Internal.Types.ReferenceRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.Registration +import qualified Language.LSP.Protocol.Internal.Types.RegistrationParams +import qualified Language.LSP.Protocol.Internal.Types.RegularExpressionsClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.RelatedFullDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.RelatedUnchangedDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.RelativePattern +import qualified Language.LSP.Protocol.Internal.Types.RenameClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.RenameFile +import qualified Language.LSP.Protocol.Internal.Types.RenameFileOptions +import qualified Language.LSP.Protocol.Internal.Types.RenameFilesParams +import qualified Language.LSP.Protocol.Internal.Types.RenameOptions +import qualified Language.LSP.Protocol.Internal.Types.RenameParams +import qualified Language.LSP.Protocol.Internal.Types.RenameRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.ResourceOperation +import qualified Language.LSP.Protocol.Internal.Types.SaveOptions +import qualified Language.LSP.Protocol.Internal.Types.SelectionRange +import qualified Language.LSP.Protocol.Internal.Types.SelectionRangeClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.SelectionRangeOptions +import qualified Language.LSP.Protocol.Internal.Types.SelectionRangeParams +import qualified Language.LSP.Protocol.Internal.Types.SelectionRangeRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokens +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensDelta +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensDeltaParams +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensDeltaPartialResult +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensEdit +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensLegend +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensOptions +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensParams +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensPartialResult +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensRangeParams +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensWorkspaceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.ServerCapabilities +import qualified Language.LSP.Protocol.Internal.Types.SetTraceParams +import qualified Language.LSP.Protocol.Internal.Types.ShowDocumentClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.ShowDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.ShowDocumentResult +import qualified Language.LSP.Protocol.Internal.Types.ShowMessageParams +import qualified Language.LSP.Protocol.Internal.Types.ShowMessageRequestClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.ShowMessageRequestParams +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelp +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelpClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelpContext +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelpOptions +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelpParams +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelpRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.SignatureInformation +import qualified Language.LSP.Protocol.Internal.Types.StaticRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.SymbolInformation +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentChangeRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentEdit +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentItem +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentPositionParams +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentSaveRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentSyncClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentSyncOptions +import qualified Language.LSP.Protocol.Internal.Types.TextEdit +import qualified Language.LSP.Protocol.Internal.Types.TypeDefinitionClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.TypeDefinitionOptions +import qualified Language.LSP.Protocol.Internal.Types.TypeDefinitionParams +import qualified Language.LSP.Protocol.Internal.Types.TypeDefinitionRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyItem +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyOptions +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyPrepareParams +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchySubtypesParams +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchySupertypesParams +import qualified Language.LSP.Protocol.Internal.Types.UInitializeParams +import qualified Language.LSP.Protocol.Internal.Types.UnchangedDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.Unregistration +import qualified Language.LSP.Protocol.Internal.Types.UnregistrationParams +import qualified Language.LSP.Protocol.Internal.Types.VersionedNotebookDocumentIdentifier +import qualified Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier +import qualified Language.LSP.Protocol.Internal.Types.WillSaveTextDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.WindowClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.WorkDoneProgressBegin +import qualified Language.LSP.Protocol.Internal.Types.WorkDoneProgressCancelParams +import qualified Language.LSP.Protocol.Internal.Types.WorkDoneProgressCreateParams +import qualified Language.LSP.Protocol.Internal.Types.WorkDoneProgressEnd +import qualified Language.LSP.Protocol.Internal.Types.WorkDoneProgressOptions +import qualified Language.LSP.Protocol.Internal.Types.WorkDoneProgressParams +import qualified Language.LSP.Protocol.Internal.Types.WorkDoneProgressReport +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticParams +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticReportPartialResult +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceEdit +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceEditClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFolder +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFoldersChangeEvent +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFoldersInitializeParams +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFoldersServerCapabilities +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFullDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceSymbol +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceSymbolClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceSymbolOptions +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceSymbolParams +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceSymbolRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceUnchangedDocumentDiagnosticReport + +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ImplementationParams.ImplementationParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.Location.Location +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ImplementationRegistrationOptions.ImplementationRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TypeDefinitionParams.TypeDefinitionParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TypeDefinitionRegistrationOptions.TypeDefinitionRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidChangeWorkspaceFoldersParams.DidChangeWorkspaceFoldersParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ConfigurationParams.ConfigurationParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentColorParams.DocumentColorParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ColorInformation.ColorInformation +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentColorRegistrationOptions.DocumentColorRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ColorPresentationParams.ColorPresentationParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ColorPresentation.ColorPresentation +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkDoneProgressOptions.WorkDoneProgressOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TextDocumentRegistrationOptions.TextDocumentRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FoldingRangeParams.FoldingRangeParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FoldingRange.FoldingRange +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FoldingRangeRegistrationOptions.FoldingRangeRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DeclarationParams.DeclarationParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DeclarationRegistrationOptions.DeclarationRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SelectionRangeParams.SelectionRangeParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SelectionRange.SelectionRange +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SelectionRangeRegistrationOptions.SelectionRangeRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkDoneProgressCreateParams.WorkDoneProgressCreateParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkDoneProgressCancelParams.WorkDoneProgressCancelParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CallHierarchyPrepareParams.CallHierarchyPrepareParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CallHierarchyItem.CallHierarchyItem +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CallHierarchyRegistrationOptions.CallHierarchyRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCallsParams.CallHierarchyIncomingCallsParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCall.CallHierarchyIncomingCall +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCallsParams.CallHierarchyOutgoingCallsParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCall.CallHierarchyOutgoingCall +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokensParams.SemanticTokensParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokens.SemanticTokens +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokensPartialResult.SemanticTokensPartialResult +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokensRegistrationOptions.SemanticTokensRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokensDeltaParams.SemanticTokensDeltaParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokensDelta.SemanticTokensDelta +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokensDeltaPartialResult.SemanticTokensDeltaPartialResult +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokensRangeParams.SemanticTokensRangeParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ShowDocumentParams.ShowDocumentParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ShowDocumentResult.ShowDocumentResult +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.LinkedEditingRangeParams.LinkedEditingRangeParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.LinkedEditingRanges.LinkedEditingRanges +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.LinkedEditingRangeRegistrationOptions.LinkedEditingRangeRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CreateFilesParams.CreateFilesParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceEdit.WorkspaceEdit +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.RenameFilesParams.RenameFilesParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DeleteFilesParams.DeleteFilesParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.MonikerParams.MonikerParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.Moniker.Moniker +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.MonikerRegistrationOptions.MonikerRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TypeHierarchyPrepareParams.TypeHierarchyPrepareParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TypeHierarchyItem.TypeHierarchyItem +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TypeHierarchyRegistrationOptions.TypeHierarchyRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TypeHierarchySupertypesParams.TypeHierarchySupertypesParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TypeHierarchySubtypesParams.TypeHierarchySubtypesParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlineValueParams.InlineValueParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlineValueRegistrationOptions.InlineValueRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlayHintParams.InlayHintParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlayHint.InlayHint +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlayHintRegistrationOptions.InlayHintRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentDiagnosticParams.DocumentDiagnosticParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReportPartialResult.DocumentDiagnosticReportPartialResult +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DiagnosticServerCancellationData.DiagnosticServerCancellationData +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DiagnosticRegistrationOptions.DiagnosticRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticParams.WorkspaceDiagnosticParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticReport.WorkspaceDiagnosticReport +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticReportPartialResult.WorkspaceDiagnosticReportPartialResult +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidOpenNotebookDocumentParams.DidOpenNotebookDocumentParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidChangeNotebookDocumentParams.DidChangeNotebookDocumentParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidSaveNotebookDocumentParams.DidSaveNotebookDocumentParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidCloseNotebookDocumentParams.DidCloseNotebookDocumentParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.RegistrationParams.RegistrationParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.UnregistrationParams.UnregistrationParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InitializeParams.InitializeParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InitializeResult.InitializeResult +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InitializeError.InitializeError +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InitializedParams.InitializedParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidChangeConfigurationParams.DidChangeConfigurationParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidChangeConfigurationRegistrationOptions.DidChangeConfigurationRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ShowMessageParams.ShowMessageParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ShowMessageRequestParams.ShowMessageRequestParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.MessageActionItem.MessageActionItem +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.LogMessageParams.LogMessageParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidOpenTextDocumentParams.DidOpenTextDocumentParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidChangeTextDocumentParams.DidChangeTextDocumentParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TextDocumentChangeRegistrationOptions.TextDocumentChangeRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidCloseTextDocumentParams.DidCloseTextDocumentParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidSaveTextDocumentParams.DidSaveTextDocumentParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TextDocumentSaveRegistrationOptions.TextDocumentSaveRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WillSaveTextDocumentParams.WillSaveTextDocumentParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesParams.DidChangeWatchedFilesParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesRegistrationOptions.DidChangeWatchedFilesRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.PublishDiagnosticsParams.PublishDiagnosticsParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CompletionParams.CompletionParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CompletionItem.CompletionItem +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CompletionList.CompletionList +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CompletionRegistrationOptions.CompletionRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.HoverParams.HoverParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.Hover.Hover +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.HoverRegistrationOptions.HoverRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SignatureHelpParams.SignatureHelpParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SignatureHelp.SignatureHelp +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SignatureHelpRegistrationOptions.SignatureHelpRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DefinitionParams.DefinitionParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DefinitionRegistrationOptions.DefinitionRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ReferenceParams.ReferenceParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ReferenceRegistrationOptions.ReferenceRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentHighlightParams.DocumentHighlightParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentHighlight.DocumentHighlight +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentHighlightRegistrationOptions.DocumentHighlightRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentSymbolParams.DocumentSymbolParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SymbolInformation.SymbolInformation +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentSymbol.DocumentSymbol +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentSymbolRegistrationOptions.DocumentSymbolRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeActionParams.CodeActionParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.Command.Command +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeAction.CodeAction +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeActionRegistrationOptions.CodeActionRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceSymbolParams.WorkspaceSymbolParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceSymbol.WorkspaceSymbol +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceSymbolRegistrationOptions.WorkspaceSymbolRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeLensParams.CodeLensParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeLens.CodeLens +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeLensRegistrationOptions.CodeLensRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentLinkParams.DocumentLinkParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentLink.DocumentLink +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentLinkRegistrationOptions.DocumentLinkRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentFormattingParams.DocumentFormattingParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentFormattingRegistrationOptions.DocumentFormattingRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingParams.DocumentRangeFormattingParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingRegistrationOptions.DocumentRangeFormattingRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingParams.DocumentOnTypeFormattingParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingRegistrationOptions.DocumentOnTypeFormattingRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.RenameParams.RenameParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.RenameRegistrationOptions.RenameRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.PrepareRenameParams.PrepareRenameParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ExecuteCommandParams.ExecuteCommandParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ExecuteCommandRegistrationOptions.ExecuteCommandRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditParams.ApplyWorkspaceEditParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditResult.ApplyWorkspaceEditResult +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkDoneProgressBegin.WorkDoneProgressBegin +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkDoneProgressReport.WorkDoneProgressReport +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkDoneProgressEnd.WorkDoneProgressEnd +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SetTraceParams.SetTraceParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.LogTraceParams.LogTraceParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CancelParams.CancelParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ProgressParams.ProgressParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TextDocumentPositionParams.TextDocumentPositionParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkDoneProgressParams.WorkDoneProgressParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.PartialResultParams.PartialResultParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.LocationLink.LocationLink +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.Range.Range +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ImplementationOptions.ImplementationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.StaticRegistrationOptions.StaticRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TypeDefinitionOptions.TypeDefinitionOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceFoldersChangeEvent.WorkspaceFoldersChangeEvent +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ConfigurationItem.ConfigurationItem +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.Color.Color +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentColorOptions.DocumentColorOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FoldingRangeOptions.FoldingRangeOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DeclarationOptions.DeclarationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.Position.Position +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SelectionRangeOptions.SelectionRangeOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CallHierarchyOptions.CallHierarchyOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokensOptions.SemanticTokensOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokensEdit.SemanticTokensEdit +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.LinkedEditingRangeOptions.LinkedEditingRangeOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FileCreate.FileCreate +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TextDocumentEdit.TextDocumentEdit +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CreateFile.CreateFile +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.RenameFile.RenameFile +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DeleteFile.DeleteFile +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ChangeAnnotation.ChangeAnnotation +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FileOperationFilter.FileOperationFilter +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FileRename.FileRename +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FileDelete.FileDelete +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.MonikerOptions.MonikerOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TypeHierarchyOptions.TypeHierarchyOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlineValueContext.InlineValueContext +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlineValueText.InlineValueText +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlineValueVariableLookup.InlineValueVariableLookup +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlineValueEvaluatableExpression.InlineValueEvaluatableExpression +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlineValueOptions.InlineValueOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlayHintLabelPart.InlayHintLabelPart +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.MarkupContent.MarkupContent +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlayHintOptions.InlayHintOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.RelatedFullDocumentDiagnosticReport.RelatedFullDocumentDiagnosticReport +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.RelatedUnchangedDocumentDiagnosticReport.RelatedUnchangedDocumentDiagnosticReport +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FullDocumentDiagnosticReport.FullDocumentDiagnosticReport +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.UnchangedDocumentDiagnosticReport.UnchangedDocumentDiagnosticReport +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DiagnosticOptions.DiagnosticOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.PreviousResultId.PreviousResultId +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.NotebookDocument.NotebookDocument +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TextDocumentItem.TextDocumentItem +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.VersionedNotebookDocumentIdentifier.VersionedNotebookDocumentIdentifier +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.NotebookDocumentChangeEvent.NotebookDocumentChangeEvent +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.NotebookDocumentIdentifier.NotebookDocumentIdentifier +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.Registration.Registration +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.Unregistration.Unregistration +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.UInitializeParams.UInitializeParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceFoldersInitializeParams.WorkspaceFoldersInitializeParams +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ServerCapabilities.ServerCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier.VersionedTextDocumentIdentifier +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SaveOptions.SaveOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FileEvent.FileEvent +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FileSystemWatcher.FileSystemWatcher +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CompletionContext.CompletionContext +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CompletionItemLabelDetails.CompletionItemLabelDetails +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InsertReplaceEdit.InsertReplaceEdit +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CompletionOptions.CompletionOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.HoverOptions.HoverOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SignatureHelpContext.SignatureHelpContext +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SignatureInformation.SignatureInformation +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SignatureHelpOptions.SignatureHelpOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DefinitionOptions.DefinitionOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ReferenceContext.ReferenceContext +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ReferenceOptions.ReferenceOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentHighlightOptions.DocumentHighlightOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.BaseSymbolInformation.BaseSymbolInformation +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentSymbolOptions.DocumentSymbolOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeActionContext.CodeActionContext +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeActionOptions.CodeActionOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceSymbolOptions.WorkspaceSymbolOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeLensOptions.CodeLensOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentLinkOptions.DocumentLinkOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FormattingOptions.FormattingOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentFormattingOptions.DocumentFormattingOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingOptions.DocumentRangeFormattingOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingOptions.DocumentOnTypeFormattingOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.RenameOptions.RenameOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ExecuteCommandOptions.ExecuteCommandOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokensLegend.SemanticTokensLegend +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.OptionalVersionedTextDocumentIdentifier.OptionalVersionedTextDocumentIdentifier +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.AnnotatedTextEdit.AnnotatedTextEdit +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ResourceOperation.ResourceOperation +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CreateFileOptions.CreateFileOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.RenameFileOptions.RenameFileOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DeleteFileOptions.DeleteFileOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FileOperationPattern.FileOperationPattern +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceFullDocumentDiagnosticReport.WorkspaceFullDocumentDiagnosticReport +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceUnchangedDocumentDiagnosticReport.WorkspaceUnchangedDocumentDiagnosticReport +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.NotebookCell.NotebookCell +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.NotebookCellArrayChange.NotebookCellArrayChange +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ClientCapabilities.ClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TextDocumentSyncOptions.TextDocumentSyncOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncOptions.NotebookDocumentSyncOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncRegistrationOptions.NotebookDocumentSyncRegistrationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceFoldersServerCapabilities.WorkspaceFoldersServerCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FileOperationOptions.FileOperationOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeDescription.CodeDescription +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DiagnosticRelatedInformation.DiagnosticRelatedInformation +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ParameterInformation.ParameterInformation +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.NotebookCellTextDocumentFilter.NotebookCellTextDocumentFilter +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FileOperationPatternOptions.FileOperationPatternOptions +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ExecutionSummary.ExecutionSummary +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceClientCapabilities.WorkspaceClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TextDocumentClientCapabilities.TextDocumentClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.NotebookDocumentClientCapabilities.NotebookDocumentClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WindowClientCapabilities.WindowClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.GeneralClientCapabilities.GeneralClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.RelativePattern.RelativePattern +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceEditClientCapabilities.WorkspaceEditClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidChangeConfigurationClientCapabilities.DidChangeConfigurationClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesClientCapabilities.DidChangeWatchedFilesClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.WorkspaceSymbolClientCapabilities.WorkspaceSymbolClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ExecuteCommandClientCapabilities.ExecuteCommandClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokensWorkspaceClientCapabilities.SemanticTokensWorkspaceClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeLensWorkspaceClientCapabilities.CodeLensWorkspaceClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FileOperationClientCapabilities.FileOperationClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlineValueWorkspaceClientCapabilities.InlineValueWorkspaceClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlayHintWorkspaceClientCapabilities.InlayHintWorkspaceClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DiagnosticWorkspaceClientCapabilities.DiagnosticWorkspaceClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TextDocumentSyncClientCapabilities.TextDocumentSyncClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CompletionClientCapabilities.CompletionClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.HoverClientCapabilities.HoverClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SignatureHelpClientCapabilities.SignatureHelpClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DeclarationClientCapabilities.DeclarationClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DefinitionClientCapabilities.DefinitionClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TypeDefinitionClientCapabilities.TypeDefinitionClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ImplementationClientCapabilities.ImplementationClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ReferenceClientCapabilities.ReferenceClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentHighlightClientCapabilities.DocumentHighlightClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentSymbolClientCapabilities.DocumentSymbolClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeActionClientCapabilities.CodeActionClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CodeLensClientCapabilities.CodeLensClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentLinkClientCapabilities.DocumentLinkClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentColorClientCapabilities.DocumentColorClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentFormattingClientCapabilities.DocumentFormattingClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingClientCapabilities.DocumentRangeFormattingClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingClientCapabilities.DocumentOnTypeFormattingClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.RenameClientCapabilities.RenameClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.FoldingRangeClientCapabilities.FoldingRangeClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SelectionRangeClientCapabilities.SelectionRangeClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.PublishDiagnosticsClientCapabilities.PublishDiagnosticsClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.CallHierarchyClientCapabilities.CallHierarchyClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.SemanticTokensClientCapabilities.SemanticTokensClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.LinkedEditingRangeClientCapabilities.LinkedEditingRangeClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.MonikerClientCapabilities.MonikerClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.TypeHierarchyClientCapabilities.TypeHierarchyClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlineValueClientCapabilities.InlineValueClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.InlayHintClientCapabilities.InlayHintClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.DiagnosticClientCapabilities.DiagnosticClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncClientCapabilities.NotebookDocumentSyncClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ShowMessageRequestClientCapabilities.ShowMessageRequestClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.ShowDocumentClientCapabilities.ShowDocumentClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.RegularExpressionsClientCapabilities.RegularExpressionsClientCapabilities +Control.Lens.TH.makeFieldsNoPrefix ''Language.LSP.Protocol.Internal.Types.MarkdownClientCapabilities.MarkdownClientCapabilities \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Method.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Method.hs new file mode 100644 index 000000000..a1d89a672 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Method.hs @@ -0,0 +1,1065 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Method where + +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Kind as Kind +import qualified Data.Proxy +import qualified Data.Row as Row +import qualified Data.Void +import qualified GHC.TypeLits +import qualified Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditParams +import qualified Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditResult +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCall +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCallsParams +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyItem +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCall +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCallsParams +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyPrepareParams +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.CancelParams +import qualified Language.LSP.Protocol.Internal.Types.CodeAction +import qualified Language.LSP.Protocol.Internal.Types.CodeActionParams +import qualified Language.LSP.Protocol.Internal.Types.CodeActionRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.CodeLens +import qualified Language.LSP.Protocol.Internal.Types.CodeLensParams +import qualified Language.LSP.Protocol.Internal.Types.CodeLensRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.ColorInformation +import qualified Language.LSP.Protocol.Internal.Types.ColorPresentation +import qualified Language.LSP.Protocol.Internal.Types.ColorPresentationParams +import qualified Language.LSP.Protocol.Internal.Types.Command +import qualified Language.LSP.Protocol.Internal.Types.CompletionItem +import qualified Language.LSP.Protocol.Internal.Types.CompletionList +import qualified Language.LSP.Protocol.Internal.Types.CompletionParams +import qualified Language.LSP.Protocol.Internal.Types.CompletionRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.ConfigurationParams +import qualified Language.LSP.Protocol.Internal.Types.CreateFilesParams +import qualified Language.LSP.Protocol.Internal.Types.Declaration +import qualified Language.LSP.Protocol.Internal.Types.DeclarationLink +import qualified Language.LSP.Protocol.Internal.Types.DeclarationParams +import qualified Language.LSP.Protocol.Internal.Types.DeclarationRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.Definition +import qualified Language.LSP.Protocol.Internal.Types.DefinitionLink +import qualified Language.LSP.Protocol.Internal.Types.DefinitionParams +import qualified Language.LSP.Protocol.Internal.Types.DefinitionRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DeleteFilesParams +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticServerCancellationData +import qualified Language.LSP.Protocol.Internal.Types.DidChangeConfigurationParams +import qualified Language.LSP.Protocol.Internal.Types.DidChangeConfigurationRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DidChangeNotebookDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidChangeTextDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesParams +import qualified Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DidChangeWorkspaceFoldersParams +import qualified Language.LSP.Protocol.Internal.Types.DidCloseNotebookDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidCloseTextDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidOpenNotebookDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidOpenTextDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidSaveNotebookDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DidSaveTextDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentColorParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentColorRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentDiagnosticParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.DocumentFormattingParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentFormattingRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentHighlight +import qualified Language.LSP.Protocol.Internal.Types.DocumentHighlightParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentHighlightRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentLink +import qualified Language.LSP.Protocol.Internal.Types.DocumentLinkParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentLinkRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Internal.Types.DocumentSymbol +import qualified Language.LSP.Protocol.Internal.Types.DocumentSymbolParams +import qualified Language.LSP.Protocol.Internal.Types.DocumentSymbolRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.ExecuteCommandParams +import qualified Language.LSP.Protocol.Internal.Types.ExecuteCommandRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.FoldingRange +import qualified Language.LSP.Protocol.Internal.Types.FoldingRangeParams +import qualified Language.LSP.Protocol.Internal.Types.FoldingRangeRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.Hover +import qualified Language.LSP.Protocol.Internal.Types.HoverParams +import qualified Language.LSP.Protocol.Internal.Types.HoverRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.ImplementationParams +import qualified Language.LSP.Protocol.Internal.Types.ImplementationRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.InitializeError +import qualified Language.LSP.Protocol.Internal.Types.InitializeParams +import qualified Language.LSP.Protocol.Internal.Types.InitializeResult +import qualified Language.LSP.Protocol.Internal.Types.InitializedParams +import qualified Language.LSP.Protocol.Internal.Types.InlayHint +import qualified Language.LSP.Protocol.Internal.Types.InlayHintParams +import qualified Language.LSP.Protocol.Internal.Types.InlayHintRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.InlineValue +import qualified Language.LSP.Protocol.Internal.Types.InlineValueParams +import qualified Language.LSP.Protocol.Internal.Types.InlineValueRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.LinkedEditingRangeParams +import qualified Language.LSP.Protocol.Internal.Types.LinkedEditingRangeRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.LinkedEditingRanges +import qualified Language.LSP.Protocol.Internal.Types.Location +import qualified Language.LSP.Protocol.Internal.Types.LogMessageParams +import qualified Language.LSP.Protocol.Internal.Types.LogTraceParams +import qualified Language.LSP.Protocol.Internal.Types.MessageActionItem +import qualified Language.LSP.Protocol.Internal.Types.Moniker +import qualified Language.LSP.Protocol.Internal.Types.MonikerParams +import qualified Language.LSP.Protocol.Internal.Types.MonikerRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.PrepareRenameParams +import qualified Language.LSP.Protocol.Internal.Types.PrepareRenameResult +import qualified Language.LSP.Protocol.Internal.Types.ProgressParams +import qualified Language.LSP.Protocol.Internal.Types.PublishDiagnosticsParams +import qualified Language.LSP.Protocol.Internal.Types.ReferenceParams +import qualified Language.LSP.Protocol.Internal.Types.ReferenceRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.RegistrationParams +import qualified Language.LSP.Protocol.Internal.Types.RenameFilesParams +import qualified Language.LSP.Protocol.Internal.Types.RenameParams +import qualified Language.LSP.Protocol.Internal.Types.RenameRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.SelectionRange +import qualified Language.LSP.Protocol.Internal.Types.SelectionRangeParams +import qualified Language.LSP.Protocol.Internal.Types.SelectionRangeRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokens +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensDelta +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensDeltaParams +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensParams +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensRangeParams +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.SetTraceParams +import qualified Language.LSP.Protocol.Internal.Types.ShowDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.ShowDocumentResult +import qualified Language.LSP.Protocol.Internal.Types.ShowMessageParams +import qualified Language.LSP.Protocol.Internal.Types.ShowMessageRequestParams +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelp +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelpParams +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelpRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.SymbolInformation +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentChangeRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentSaveRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.TextEdit +import qualified Language.LSP.Protocol.Internal.Types.TypeDefinitionParams +import qualified Language.LSP.Protocol.Internal.Types.TypeDefinitionRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyItem +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyPrepareParams +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchySubtypesParams +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchySupertypesParams +import qualified Language.LSP.Protocol.Internal.Types.UnregistrationParams +import qualified Language.LSP.Protocol.Internal.Types.WillSaveTextDocumentParams +import qualified Language.LSP.Protocol.Internal.Types.WorkDoneProgressCancelParams +import qualified Language.LSP.Protocol.Internal.Types.WorkDoneProgressCreateParams +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticParams +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceEdit +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFolder +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceSymbol +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceSymbolParams +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceSymbolRegistrationOptions +import qualified Language.LSP.Protocol.Message.Meta as MM +import qualified Language.LSP.Protocol.Types.Common + +-- | A type representing a LSP method (or class of methods), intended to be used mostly at the type level. +type Method :: MM.MessageDirection -> MM.MessageKind -> Kind.Type +data Method f t where + Method_TextDocumentImplementation :: Method MM.ClientToServer MM.Request + Method_TextDocumentTypeDefinition :: Method MM.ClientToServer MM.Request + Method_WorkspaceWorkspaceFolders :: Method MM.ServerToClient MM.Request + Method_WorkspaceConfiguration :: Method MM.ServerToClient MM.Request + Method_TextDocumentDocumentColor :: Method MM.ClientToServer MM.Request + Method_TextDocumentColorPresentation :: Method MM.ClientToServer MM.Request + Method_TextDocumentFoldingRange :: Method MM.ClientToServer MM.Request + Method_TextDocumentDeclaration :: Method MM.ClientToServer MM.Request + Method_TextDocumentSelectionRange :: Method MM.ClientToServer MM.Request + Method_WindowWorkDoneProgressCreate :: Method MM.ServerToClient MM.Request + Method_TextDocumentPrepareCallHierarchy :: Method MM.ClientToServer MM.Request + Method_CallHierarchyIncomingCalls :: Method MM.ClientToServer MM.Request + Method_CallHierarchyOutgoingCalls :: Method MM.ClientToServer MM.Request + Method_TextDocumentSemanticTokensFull :: Method MM.ClientToServer MM.Request + Method_TextDocumentSemanticTokensFullDelta :: Method MM.ClientToServer MM.Request + Method_TextDocumentSemanticTokensRange :: Method MM.ClientToServer MM.Request + Method_WorkspaceSemanticTokensRefresh :: Method MM.ServerToClient MM.Request + Method_WindowShowDocument :: Method MM.ServerToClient MM.Request + Method_TextDocumentLinkedEditingRange :: Method MM.ClientToServer MM.Request + Method_WorkspaceWillCreateFiles :: Method MM.ClientToServer MM.Request + Method_WorkspaceWillRenameFiles :: Method MM.ClientToServer MM.Request + Method_WorkspaceWillDeleteFiles :: Method MM.ClientToServer MM.Request + Method_TextDocumentMoniker :: Method MM.ClientToServer MM.Request + Method_TextDocumentPrepareTypeHierarchy :: Method MM.ClientToServer MM.Request + Method_TypeHierarchySupertypes :: Method MM.ClientToServer MM.Request + Method_TypeHierarchySubtypes :: Method MM.ClientToServer MM.Request + Method_TextDocumentInlineValue :: Method MM.ClientToServer MM.Request + Method_WorkspaceInlineValueRefresh :: Method MM.ServerToClient MM.Request + Method_TextDocumentInlayHint :: Method MM.ClientToServer MM.Request + Method_InlayHintResolve :: Method MM.ClientToServer MM.Request + Method_WorkspaceInlayHintRefresh :: Method MM.ServerToClient MM.Request + Method_TextDocumentDiagnostic :: Method MM.ClientToServer MM.Request + Method_WorkspaceDiagnostic :: Method MM.ClientToServer MM.Request + Method_WorkspaceDiagnosticRefresh :: Method MM.ServerToClient MM.Request + Method_ClientRegisterCapability :: Method MM.ServerToClient MM.Request + Method_ClientUnregisterCapability :: Method MM.ServerToClient MM.Request + Method_Initialize :: Method MM.ClientToServer MM.Request + Method_Shutdown :: Method MM.ClientToServer MM.Request + Method_WindowShowMessageRequest :: Method MM.ServerToClient MM.Request + Method_TextDocumentWillSaveWaitUntil :: Method MM.ClientToServer MM.Request + Method_TextDocumentCompletion :: Method MM.ClientToServer MM.Request + Method_CompletionItemResolve :: Method MM.ClientToServer MM.Request + Method_TextDocumentHover :: Method MM.ClientToServer MM.Request + Method_TextDocumentSignatureHelp :: Method MM.ClientToServer MM.Request + Method_TextDocumentDefinition :: Method MM.ClientToServer MM.Request + Method_TextDocumentReferences :: Method MM.ClientToServer MM.Request + Method_TextDocumentDocumentHighlight :: Method MM.ClientToServer MM.Request + Method_TextDocumentDocumentSymbol :: Method MM.ClientToServer MM.Request + Method_TextDocumentCodeAction :: Method MM.ClientToServer MM.Request + Method_CodeActionResolve :: Method MM.ClientToServer MM.Request + Method_WorkspaceSymbol :: Method MM.ClientToServer MM.Request + Method_WorkspaceSymbolResolve :: Method MM.ClientToServer MM.Request + Method_TextDocumentCodeLens :: Method MM.ClientToServer MM.Request + Method_CodeLensResolve :: Method MM.ClientToServer MM.Request + Method_WorkspaceCodeLensRefresh :: Method MM.ServerToClient MM.Request + Method_TextDocumentDocumentLink :: Method MM.ClientToServer MM.Request + Method_DocumentLinkResolve :: Method MM.ClientToServer MM.Request + Method_TextDocumentFormatting :: Method MM.ClientToServer MM.Request + Method_TextDocumentRangeFormatting :: Method MM.ClientToServer MM.Request + Method_TextDocumentOnTypeFormatting :: Method MM.ClientToServer MM.Request + Method_TextDocumentRename :: Method MM.ClientToServer MM.Request + Method_TextDocumentPrepareRename :: Method MM.ClientToServer MM.Request + Method_WorkspaceExecuteCommand :: Method MM.ClientToServer MM.Request + Method_WorkspaceApplyEdit :: Method MM.ServerToClient MM.Request + Method_WorkspaceDidChangeWorkspaceFolders :: Method MM.ClientToServer MM.Notification + Method_WindowWorkDoneProgressCancel :: Method MM.ClientToServer MM.Notification + Method_WorkspaceDidCreateFiles :: Method MM.ClientToServer MM.Notification + Method_WorkspaceDidRenameFiles :: Method MM.ClientToServer MM.Notification + Method_WorkspaceDidDeleteFiles :: Method MM.ClientToServer MM.Notification + Method_NotebookDocumentDidOpen :: Method MM.ClientToServer MM.Notification + Method_NotebookDocumentDidChange :: Method MM.ClientToServer MM.Notification + Method_NotebookDocumentDidSave :: Method MM.ClientToServer MM.Notification + Method_NotebookDocumentDidClose :: Method MM.ClientToServer MM.Notification + Method_Initialized :: Method MM.ClientToServer MM.Notification + Method_Exit :: Method MM.ClientToServer MM.Notification + Method_WorkspaceDidChangeConfiguration :: Method MM.ClientToServer MM.Notification + Method_WindowShowMessage :: Method MM.ServerToClient MM.Notification + Method_WindowLogMessage :: Method MM.ServerToClient MM.Notification + Method_TelemetryEvent :: Method MM.ServerToClient MM.Notification + Method_TextDocumentDidOpen :: Method MM.ClientToServer MM.Notification + Method_TextDocumentDidChange :: Method MM.ClientToServer MM.Notification + Method_TextDocumentDidClose :: Method MM.ClientToServer MM.Notification + Method_TextDocumentDidSave :: Method MM.ClientToServer MM.Notification + Method_TextDocumentWillSave :: Method MM.ClientToServer MM.Notification + Method_WorkspaceDidChangeWatchedFiles :: Method MM.ClientToServer MM.Notification + Method_TextDocumentPublishDiagnostics :: Method MM.ServerToClient MM.Notification + Method_SetTrace :: Method MM.ClientToServer MM.Notification + Method_LogTrace :: Method MM.ServerToClient MM.Notification + Method_CancelRequest :: Method f MM.Notification + Method_Progress :: Method f MM.Notification + Method_CustomMethod :: GHC.TypeLits.Symbol -> Method f t + +-- | Maps a LSP method to its parameter type. +type MessageParams :: forall f t . Method f t -> Kind.Type +type family MessageParams (m :: Method f t) where + MessageParams Method_TextDocumentImplementation = Language.LSP.Protocol.Internal.Types.ImplementationParams.ImplementationParams + MessageParams Method_TextDocumentTypeDefinition = Language.LSP.Protocol.Internal.Types.TypeDefinitionParams.TypeDefinitionParams + MessageParams Method_WorkspaceWorkspaceFolders = Maybe Data.Void.Void + MessageParams Method_WorkspaceConfiguration = Language.LSP.Protocol.Internal.Types.ConfigurationParams.ConfigurationParams + MessageParams Method_TextDocumentDocumentColor = Language.LSP.Protocol.Internal.Types.DocumentColorParams.DocumentColorParams + MessageParams Method_TextDocumentColorPresentation = Language.LSP.Protocol.Internal.Types.ColorPresentationParams.ColorPresentationParams + MessageParams Method_TextDocumentFoldingRange = Language.LSP.Protocol.Internal.Types.FoldingRangeParams.FoldingRangeParams + MessageParams Method_TextDocumentDeclaration = Language.LSP.Protocol.Internal.Types.DeclarationParams.DeclarationParams + MessageParams Method_TextDocumentSelectionRange = Language.LSP.Protocol.Internal.Types.SelectionRangeParams.SelectionRangeParams + MessageParams Method_WindowWorkDoneProgressCreate = Language.LSP.Protocol.Internal.Types.WorkDoneProgressCreateParams.WorkDoneProgressCreateParams + MessageParams Method_TextDocumentPrepareCallHierarchy = Language.LSP.Protocol.Internal.Types.CallHierarchyPrepareParams.CallHierarchyPrepareParams + MessageParams Method_CallHierarchyIncomingCalls = Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCallsParams.CallHierarchyIncomingCallsParams + MessageParams Method_CallHierarchyOutgoingCalls = Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCallsParams.CallHierarchyOutgoingCallsParams + MessageParams Method_TextDocumentSemanticTokensFull = Language.LSP.Protocol.Internal.Types.SemanticTokensParams.SemanticTokensParams + MessageParams Method_TextDocumentSemanticTokensFullDelta = Language.LSP.Protocol.Internal.Types.SemanticTokensDeltaParams.SemanticTokensDeltaParams + MessageParams Method_TextDocumentSemanticTokensRange = Language.LSP.Protocol.Internal.Types.SemanticTokensRangeParams.SemanticTokensRangeParams + MessageParams Method_WorkspaceSemanticTokensRefresh = Maybe Data.Void.Void + MessageParams Method_WindowShowDocument = Language.LSP.Protocol.Internal.Types.ShowDocumentParams.ShowDocumentParams + MessageParams Method_TextDocumentLinkedEditingRange = Language.LSP.Protocol.Internal.Types.LinkedEditingRangeParams.LinkedEditingRangeParams + MessageParams Method_WorkspaceWillCreateFiles = Language.LSP.Protocol.Internal.Types.CreateFilesParams.CreateFilesParams + MessageParams Method_WorkspaceWillRenameFiles = Language.LSP.Protocol.Internal.Types.RenameFilesParams.RenameFilesParams + MessageParams Method_WorkspaceWillDeleteFiles = Language.LSP.Protocol.Internal.Types.DeleteFilesParams.DeleteFilesParams + MessageParams Method_TextDocumentMoniker = Language.LSP.Protocol.Internal.Types.MonikerParams.MonikerParams + MessageParams Method_TextDocumentPrepareTypeHierarchy = Language.LSP.Protocol.Internal.Types.TypeHierarchyPrepareParams.TypeHierarchyPrepareParams + MessageParams Method_TypeHierarchySupertypes = Language.LSP.Protocol.Internal.Types.TypeHierarchySupertypesParams.TypeHierarchySupertypesParams + MessageParams Method_TypeHierarchySubtypes = Language.LSP.Protocol.Internal.Types.TypeHierarchySubtypesParams.TypeHierarchySubtypesParams + MessageParams Method_TextDocumentInlineValue = Language.LSP.Protocol.Internal.Types.InlineValueParams.InlineValueParams + MessageParams Method_WorkspaceInlineValueRefresh = Maybe Data.Void.Void + MessageParams Method_TextDocumentInlayHint = Language.LSP.Protocol.Internal.Types.InlayHintParams.InlayHintParams + MessageParams Method_InlayHintResolve = Language.LSP.Protocol.Internal.Types.InlayHint.InlayHint + MessageParams Method_WorkspaceInlayHintRefresh = Maybe Data.Void.Void + MessageParams Method_TextDocumentDiagnostic = Language.LSP.Protocol.Internal.Types.DocumentDiagnosticParams.DocumentDiagnosticParams + MessageParams Method_WorkspaceDiagnostic = Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticParams.WorkspaceDiagnosticParams + MessageParams Method_WorkspaceDiagnosticRefresh = Maybe Data.Void.Void + MessageParams Method_ClientRegisterCapability = Language.LSP.Protocol.Internal.Types.RegistrationParams.RegistrationParams + MessageParams Method_ClientUnregisterCapability = Language.LSP.Protocol.Internal.Types.UnregistrationParams.UnregistrationParams + MessageParams Method_Initialize = Language.LSP.Protocol.Internal.Types.InitializeParams.InitializeParams + MessageParams Method_Shutdown = Maybe Data.Void.Void + MessageParams Method_WindowShowMessageRequest = Language.LSP.Protocol.Internal.Types.ShowMessageRequestParams.ShowMessageRequestParams + MessageParams Method_TextDocumentWillSaveWaitUntil = Language.LSP.Protocol.Internal.Types.WillSaveTextDocumentParams.WillSaveTextDocumentParams + MessageParams Method_TextDocumentCompletion = Language.LSP.Protocol.Internal.Types.CompletionParams.CompletionParams + MessageParams Method_CompletionItemResolve = Language.LSP.Protocol.Internal.Types.CompletionItem.CompletionItem + MessageParams Method_TextDocumentHover = Language.LSP.Protocol.Internal.Types.HoverParams.HoverParams + MessageParams Method_TextDocumentSignatureHelp = Language.LSP.Protocol.Internal.Types.SignatureHelpParams.SignatureHelpParams + MessageParams Method_TextDocumentDefinition = Language.LSP.Protocol.Internal.Types.DefinitionParams.DefinitionParams + MessageParams Method_TextDocumentReferences = Language.LSP.Protocol.Internal.Types.ReferenceParams.ReferenceParams + MessageParams Method_TextDocumentDocumentHighlight = Language.LSP.Protocol.Internal.Types.DocumentHighlightParams.DocumentHighlightParams + MessageParams Method_TextDocumentDocumentSymbol = Language.LSP.Protocol.Internal.Types.DocumentSymbolParams.DocumentSymbolParams + MessageParams Method_TextDocumentCodeAction = Language.LSP.Protocol.Internal.Types.CodeActionParams.CodeActionParams + MessageParams Method_CodeActionResolve = Language.LSP.Protocol.Internal.Types.CodeAction.CodeAction + MessageParams Method_WorkspaceSymbol = Language.LSP.Protocol.Internal.Types.WorkspaceSymbolParams.WorkspaceSymbolParams + MessageParams Method_WorkspaceSymbolResolve = Language.LSP.Protocol.Internal.Types.WorkspaceSymbol.WorkspaceSymbol + MessageParams Method_TextDocumentCodeLens = Language.LSP.Protocol.Internal.Types.CodeLensParams.CodeLensParams + MessageParams Method_CodeLensResolve = Language.LSP.Protocol.Internal.Types.CodeLens.CodeLens + MessageParams Method_WorkspaceCodeLensRefresh = Maybe Data.Void.Void + MessageParams Method_TextDocumentDocumentLink = Language.LSP.Protocol.Internal.Types.DocumentLinkParams.DocumentLinkParams + MessageParams Method_DocumentLinkResolve = Language.LSP.Protocol.Internal.Types.DocumentLink.DocumentLink + MessageParams Method_TextDocumentFormatting = Language.LSP.Protocol.Internal.Types.DocumentFormattingParams.DocumentFormattingParams + MessageParams Method_TextDocumentRangeFormatting = Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingParams.DocumentRangeFormattingParams + MessageParams Method_TextDocumentOnTypeFormatting = Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingParams.DocumentOnTypeFormattingParams + MessageParams Method_TextDocumentRename = Language.LSP.Protocol.Internal.Types.RenameParams.RenameParams + MessageParams Method_TextDocumentPrepareRename = Language.LSP.Protocol.Internal.Types.PrepareRenameParams.PrepareRenameParams + MessageParams Method_WorkspaceExecuteCommand = Language.LSP.Protocol.Internal.Types.ExecuteCommandParams.ExecuteCommandParams + MessageParams Method_WorkspaceApplyEdit = Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditParams.ApplyWorkspaceEditParams + MessageParams Method_WorkspaceDidChangeWorkspaceFolders = Language.LSP.Protocol.Internal.Types.DidChangeWorkspaceFoldersParams.DidChangeWorkspaceFoldersParams + MessageParams Method_WindowWorkDoneProgressCancel = Language.LSP.Protocol.Internal.Types.WorkDoneProgressCancelParams.WorkDoneProgressCancelParams + MessageParams Method_WorkspaceDidCreateFiles = Language.LSP.Protocol.Internal.Types.CreateFilesParams.CreateFilesParams + MessageParams Method_WorkspaceDidRenameFiles = Language.LSP.Protocol.Internal.Types.RenameFilesParams.RenameFilesParams + MessageParams Method_WorkspaceDidDeleteFiles = Language.LSP.Protocol.Internal.Types.DeleteFilesParams.DeleteFilesParams + MessageParams Method_NotebookDocumentDidOpen = Language.LSP.Protocol.Internal.Types.DidOpenNotebookDocumentParams.DidOpenNotebookDocumentParams + MessageParams Method_NotebookDocumentDidChange = Language.LSP.Protocol.Internal.Types.DidChangeNotebookDocumentParams.DidChangeNotebookDocumentParams + MessageParams Method_NotebookDocumentDidSave = Language.LSP.Protocol.Internal.Types.DidSaveNotebookDocumentParams.DidSaveNotebookDocumentParams + MessageParams Method_NotebookDocumentDidClose = Language.LSP.Protocol.Internal.Types.DidCloseNotebookDocumentParams.DidCloseNotebookDocumentParams + MessageParams Method_Initialized = Language.LSP.Protocol.Internal.Types.InitializedParams.InitializedParams + MessageParams Method_Exit = Maybe Data.Void.Void + MessageParams Method_WorkspaceDidChangeConfiguration = Language.LSP.Protocol.Internal.Types.DidChangeConfigurationParams.DidChangeConfigurationParams + MessageParams Method_WindowShowMessage = Language.LSP.Protocol.Internal.Types.ShowMessageParams.ShowMessageParams + MessageParams Method_WindowLogMessage = Language.LSP.Protocol.Internal.Types.LogMessageParams.LogMessageParams + MessageParams Method_TelemetryEvent = Data.Aeson.Value + MessageParams Method_TextDocumentDidOpen = Language.LSP.Protocol.Internal.Types.DidOpenTextDocumentParams.DidOpenTextDocumentParams + MessageParams Method_TextDocumentDidChange = Language.LSP.Protocol.Internal.Types.DidChangeTextDocumentParams.DidChangeTextDocumentParams + MessageParams Method_TextDocumentDidClose = Language.LSP.Protocol.Internal.Types.DidCloseTextDocumentParams.DidCloseTextDocumentParams + MessageParams Method_TextDocumentDidSave = Language.LSP.Protocol.Internal.Types.DidSaveTextDocumentParams.DidSaveTextDocumentParams + MessageParams Method_TextDocumentWillSave = Language.LSP.Protocol.Internal.Types.WillSaveTextDocumentParams.WillSaveTextDocumentParams + MessageParams Method_WorkspaceDidChangeWatchedFiles = Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesParams.DidChangeWatchedFilesParams + MessageParams Method_TextDocumentPublishDiagnostics = Language.LSP.Protocol.Internal.Types.PublishDiagnosticsParams.PublishDiagnosticsParams + MessageParams Method_SetTrace = Language.LSP.Protocol.Internal.Types.SetTraceParams.SetTraceParams + MessageParams Method_LogTrace = Language.LSP.Protocol.Internal.Types.LogTraceParams.LogTraceParams + MessageParams Method_CancelRequest = Language.LSP.Protocol.Internal.Types.CancelParams.CancelParams + MessageParams Method_Progress = Language.LSP.Protocol.Internal.Types.ProgressParams.ProgressParams + MessageParams (Method_CustomMethod s) = Aeson.Value + +-- | Maps a LSP method to its result type. +type MessageResult :: forall f t . Method f t -> Kind.Type +type family MessageResult (m :: Method f t) where + MessageResult Method_TextDocumentImplementation = (Language.LSP.Protocol.Internal.Types.Definition.Definition Language.LSP.Protocol.Types.Common.|? ([Language.LSP.Protocol.Internal.Types.DefinitionLink.DefinitionLink] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + MessageResult Method_TextDocumentTypeDefinition = (Language.LSP.Protocol.Internal.Types.Definition.Definition Language.LSP.Protocol.Types.Common.|? ([Language.LSP.Protocol.Internal.Types.DefinitionLink.DefinitionLink] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + MessageResult Method_WorkspaceWorkspaceFolders = ([Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_WorkspaceConfiguration = [Data.Aeson.Value] + MessageResult Method_TextDocumentDocumentColor = [Language.LSP.Protocol.Internal.Types.ColorInformation.ColorInformation] + MessageResult Method_TextDocumentColorPresentation = [Language.LSP.Protocol.Internal.Types.ColorPresentation.ColorPresentation] + MessageResult Method_TextDocumentFoldingRange = ([Language.LSP.Protocol.Internal.Types.FoldingRange.FoldingRange] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentDeclaration = (Language.LSP.Protocol.Internal.Types.Declaration.Declaration Language.LSP.Protocol.Types.Common.|? ([Language.LSP.Protocol.Internal.Types.DeclarationLink.DeclarationLink] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + MessageResult Method_TextDocumentSelectionRange = ([Language.LSP.Protocol.Internal.Types.SelectionRange.SelectionRange] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_WindowWorkDoneProgressCreate = Language.LSP.Protocol.Types.Common.Null + MessageResult Method_TextDocumentPrepareCallHierarchy = ([Language.LSP.Protocol.Internal.Types.CallHierarchyItem.CallHierarchyItem] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_CallHierarchyIncomingCalls = ([Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCall.CallHierarchyIncomingCall] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_CallHierarchyOutgoingCalls = ([Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCall.CallHierarchyOutgoingCall] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentSemanticTokensFull = (Language.LSP.Protocol.Internal.Types.SemanticTokens.SemanticTokens Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentSemanticTokensFullDelta = (Language.LSP.Protocol.Internal.Types.SemanticTokens.SemanticTokens Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.SemanticTokensDelta.SemanticTokensDelta Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + MessageResult Method_TextDocumentSemanticTokensRange = (Language.LSP.Protocol.Internal.Types.SemanticTokens.SemanticTokens Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_WorkspaceSemanticTokensRefresh = Language.LSP.Protocol.Types.Common.Null + MessageResult Method_WindowShowDocument = Language.LSP.Protocol.Internal.Types.ShowDocumentResult.ShowDocumentResult + MessageResult Method_TextDocumentLinkedEditingRange = (Language.LSP.Protocol.Internal.Types.LinkedEditingRanges.LinkedEditingRanges Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_WorkspaceWillCreateFiles = (Language.LSP.Protocol.Internal.Types.WorkspaceEdit.WorkspaceEdit Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_WorkspaceWillRenameFiles = (Language.LSP.Protocol.Internal.Types.WorkspaceEdit.WorkspaceEdit Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_WorkspaceWillDeleteFiles = (Language.LSP.Protocol.Internal.Types.WorkspaceEdit.WorkspaceEdit Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentMoniker = ([Language.LSP.Protocol.Internal.Types.Moniker.Moniker] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentPrepareTypeHierarchy = ([Language.LSP.Protocol.Internal.Types.TypeHierarchyItem.TypeHierarchyItem] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TypeHierarchySupertypes = ([Language.LSP.Protocol.Internal.Types.TypeHierarchyItem.TypeHierarchyItem] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TypeHierarchySubtypes = ([Language.LSP.Protocol.Internal.Types.TypeHierarchyItem.TypeHierarchyItem] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentInlineValue = ([Language.LSP.Protocol.Internal.Types.InlineValue.InlineValue] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_WorkspaceInlineValueRefresh = Language.LSP.Protocol.Types.Common.Null + MessageResult Method_TextDocumentInlayHint = ([Language.LSP.Protocol.Internal.Types.InlayHint.InlayHint] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_InlayHintResolve = Language.LSP.Protocol.Internal.Types.InlayHint.InlayHint + MessageResult Method_WorkspaceInlayHintRefresh = Language.LSP.Protocol.Types.Common.Null + MessageResult Method_TextDocumentDiagnostic = Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReport.DocumentDiagnosticReport + MessageResult Method_WorkspaceDiagnostic = Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticReport.WorkspaceDiagnosticReport + MessageResult Method_WorkspaceDiagnosticRefresh = Language.LSP.Protocol.Types.Common.Null + MessageResult Method_ClientRegisterCapability = Language.LSP.Protocol.Types.Common.Null + MessageResult Method_ClientUnregisterCapability = Language.LSP.Protocol.Types.Common.Null + MessageResult Method_Initialize = Language.LSP.Protocol.Internal.Types.InitializeResult.InitializeResult + MessageResult Method_Shutdown = Language.LSP.Protocol.Types.Common.Null + MessageResult Method_WindowShowMessageRequest = (Language.LSP.Protocol.Internal.Types.MessageActionItem.MessageActionItem Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentWillSaveWaitUntil = ([Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentCompletion = ([Language.LSP.Protocol.Internal.Types.CompletionItem.CompletionItem] Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.CompletionList.CompletionList Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + MessageResult Method_CompletionItemResolve = Language.LSP.Protocol.Internal.Types.CompletionItem.CompletionItem + MessageResult Method_TextDocumentHover = (Language.LSP.Protocol.Internal.Types.Hover.Hover Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentSignatureHelp = (Language.LSP.Protocol.Internal.Types.SignatureHelp.SignatureHelp Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentDefinition = (Language.LSP.Protocol.Internal.Types.Definition.Definition Language.LSP.Protocol.Types.Common.|? ([Language.LSP.Protocol.Internal.Types.DefinitionLink.DefinitionLink] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + MessageResult Method_TextDocumentReferences = ([Language.LSP.Protocol.Internal.Types.Location.Location] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentDocumentHighlight = ([Language.LSP.Protocol.Internal.Types.DocumentHighlight.DocumentHighlight] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentDocumentSymbol = ([Language.LSP.Protocol.Internal.Types.SymbolInformation.SymbolInformation] Language.LSP.Protocol.Types.Common.|? ([Language.LSP.Protocol.Internal.Types.DocumentSymbol.DocumentSymbol] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + MessageResult Method_TextDocumentCodeAction = ([(Language.LSP.Protocol.Internal.Types.Command.Command Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.CodeAction.CodeAction)] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_CodeActionResolve = Language.LSP.Protocol.Internal.Types.CodeAction.CodeAction + MessageResult Method_WorkspaceSymbol = ([Language.LSP.Protocol.Internal.Types.SymbolInformation.SymbolInformation] Language.LSP.Protocol.Types.Common.|? ([Language.LSP.Protocol.Internal.Types.WorkspaceSymbol.WorkspaceSymbol] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + MessageResult Method_WorkspaceSymbolResolve = Language.LSP.Protocol.Internal.Types.WorkspaceSymbol.WorkspaceSymbol + MessageResult Method_TextDocumentCodeLens = ([Language.LSP.Protocol.Internal.Types.CodeLens.CodeLens] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_CodeLensResolve = Language.LSP.Protocol.Internal.Types.CodeLens.CodeLens + MessageResult Method_WorkspaceCodeLensRefresh = Language.LSP.Protocol.Types.Common.Null + MessageResult Method_TextDocumentDocumentLink = ([Language.LSP.Protocol.Internal.Types.DocumentLink.DocumentLink] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_DocumentLinkResolve = Language.LSP.Protocol.Internal.Types.DocumentLink.DocumentLink + MessageResult Method_TextDocumentFormatting = ([Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentRangeFormatting = ([Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentOnTypeFormatting = ([Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentRename = (Language.LSP.Protocol.Internal.Types.WorkspaceEdit.WorkspaceEdit Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_TextDocumentPrepareRename = (Language.LSP.Protocol.Internal.Types.PrepareRenameResult.PrepareRenameResult Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_WorkspaceExecuteCommand = (Data.Aeson.Value Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + MessageResult Method_WorkspaceApplyEdit = Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditResult.ApplyWorkspaceEditResult + MessageResult (Method_CustomMethod s) = Aeson.Value + +-- | Maps a LSP method to its error data type. +type ErrorData :: forall f t . Method f t -> Kind.Type +type family ErrorData (m :: Method f t) where + ErrorData Method_TextDocumentImplementation = Maybe Data.Void.Void + ErrorData Method_TextDocumentTypeDefinition = Maybe Data.Void.Void + ErrorData Method_WorkspaceWorkspaceFolders = Maybe Data.Void.Void + ErrorData Method_WorkspaceConfiguration = Maybe Data.Void.Void + ErrorData Method_TextDocumentDocumentColor = Maybe Data.Void.Void + ErrorData Method_TextDocumentColorPresentation = Maybe Data.Void.Void + ErrorData Method_TextDocumentFoldingRange = Maybe Data.Void.Void + ErrorData Method_TextDocumentDeclaration = Maybe Data.Void.Void + ErrorData Method_TextDocumentSelectionRange = Maybe Data.Void.Void + ErrorData Method_WindowWorkDoneProgressCreate = Maybe Data.Void.Void + ErrorData Method_TextDocumentPrepareCallHierarchy = Maybe Data.Void.Void + ErrorData Method_CallHierarchyIncomingCalls = Maybe Data.Void.Void + ErrorData Method_CallHierarchyOutgoingCalls = Maybe Data.Void.Void + ErrorData Method_TextDocumentSemanticTokensFull = Maybe Data.Void.Void + ErrorData Method_TextDocumentSemanticTokensFullDelta = Maybe Data.Void.Void + ErrorData Method_TextDocumentSemanticTokensRange = Maybe Data.Void.Void + ErrorData Method_WorkspaceSemanticTokensRefresh = Maybe Data.Void.Void + ErrorData Method_WindowShowDocument = Maybe Data.Void.Void + ErrorData Method_TextDocumentLinkedEditingRange = Maybe Data.Void.Void + ErrorData Method_WorkspaceWillCreateFiles = Maybe Data.Void.Void + ErrorData Method_WorkspaceWillRenameFiles = Maybe Data.Void.Void + ErrorData Method_WorkspaceWillDeleteFiles = Maybe Data.Void.Void + ErrorData Method_TextDocumentMoniker = Maybe Data.Void.Void + ErrorData Method_TextDocumentPrepareTypeHierarchy = Maybe Data.Void.Void + ErrorData Method_TypeHierarchySupertypes = Maybe Data.Void.Void + ErrorData Method_TypeHierarchySubtypes = Maybe Data.Void.Void + ErrorData Method_TextDocumentInlineValue = Maybe Data.Void.Void + ErrorData Method_WorkspaceInlineValueRefresh = Maybe Data.Void.Void + ErrorData Method_TextDocumentInlayHint = Maybe Data.Void.Void + ErrorData Method_InlayHintResolve = Maybe Data.Void.Void + ErrorData Method_WorkspaceInlayHintRefresh = Maybe Data.Void.Void + ErrorData Method_TextDocumentDiagnostic = Language.LSP.Protocol.Internal.Types.DiagnosticServerCancellationData.DiagnosticServerCancellationData + ErrorData Method_WorkspaceDiagnostic = Language.LSP.Protocol.Internal.Types.DiagnosticServerCancellationData.DiagnosticServerCancellationData + ErrorData Method_WorkspaceDiagnosticRefresh = Maybe Data.Void.Void + ErrorData Method_ClientRegisterCapability = Maybe Data.Void.Void + ErrorData Method_ClientUnregisterCapability = Maybe Data.Void.Void + ErrorData Method_Initialize = Language.LSP.Protocol.Internal.Types.InitializeError.InitializeError + ErrorData Method_Shutdown = Maybe Data.Void.Void + ErrorData Method_WindowShowMessageRequest = Maybe Data.Void.Void + ErrorData Method_TextDocumentWillSaveWaitUntil = Maybe Data.Void.Void + ErrorData Method_TextDocumentCompletion = Maybe Data.Void.Void + ErrorData Method_CompletionItemResolve = Maybe Data.Void.Void + ErrorData Method_TextDocumentHover = Maybe Data.Void.Void + ErrorData Method_TextDocumentSignatureHelp = Maybe Data.Void.Void + ErrorData Method_TextDocumentDefinition = Maybe Data.Void.Void + ErrorData Method_TextDocumentReferences = Maybe Data.Void.Void + ErrorData Method_TextDocumentDocumentHighlight = Maybe Data.Void.Void + ErrorData Method_TextDocumentDocumentSymbol = Maybe Data.Void.Void + ErrorData Method_TextDocumentCodeAction = Maybe Data.Void.Void + ErrorData Method_CodeActionResolve = Maybe Data.Void.Void + ErrorData Method_WorkspaceSymbol = Maybe Data.Void.Void + ErrorData Method_WorkspaceSymbolResolve = Maybe Data.Void.Void + ErrorData Method_TextDocumentCodeLens = Maybe Data.Void.Void + ErrorData Method_CodeLensResolve = Maybe Data.Void.Void + ErrorData Method_WorkspaceCodeLensRefresh = Maybe Data.Void.Void + ErrorData Method_TextDocumentDocumentLink = Maybe Data.Void.Void + ErrorData Method_DocumentLinkResolve = Maybe Data.Void.Void + ErrorData Method_TextDocumentFormatting = Maybe Data.Void.Void + ErrorData Method_TextDocumentRangeFormatting = Maybe Data.Void.Void + ErrorData Method_TextDocumentOnTypeFormatting = Maybe Data.Void.Void + ErrorData Method_TextDocumentRename = Maybe Data.Void.Void + ErrorData Method_TextDocumentPrepareRename = Maybe Data.Void.Void + ErrorData Method_WorkspaceExecuteCommand = Maybe Data.Void.Void + ErrorData Method_WorkspaceApplyEdit = Maybe Data.Void.Void + ErrorData (Method_CustomMethod s) = Aeson.Value + +-- | Maps a LSP method to its registration options type. +type RegistrationOptions :: forall f t . Method f t -> Kind.Type +type family RegistrationOptions (m :: Method f t) where + RegistrationOptions Method_TextDocumentImplementation = Language.LSP.Protocol.Internal.Types.ImplementationRegistrationOptions.ImplementationRegistrationOptions + RegistrationOptions Method_TextDocumentTypeDefinition = Language.LSP.Protocol.Internal.Types.TypeDefinitionRegistrationOptions.TypeDefinitionRegistrationOptions + RegistrationOptions Method_WorkspaceWorkspaceFolders = Maybe Data.Void.Void + RegistrationOptions Method_WorkspaceConfiguration = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentDocumentColor = Language.LSP.Protocol.Internal.Types.DocumentColorRegistrationOptions.DocumentColorRegistrationOptions + RegistrationOptions Method_TextDocumentColorPresentation = (Row.Rec ("workDoneProgress" Row..== (Maybe Bool) Row..+ ("documentSelector" Row..== (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) Row..+ Row.Empty))) + RegistrationOptions Method_TextDocumentFoldingRange = Language.LSP.Protocol.Internal.Types.FoldingRangeRegistrationOptions.FoldingRangeRegistrationOptions + RegistrationOptions Method_TextDocumentDeclaration = Language.LSP.Protocol.Internal.Types.DeclarationRegistrationOptions.DeclarationRegistrationOptions + RegistrationOptions Method_TextDocumentSelectionRange = Language.LSP.Protocol.Internal.Types.SelectionRangeRegistrationOptions.SelectionRangeRegistrationOptions + RegistrationOptions Method_WindowWorkDoneProgressCreate = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentPrepareCallHierarchy = Language.LSP.Protocol.Internal.Types.CallHierarchyRegistrationOptions.CallHierarchyRegistrationOptions + RegistrationOptions Method_CallHierarchyIncomingCalls = Maybe Data.Void.Void + RegistrationOptions Method_CallHierarchyOutgoingCalls = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentSemanticTokensFull = Language.LSP.Protocol.Internal.Types.SemanticTokensRegistrationOptions.SemanticTokensRegistrationOptions + RegistrationOptions Method_TextDocumentSemanticTokensFullDelta = Language.LSP.Protocol.Internal.Types.SemanticTokensRegistrationOptions.SemanticTokensRegistrationOptions + RegistrationOptions Method_TextDocumentSemanticTokensRange = Maybe Data.Void.Void + RegistrationOptions Method_WorkspaceSemanticTokensRefresh = Maybe Data.Void.Void + RegistrationOptions Method_WindowShowDocument = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentLinkedEditingRange = Language.LSP.Protocol.Internal.Types.LinkedEditingRangeRegistrationOptions.LinkedEditingRangeRegistrationOptions + RegistrationOptions Method_WorkspaceWillCreateFiles = Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions + RegistrationOptions Method_WorkspaceWillRenameFiles = Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions + RegistrationOptions Method_WorkspaceWillDeleteFiles = Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions + RegistrationOptions Method_TextDocumentMoniker = Language.LSP.Protocol.Internal.Types.MonikerRegistrationOptions.MonikerRegistrationOptions + RegistrationOptions Method_TextDocumentPrepareTypeHierarchy = Language.LSP.Protocol.Internal.Types.TypeHierarchyRegistrationOptions.TypeHierarchyRegistrationOptions + RegistrationOptions Method_TypeHierarchySupertypes = Maybe Data.Void.Void + RegistrationOptions Method_TypeHierarchySubtypes = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentInlineValue = Language.LSP.Protocol.Internal.Types.InlineValueRegistrationOptions.InlineValueRegistrationOptions + RegistrationOptions Method_WorkspaceInlineValueRefresh = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentInlayHint = Language.LSP.Protocol.Internal.Types.InlayHintRegistrationOptions.InlayHintRegistrationOptions + RegistrationOptions Method_InlayHintResolve = Maybe Data.Void.Void + RegistrationOptions Method_WorkspaceInlayHintRefresh = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentDiagnostic = Language.LSP.Protocol.Internal.Types.DiagnosticRegistrationOptions.DiagnosticRegistrationOptions + RegistrationOptions Method_WorkspaceDiagnostic = Maybe Data.Void.Void + RegistrationOptions Method_WorkspaceDiagnosticRefresh = Maybe Data.Void.Void + RegistrationOptions Method_ClientRegisterCapability = Maybe Data.Void.Void + RegistrationOptions Method_ClientUnregisterCapability = Maybe Data.Void.Void + RegistrationOptions Method_Initialize = Maybe Data.Void.Void + RegistrationOptions Method_Shutdown = Maybe Data.Void.Void + RegistrationOptions Method_WindowShowMessageRequest = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentWillSaveWaitUntil = Language.LSP.Protocol.Internal.Types.TextDocumentRegistrationOptions.TextDocumentRegistrationOptions + RegistrationOptions Method_TextDocumentCompletion = Language.LSP.Protocol.Internal.Types.CompletionRegistrationOptions.CompletionRegistrationOptions + RegistrationOptions Method_CompletionItemResolve = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentHover = Language.LSP.Protocol.Internal.Types.HoverRegistrationOptions.HoverRegistrationOptions + RegistrationOptions Method_TextDocumentSignatureHelp = Language.LSP.Protocol.Internal.Types.SignatureHelpRegistrationOptions.SignatureHelpRegistrationOptions + RegistrationOptions Method_TextDocumentDefinition = Language.LSP.Protocol.Internal.Types.DefinitionRegistrationOptions.DefinitionRegistrationOptions + RegistrationOptions Method_TextDocumentReferences = Language.LSP.Protocol.Internal.Types.ReferenceRegistrationOptions.ReferenceRegistrationOptions + RegistrationOptions Method_TextDocumentDocumentHighlight = Language.LSP.Protocol.Internal.Types.DocumentHighlightRegistrationOptions.DocumentHighlightRegistrationOptions + RegistrationOptions Method_TextDocumentDocumentSymbol = Language.LSP.Protocol.Internal.Types.DocumentSymbolRegistrationOptions.DocumentSymbolRegistrationOptions + RegistrationOptions Method_TextDocumentCodeAction = Language.LSP.Protocol.Internal.Types.CodeActionRegistrationOptions.CodeActionRegistrationOptions + RegistrationOptions Method_CodeActionResolve = Maybe Data.Void.Void + RegistrationOptions Method_WorkspaceSymbol = Language.LSP.Protocol.Internal.Types.WorkspaceSymbolRegistrationOptions.WorkspaceSymbolRegistrationOptions + RegistrationOptions Method_WorkspaceSymbolResolve = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentCodeLens = Language.LSP.Protocol.Internal.Types.CodeLensRegistrationOptions.CodeLensRegistrationOptions + RegistrationOptions Method_CodeLensResolve = Maybe Data.Void.Void + RegistrationOptions Method_WorkspaceCodeLensRefresh = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentDocumentLink = Language.LSP.Protocol.Internal.Types.DocumentLinkRegistrationOptions.DocumentLinkRegistrationOptions + RegistrationOptions Method_DocumentLinkResolve = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentFormatting = Language.LSP.Protocol.Internal.Types.DocumentFormattingRegistrationOptions.DocumentFormattingRegistrationOptions + RegistrationOptions Method_TextDocumentRangeFormatting = Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingRegistrationOptions.DocumentRangeFormattingRegistrationOptions + RegistrationOptions Method_TextDocumentOnTypeFormatting = Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingRegistrationOptions.DocumentOnTypeFormattingRegistrationOptions + RegistrationOptions Method_TextDocumentRename = Language.LSP.Protocol.Internal.Types.RenameRegistrationOptions.RenameRegistrationOptions + RegistrationOptions Method_TextDocumentPrepareRename = Maybe Data.Void.Void + RegistrationOptions Method_WorkspaceExecuteCommand = Language.LSP.Protocol.Internal.Types.ExecuteCommandRegistrationOptions.ExecuteCommandRegistrationOptions + RegistrationOptions Method_WorkspaceApplyEdit = Maybe Data.Void.Void + RegistrationOptions Method_WorkspaceDidChangeWorkspaceFolders = Maybe Data.Void.Void + RegistrationOptions Method_WindowWorkDoneProgressCancel = Maybe Data.Void.Void + RegistrationOptions Method_WorkspaceDidCreateFiles = Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions + RegistrationOptions Method_WorkspaceDidRenameFiles = Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions + RegistrationOptions Method_WorkspaceDidDeleteFiles = Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions + RegistrationOptions Method_NotebookDocumentDidOpen = Maybe Data.Void.Void + RegistrationOptions Method_NotebookDocumentDidChange = Maybe Data.Void.Void + RegistrationOptions Method_NotebookDocumentDidSave = Maybe Data.Void.Void + RegistrationOptions Method_NotebookDocumentDidClose = Maybe Data.Void.Void + RegistrationOptions Method_Initialized = Maybe Data.Void.Void + RegistrationOptions Method_Exit = Maybe Data.Void.Void + RegistrationOptions Method_WorkspaceDidChangeConfiguration = Language.LSP.Protocol.Internal.Types.DidChangeConfigurationRegistrationOptions.DidChangeConfigurationRegistrationOptions + RegistrationOptions Method_WindowShowMessage = Maybe Data.Void.Void + RegistrationOptions Method_WindowLogMessage = Maybe Data.Void.Void + RegistrationOptions Method_TelemetryEvent = Maybe Data.Void.Void + RegistrationOptions Method_TextDocumentDidOpen = Language.LSP.Protocol.Internal.Types.TextDocumentRegistrationOptions.TextDocumentRegistrationOptions + RegistrationOptions Method_TextDocumentDidChange = Language.LSP.Protocol.Internal.Types.TextDocumentChangeRegistrationOptions.TextDocumentChangeRegistrationOptions + RegistrationOptions Method_TextDocumentDidClose = Language.LSP.Protocol.Internal.Types.TextDocumentRegistrationOptions.TextDocumentRegistrationOptions + RegistrationOptions Method_TextDocumentDidSave = Language.LSP.Protocol.Internal.Types.TextDocumentSaveRegistrationOptions.TextDocumentSaveRegistrationOptions + RegistrationOptions Method_TextDocumentWillSave = Language.LSP.Protocol.Internal.Types.TextDocumentRegistrationOptions.TextDocumentRegistrationOptions + RegistrationOptions Method_WorkspaceDidChangeWatchedFiles = Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesRegistrationOptions.DidChangeWatchedFilesRegistrationOptions + RegistrationOptions Method_TextDocumentPublishDiagnostics = Maybe Data.Void.Void + RegistrationOptions Method_SetTrace = Maybe Data.Void.Void + RegistrationOptions Method_LogTrace = Maybe Data.Void.Void + RegistrationOptions Method_CancelRequest = Maybe Data.Void.Void + RegistrationOptions Method_Progress = Maybe Data.Void.Void + RegistrationOptions (Method_CustomMethod s) = Data.Void.Void + +-- | A singleton type for 'Method'. +type SMethod :: forall f t . Method f t -> Kind.Type +data SMethod m where + SMethod_TextDocumentImplementation :: SMethod Method_TextDocumentImplementation + SMethod_TextDocumentTypeDefinition :: SMethod Method_TextDocumentTypeDefinition + SMethod_WorkspaceWorkspaceFolders :: SMethod Method_WorkspaceWorkspaceFolders + SMethod_WorkspaceConfiguration :: SMethod Method_WorkspaceConfiguration + SMethod_TextDocumentDocumentColor :: SMethod Method_TextDocumentDocumentColor + SMethod_TextDocumentColorPresentation :: SMethod Method_TextDocumentColorPresentation + SMethod_TextDocumentFoldingRange :: SMethod Method_TextDocumentFoldingRange + SMethod_TextDocumentDeclaration :: SMethod Method_TextDocumentDeclaration + SMethod_TextDocumentSelectionRange :: SMethod Method_TextDocumentSelectionRange + SMethod_WindowWorkDoneProgressCreate :: SMethod Method_WindowWorkDoneProgressCreate + SMethod_TextDocumentPrepareCallHierarchy :: SMethod Method_TextDocumentPrepareCallHierarchy + SMethod_CallHierarchyIncomingCalls :: SMethod Method_CallHierarchyIncomingCalls + SMethod_CallHierarchyOutgoingCalls :: SMethod Method_CallHierarchyOutgoingCalls + SMethod_TextDocumentSemanticTokensFull :: SMethod Method_TextDocumentSemanticTokensFull + SMethod_TextDocumentSemanticTokensFullDelta :: SMethod Method_TextDocumentSemanticTokensFullDelta + SMethod_TextDocumentSemanticTokensRange :: SMethod Method_TextDocumentSemanticTokensRange + SMethod_WorkspaceSemanticTokensRefresh :: SMethod Method_WorkspaceSemanticTokensRefresh + SMethod_WindowShowDocument :: SMethod Method_WindowShowDocument + SMethod_TextDocumentLinkedEditingRange :: SMethod Method_TextDocumentLinkedEditingRange + SMethod_WorkspaceWillCreateFiles :: SMethod Method_WorkspaceWillCreateFiles + SMethod_WorkspaceWillRenameFiles :: SMethod Method_WorkspaceWillRenameFiles + SMethod_WorkspaceWillDeleteFiles :: SMethod Method_WorkspaceWillDeleteFiles + SMethod_TextDocumentMoniker :: SMethod Method_TextDocumentMoniker + SMethod_TextDocumentPrepareTypeHierarchy :: SMethod Method_TextDocumentPrepareTypeHierarchy + SMethod_TypeHierarchySupertypes :: SMethod Method_TypeHierarchySupertypes + SMethod_TypeHierarchySubtypes :: SMethod Method_TypeHierarchySubtypes + SMethod_TextDocumentInlineValue :: SMethod Method_TextDocumentInlineValue + SMethod_WorkspaceInlineValueRefresh :: SMethod Method_WorkspaceInlineValueRefresh + SMethod_TextDocumentInlayHint :: SMethod Method_TextDocumentInlayHint + SMethod_InlayHintResolve :: SMethod Method_InlayHintResolve + SMethod_WorkspaceInlayHintRefresh :: SMethod Method_WorkspaceInlayHintRefresh + SMethod_TextDocumentDiagnostic :: SMethod Method_TextDocumentDiagnostic + SMethod_WorkspaceDiagnostic :: SMethod Method_WorkspaceDiagnostic + SMethod_WorkspaceDiagnosticRefresh :: SMethod Method_WorkspaceDiagnosticRefresh + SMethod_ClientRegisterCapability :: SMethod Method_ClientRegisterCapability + SMethod_ClientUnregisterCapability :: SMethod Method_ClientUnregisterCapability + SMethod_Initialize :: SMethod Method_Initialize + SMethod_Shutdown :: SMethod Method_Shutdown + SMethod_WindowShowMessageRequest :: SMethod Method_WindowShowMessageRequest + SMethod_TextDocumentWillSaveWaitUntil :: SMethod Method_TextDocumentWillSaveWaitUntil + SMethod_TextDocumentCompletion :: SMethod Method_TextDocumentCompletion + SMethod_CompletionItemResolve :: SMethod Method_CompletionItemResolve + SMethod_TextDocumentHover :: SMethod Method_TextDocumentHover + SMethod_TextDocumentSignatureHelp :: SMethod Method_TextDocumentSignatureHelp + SMethod_TextDocumentDefinition :: SMethod Method_TextDocumentDefinition + SMethod_TextDocumentReferences :: SMethod Method_TextDocumentReferences + SMethod_TextDocumentDocumentHighlight :: SMethod Method_TextDocumentDocumentHighlight + SMethod_TextDocumentDocumentSymbol :: SMethod Method_TextDocumentDocumentSymbol + SMethod_TextDocumentCodeAction :: SMethod Method_TextDocumentCodeAction + SMethod_CodeActionResolve :: SMethod Method_CodeActionResolve + SMethod_WorkspaceSymbol :: SMethod Method_WorkspaceSymbol + SMethod_WorkspaceSymbolResolve :: SMethod Method_WorkspaceSymbolResolve + SMethod_TextDocumentCodeLens :: SMethod Method_TextDocumentCodeLens + SMethod_CodeLensResolve :: SMethod Method_CodeLensResolve + SMethod_WorkspaceCodeLensRefresh :: SMethod Method_WorkspaceCodeLensRefresh + SMethod_TextDocumentDocumentLink :: SMethod Method_TextDocumentDocumentLink + SMethod_DocumentLinkResolve :: SMethod Method_DocumentLinkResolve + SMethod_TextDocumentFormatting :: SMethod Method_TextDocumentFormatting + SMethod_TextDocumentRangeFormatting :: SMethod Method_TextDocumentRangeFormatting + SMethod_TextDocumentOnTypeFormatting :: SMethod Method_TextDocumentOnTypeFormatting + SMethod_TextDocumentRename :: SMethod Method_TextDocumentRename + SMethod_TextDocumentPrepareRename :: SMethod Method_TextDocumentPrepareRename + SMethod_WorkspaceExecuteCommand :: SMethod Method_WorkspaceExecuteCommand + SMethod_WorkspaceApplyEdit :: SMethod Method_WorkspaceApplyEdit + SMethod_WorkspaceDidChangeWorkspaceFolders :: SMethod Method_WorkspaceDidChangeWorkspaceFolders + SMethod_WindowWorkDoneProgressCancel :: SMethod Method_WindowWorkDoneProgressCancel + SMethod_WorkspaceDidCreateFiles :: SMethod Method_WorkspaceDidCreateFiles + SMethod_WorkspaceDidRenameFiles :: SMethod Method_WorkspaceDidRenameFiles + SMethod_WorkspaceDidDeleteFiles :: SMethod Method_WorkspaceDidDeleteFiles + SMethod_NotebookDocumentDidOpen :: SMethod Method_NotebookDocumentDidOpen + SMethod_NotebookDocumentDidChange :: SMethod Method_NotebookDocumentDidChange + SMethod_NotebookDocumentDidSave :: SMethod Method_NotebookDocumentDidSave + SMethod_NotebookDocumentDidClose :: SMethod Method_NotebookDocumentDidClose + SMethod_Initialized :: SMethod Method_Initialized + SMethod_Exit :: SMethod Method_Exit + SMethod_WorkspaceDidChangeConfiguration :: SMethod Method_WorkspaceDidChangeConfiguration + SMethod_WindowShowMessage :: SMethod Method_WindowShowMessage + SMethod_WindowLogMessage :: SMethod Method_WindowLogMessage + SMethod_TelemetryEvent :: SMethod Method_TelemetryEvent + SMethod_TextDocumentDidOpen :: SMethod Method_TextDocumentDidOpen + SMethod_TextDocumentDidChange :: SMethod Method_TextDocumentDidChange + SMethod_TextDocumentDidClose :: SMethod Method_TextDocumentDidClose + SMethod_TextDocumentDidSave :: SMethod Method_TextDocumentDidSave + SMethod_TextDocumentWillSave :: SMethod Method_TextDocumentWillSave + SMethod_WorkspaceDidChangeWatchedFiles :: SMethod Method_WorkspaceDidChangeWatchedFiles + SMethod_TextDocumentPublishDiagnostics :: SMethod Method_TextDocumentPublishDiagnostics + SMethod_SetTrace :: SMethod Method_SetTrace + SMethod_LogTrace :: SMethod Method_LogTrace + SMethod_CancelRequest :: SMethod Method_CancelRequest + SMethod_Progress :: SMethod Method_Progress + SMethod_CustomMethod :: forall s . GHC.TypeLits.KnownSymbol s => Data.Proxy.Proxy s -> SMethod (Method_CustomMethod s) + +-- | A method which isn't statically known. +data SomeMethod where + SomeMethod :: forall m . SMethod m -> SomeMethod + +-- | Turn a 'SomeMethod' into its LSP method string. +someMethodToMethodString :: SomeMethod -> String +someMethodToMethodString (SomeMethod SMethod_TextDocumentImplementation) = "textDocument/implementation" +someMethodToMethodString (SomeMethod SMethod_TextDocumentTypeDefinition) = "textDocument/typeDefinition" +someMethodToMethodString (SomeMethod SMethod_WorkspaceWorkspaceFolders) = "workspace/workspaceFolders" +someMethodToMethodString (SomeMethod SMethod_WorkspaceConfiguration) = "workspace/configuration" +someMethodToMethodString (SomeMethod SMethod_TextDocumentDocumentColor) = "textDocument/documentColor" +someMethodToMethodString (SomeMethod SMethod_TextDocumentColorPresentation) = "textDocument/colorPresentation" +someMethodToMethodString (SomeMethod SMethod_TextDocumentFoldingRange) = "textDocument/foldingRange" +someMethodToMethodString (SomeMethod SMethod_TextDocumentDeclaration) = "textDocument/declaration" +someMethodToMethodString (SomeMethod SMethod_TextDocumentSelectionRange) = "textDocument/selectionRange" +someMethodToMethodString (SomeMethod SMethod_WindowWorkDoneProgressCreate) = "window/workDoneProgress/create" +someMethodToMethodString (SomeMethod SMethod_TextDocumentPrepareCallHierarchy) = "textDocument/prepareCallHierarchy" +someMethodToMethodString (SomeMethod SMethod_CallHierarchyIncomingCalls) = "callHierarchy/incomingCalls" +someMethodToMethodString (SomeMethod SMethod_CallHierarchyOutgoingCalls) = "callHierarchy/outgoingCalls" +someMethodToMethodString (SomeMethod SMethod_TextDocumentSemanticTokensFull) = "textDocument/semanticTokens/full" +someMethodToMethodString (SomeMethod SMethod_TextDocumentSemanticTokensFullDelta) = "textDocument/semanticTokens/full/delta" +someMethodToMethodString (SomeMethod SMethod_TextDocumentSemanticTokensRange) = "textDocument/semanticTokens/range" +someMethodToMethodString (SomeMethod SMethod_WorkspaceSemanticTokensRefresh) = "workspace/semanticTokens/refresh" +someMethodToMethodString (SomeMethod SMethod_WindowShowDocument) = "window/showDocument" +someMethodToMethodString (SomeMethod SMethod_TextDocumentLinkedEditingRange) = "textDocument/linkedEditingRange" +someMethodToMethodString (SomeMethod SMethod_WorkspaceWillCreateFiles) = "workspace/willCreateFiles" +someMethodToMethodString (SomeMethod SMethod_WorkspaceWillRenameFiles) = "workspace/willRenameFiles" +someMethodToMethodString (SomeMethod SMethod_WorkspaceWillDeleteFiles) = "workspace/willDeleteFiles" +someMethodToMethodString (SomeMethod SMethod_TextDocumentMoniker) = "textDocument/moniker" +someMethodToMethodString (SomeMethod SMethod_TextDocumentPrepareTypeHierarchy) = "textDocument/prepareTypeHierarchy" +someMethodToMethodString (SomeMethod SMethod_TypeHierarchySupertypes) = "typeHierarchy/supertypes" +someMethodToMethodString (SomeMethod SMethod_TypeHierarchySubtypes) = "typeHierarchy/subtypes" +someMethodToMethodString (SomeMethod SMethod_TextDocumentInlineValue) = "textDocument/inlineValue" +someMethodToMethodString (SomeMethod SMethod_WorkspaceInlineValueRefresh) = "workspace/inlineValue/refresh" +someMethodToMethodString (SomeMethod SMethod_TextDocumentInlayHint) = "textDocument/inlayHint" +someMethodToMethodString (SomeMethod SMethod_InlayHintResolve) = "inlayHint/resolve" +someMethodToMethodString (SomeMethod SMethod_WorkspaceInlayHintRefresh) = "workspace/inlayHint/refresh" +someMethodToMethodString (SomeMethod SMethod_TextDocumentDiagnostic) = "textDocument/diagnostic" +someMethodToMethodString (SomeMethod SMethod_WorkspaceDiagnostic) = "workspace/diagnostic" +someMethodToMethodString (SomeMethod SMethod_WorkspaceDiagnosticRefresh) = "workspace/diagnostic/refresh" +someMethodToMethodString (SomeMethod SMethod_ClientRegisterCapability) = "client/registerCapability" +someMethodToMethodString (SomeMethod SMethod_ClientUnregisterCapability) = "client/unregisterCapability" +someMethodToMethodString (SomeMethod SMethod_Initialize) = "initialize" +someMethodToMethodString (SomeMethod SMethod_Shutdown) = "shutdown" +someMethodToMethodString (SomeMethod SMethod_WindowShowMessageRequest) = "window/showMessageRequest" +someMethodToMethodString (SomeMethod SMethod_TextDocumentWillSaveWaitUntil) = "textDocument/willSaveWaitUntil" +someMethodToMethodString (SomeMethod SMethod_TextDocumentCompletion) = "textDocument/completion" +someMethodToMethodString (SomeMethod SMethod_CompletionItemResolve) = "completionItem/resolve" +someMethodToMethodString (SomeMethod SMethod_TextDocumentHover) = "textDocument/hover" +someMethodToMethodString (SomeMethod SMethod_TextDocumentSignatureHelp) = "textDocument/signatureHelp" +someMethodToMethodString (SomeMethod SMethod_TextDocumentDefinition) = "textDocument/definition" +someMethodToMethodString (SomeMethod SMethod_TextDocumentReferences) = "textDocument/references" +someMethodToMethodString (SomeMethod SMethod_TextDocumentDocumentHighlight) = "textDocument/documentHighlight" +someMethodToMethodString (SomeMethod SMethod_TextDocumentDocumentSymbol) = "textDocument/documentSymbol" +someMethodToMethodString (SomeMethod SMethod_TextDocumentCodeAction) = "textDocument/codeAction" +someMethodToMethodString (SomeMethod SMethod_CodeActionResolve) = "codeAction/resolve" +someMethodToMethodString (SomeMethod SMethod_WorkspaceSymbol) = "workspace/symbol" +someMethodToMethodString (SomeMethod SMethod_WorkspaceSymbolResolve) = "workspaceSymbol/resolve" +someMethodToMethodString (SomeMethod SMethod_TextDocumentCodeLens) = "textDocument/codeLens" +someMethodToMethodString (SomeMethod SMethod_CodeLensResolve) = "codeLens/resolve" +someMethodToMethodString (SomeMethod SMethod_WorkspaceCodeLensRefresh) = "workspace/codeLens/refresh" +someMethodToMethodString (SomeMethod SMethod_TextDocumentDocumentLink) = "textDocument/documentLink" +someMethodToMethodString (SomeMethod SMethod_DocumentLinkResolve) = "documentLink/resolve" +someMethodToMethodString (SomeMethod SMethod_TextDocumentFormatting) = "textDocument/formatting" +someMethodToMethodString (SomeMethod SMethod_TextDocumentRangeFormatting) = "textDocument/rangeFormatting" +someMethodToMethodString (SomeMethod SMethod_TextDocumentOnTypeFormatting) = "textDocument/onTypeFormatting" +someMethodToMethodString (SomeMethod SMethod_TextDocumentRename) = "textDocument/rename" +someMethodToMethodString (SomeMethod SMethod_TextDocumentPrepareRename) = "textDocument/prepareRename" +someMethodToMethodString (SomeMethod SMethod_WorkspaceExecuteCommand) = "workspace/executeCommand" +someMethodToMethodString (SomeMethod SMethod_WorkspaceApplyEdit) = "workspace/applyEdit" +someMethodToMethodString (SomeMethod SMethod_WorkspaceDidChangeWorkspaceFolders) = "workspace/didChangeWorkspaceFolders" +someMethodToMethodString (SomeMethod SMethod_WindowWorkDoneProgressCancel) = "window/workDoneProgress/cancel" +someMethodToMethodString (SomeMethod SMethod_WorkspaceDidCreateFiles) = "workspace/didCreateFiles" +someMethodToMethodString (SomeMethod SMethod_WorkspaceDidRenameFiles) = "workspace/didRenameFiles" +someMethodToMethodString (SomeMethod SMethod_WorkspaceDidDeleteFiles) = "workspace/didDeleteFiles" +someMethodToMethodString (SomeMethod SMethod_NotebookDocumentDidOpen) = "notebookDocument/didOpen" +someMethodToMethodString (SomeMethod SMethod_NotebookDocumentDidChange) = "notebookDocument/didChange" +someMethodToMethodString (SomeMethod SMethod_NotebookDocumentDidSave) = "notebookDocument/didSave" +someMethodToMethodString (SomeMethod SMethod_NotebookDocumentDidClose) = "notebookDocument/didClose" +someMethodToMethodString (SomeMethod SMethod_Initialized) = "initialized" +someMethodToMethodString (SomeMethod SMethod_Exit) = "exit" +someMethodToMethodString (SomeMethod SMethod_WorkspaceDidChangeConfiguration) = "workspace/didChangeConfiguration" +someMethodToMethodString (SomeMethod SMethod_WindowShowMessage) = "window/showMessage" +someMethodToMethodString (SomeMethod SMethod_WindowLogMessage) = "window/logMessage" +someMethodToMethodString (SomeMethod SMethod_TelemetryEvent) = "telemetry/event" +someMethodToMethodString (SomeMethod SMethod_TextDocumentDidOpen) = "textDocument/didOpen" +someMethodToMethodString (SomeMethod SMethod_TextDocumentDidChange) = "textDocument/didChange" +someMethodToMethodString (SomeMethod SMethod_TextDocumentDidClose) = "textDocument/didClose" +someMethodToMethodString (SomeMethod SMethod_TextDocumentDidSave) = "textDocument/didSave" +someMethodToMethodString (SomeMethod SMethod_TextDocumentWillSave) = "textDocument/willSave" +someMethodToMethodString (SomeMethod SMethod_WorkspaceDidChangeWatchedFiles) = "workspace/didChangeWatchedFiles" +someMethodToMethodString (SomeMethod SMethod_TextDocumentPublishDiagnostics) = "textDocument/publishDiagnostics" +someMethodToMethodString (SomeMethod SMethod_SetTrace) = "$/setTrace" +someMethodToMethodString (SomeMethod SMethod_LogTrace) = "$/logTrace" +someMethodToMethodString (SomeMethod SMethod_CancelRequest) = "$/cancelRequest" +someMethodToMethodString (SomeMethod SMethod_Progress) = "$/progress" +someMethodToMethodString (SomeMethod (SMethod_CustomMethod v)) = GHC.TypeLits.symbolVal v + +-- | Turn a LSP method string into a 'SomeMethod'. +methodStringToSomeMethod :: String -> SomeMethod +methodStringToSomeMethod "textDocument/implementation" = SomeMethod SMethod_TextDocumentImplementation +methodStringToSomeMethod "textDocument/typeDefinition" = SomeMethod SMethod_TextDocumentTypeDefinition +methodStringToSomeMethod "workspace/workspaceFolders" = SomeMethod SMethod_WorkspaceWorkspaceFolders +methodStringToSomeMethod "workspace/configuration" = SomeMethod SMethod_WorkspaceConfiguration +methodStringToSomeMethod "textDocument/documentColor" = SomeMethod SMethod_TextDocumentDocumentColor +methodStringToSomeMethod "textDocument/colorPresentation" = SomeMethod SMethod_TextDocumentColorPresentation +methodStringToSomeMethod "textDocument/foldingRange" = SomeMethod SMethod_TextDocumentFoldingRange +methodStringToSomeMethod "textDocument/declaration" = SomeMethod SMethod_TextDocumentDeclaration +methodStringToSomeMethod "textDocument/selectionRange" = SomeMethod SMethod_TextDocumentSelectionRange +methodStringToSomeMethod "window/workDoneProgress/create" = SomeMethod SMethod_WindowWorkDoneProgressCreate +methodStringToSomeMethod "textDocument/prepareCallHierarchy" = SomeMethod SMethod_TextDocumentPrepareCallHierarchy +methodStringToSomeMethod "callHierarchy/incomingCalls" = SomeMethod SMethod_CallHierarchyIncomingCalls +methodStringToSomeMethod "callHierarchy/outgoingCalls" = SomeMethod SMethod_CallHierarchyOutgoingCalls +methodStringToSomeMethod "textDocument/semanticTokens/full" = SomeMethod SMethod_TextDocumentSemanticTokensFull +methodStringToSomeMethod "textDocument/semanticTokens/full/delta" = SomeMethod SMethod_TextDocumentSemanticTokensFullDelta +methodStringToSomeMethod "textDocument/semanticTokens/range" = SomeMethod SMethod_TextDocumentSemanticTokensRange +methodStringToSomeMethod "workspace/semanticTokens/refresh" = SomeMethod SMethod_WorkspaceSemanticTokensRefresh +methodStringToSomeMethod "window/showDocument" = SomeMethod SMethod_WindowShowDocument +methodStringToSomeMethod "textDocument/linkedEditingRange" = SomeMethod SMethod_TextDocumentLinkedEditingRange +methodStringToSomeMethod "workspace/willCreateFiles" = SomeMethod SMethod_WorkspaceWillCreateFiles +methodStringToSomeMethod "workspace/willRenameFiles" = SomeMethod SMethod_WorkspaceWillRenameFiles +methodStringToSomeMethod "workspace/willDeleteFiles" = SomeMethod SMethod_WorkspaceWillDeleteFiles +methodStringToSomeMethod "textDocument/moniker" = SomeMethod SMethod_TextDocumentMoniker +methodStringToSomeMethod "textDocument/prepareTypeHierarchy" = SomeMethod SMethod_TextDocumentPrepareTypeHierarchy +methodStringToSomeMethod "typeHierarchy/supertypes" = SomeMethod SMethod_TypeHierarchySupertypes +methodStringToSomeMethod "typeHierarchy/subtypes" = SomeMethod SMethod_TypeHierarchySubtypes +methodStringToSomeMethod "textDocument/inlineValue" = SomeMethod SMethod_TextDocumentInlineValue +methodStringToSomeMethod "workspace/inlineValue/refresh" = SomeMethod SMethod_WorkspaceInlineValueRefresh +methodStringToSomeMethod "textDocument/inlayHint" = SomeMethod SMethod_TextDocumentInlayHint +methodStringToSomeMethod "inlayHint/resolve" = SomeMethod SMethod_InlayHintResolve +methodStringToSomeMethod "workspace/inlayHint/refresh" = SomeMethod SMethod_WorkspaceInlayHintRefresh +methodStringToSomeMethod "textDocument/diagnostic" = SomeMethod SMethod_TextDocumentDiagnostic +methodStringToSomeMethod "workspace/diagnostic" = SomeMethod SMethod_WorkspaceDiagnostic +methodStringToSomeMethod "workspace/diagnostic/refresh" = SomeMethod SMethod_WorkspaceDiagnosticRefresh +methodStringToSomeMethod "client/registerCapability" = SomeMethod SMethod_ClientRegisterCapability +methodStringToSomeMethod "client/unregisterCapability" = SomeMethod SMethod_ClientUnregisterCapability +methodStringToSomeMethod "initialize" = SomeMethod SMethod_Initialize +methodStringToSomeMethod "shutdown" = SomeMethod SMethod_Shutdown +methodStringToSomeMethod "window/showMessageRequest" = SomeMethod SMethod_WindowShowMessageRequest +methodStringToSomeMethod "textDocument/willSaveWaitUntil" = SomeMethod SMethod_TextDocumentWillSaveWaitUntil +methodStringToSomeMethod "textDocument/completion" = SomeMethod SMethod_TextDocumentCompletion +methodStringToSomeMethod "completionItem/resolve" = SomeMethod SMethod_CompletionItemResolve +methodStringToSomeMethod "textDocument/hover" = SomeMethod SMethod_TextDocumentHover +methodStringToSomeMethod "textDocument/signatureHelp" = SomeMethod SMethod_TextDocumentSignatureHelp +methodStringToSomeMethod "textDocument/definition" = SomeMethod SMethod_TextDocumentDefinition +methodStringToSomeMethod "textDocument/references" = SomeMethod SMethod_TextDocumentReferences +methodStringToSomeMethod "textDocument/documentHighlight" = SomeMethod SMethod_TextDocumentDocumentHighlight +methodStringToSomeMethod "textDocument/documentSymbol" = SomeMethod SMethod_TextDocumentDocumentSymbol +methodStringToSomeMethod "textDocument/codeAction" = SomeMethod SMethod_TextDocumentCodeAction +methodStringToSomeMethod "codeAction/resolve" = SomeMethod SMethod_CodeActionResolve +methodStringToSomeMethod "workspace/symbol" = SomeMethod SMethod_WorkspaceSymbol +methodStringToSomeMethod "workspaceSymbol/resolve" = SomeMethod SMethod_WorkspaceSymbolResolve +methodStringToSomeMethod "textDocument/codeLens" = SomeMethod SMethod_TextDocumentCodeLens +methodStringToSomeMethod "codeLens/resolve" = SomeMethod SMethod_CodeLensResolve +methodStringToSomeMethod "workspace/codeLens/refresh" = SomeMethod SMethod_WorkspaceCodeLensRefresh +methodStringToSomeMethod "textDocument/documentLink" = SomeMethod SMethod_TextDocumentDocumentLink +methodStringToSomeMethod "documentLink/resolve" = SomeMethod SMethod_DocumentLinkResolve +methodStringToSomeMethod "textDocument/formatting" = SomeMethod SMethod_TextDocumentFormatting +methodStringToSomeMethod "textDocument/rangeFormatting" = SomeMethod SMethod_TextDocumentRangeFormatting +methodStringToSomeMethod "textDocument/onTypeFormatting" = SomeMethod SMethod_TextDocumentOnTypeFormatting +methodStringToSomeMethod "textDocument/rename" = SomeMethod SMethod_TextDocumentRename +methodStringToSomeMethod "textDocument/prepareRename" = SomeMethod SMethod_TextDocumentPrepareRename +methodStringToSomeMethod "workspace/executeCommand" = SomeMethod SMethod_WorkspaceExecuteCommand +methodStringToSomeMethod "workspace/applyEdit" = SomeMethod SMethod_WorkspaceApplyEdit +methodStringToSomeMethod "workspace/didChangeWorkspaceFolders" = SomeMethod SMethod_WorkspaceDidChangeWorkspaceFolders +methodStringToSomeMethod "window/workDoneProgress/cancel" = SomeMethod SMethod_WindowWorkDoneProgressCancel +methodStringToSomeMethod "workspace/didCreateFiles" = SomeMethod SMethod_WorkspaceDidCreateFiles +methodStringToSomeMethod "workspace/didRenameFiles" = SomeMethod SMethod_WorkspaceDidRenameFiles +methodStringToSomeMethod "workspace/didDeleteFiles" = SomeMethod SMethod_WorkspaceDidDeleteFiles +methodStringToSomeMethod "notebookDocument/didOpen" = SomeMethod SMethod_NotebookDocumentDidOpen +methodStringToSomeMethod "notebookDocument/didChange" = SomeMethod SMethod_NotebookDocumentDidChange +methodStringToSomeMethod "notebookDocument/didSave" = SomeMethod SMethod_NotebookDocumentDidSave +methodStringToSomeMethod "notebookDocument/didClose" = SomeMethod SMethod_NotebookDocumentDidClose +methodStringToSomeMethod "initialized" = SomeMethod SMethod_Initialized +methodStringToSomeMethod "exit" = SomeMethod SMethod_Exit +methodStringToSomeMethod "workspace/didChangeConfiguration" = SomeMethod SMethod_WorkspaceDidChangeConfiguration +methodStringToSomeMethod "window/showMessage" = SomeMethod SMethod_WindowShowMessage +methodStringToSomeMethod "window/logMessage" = SomeMethod SMethod_WindowLogMessage +methodStringToSomeMethod "telemetry/event" = SomeMethod SMethod_TelemetryEvent +methodStringToSomeMethod "textDocument/didOpen" = SomeMethod SMethod_TextDocumentDidOpen +methodStringToSomeMethod "textDocument/didChange" = SomeMethod SMethod_TextDocumentDidChange +methodStringToSomeMethod "textDocument/didClose" = SomeMethod SMethod_TextDocumentDidClose +methodStringToSomeMethod "textDocument/didSave" = SomeMethod SMethod_TextDocumentDidSave +methodStringToSomeMethod "textDocument/willSave" = SomeMethod SMethod_TextDocumentWillSave +methodStringToSomeMethod "workspace/didChangeWatchedFiles" = SomeMethod SMethod_WorkspaceDidChangeWatchedFiles +methodStringToSomeMethod "textDocument/publishDiagnostics" = SomeMethod SMethod_TextDocumentPublishDiagnostics +methodStringToSomeMethod "$/setTrace" = SomeMethod SMethod_SetTrace +methodStringToSomeMethod "$/logTrace" = SomeMethod SMethod_LogTrace +methodStringToSomeMethod "$/cancelRequest" = SomeMethod SMethod_CancelRequest +methodStringToSomeMethod "$/progress" = SomeMethod SMethod_Progress +methodStringToSomeMethod v = case GHC.TypeLits.someSymbolVal v of { GHC.TypeLits.SomeSymbol p -> SomeMethod (SMethod_CustomMethod p) ; } + +-- | Get a singleton witness for the message direction of a 'SMethod'. +messageDirection :: forall f t (m :: Method f t) . SMethod m -> MM.SMessageDirection f +messageDirection SMethod_TextDocumentImplementation = MM.SClientToServer +messageDirection SMethod_TextDocumentTypeDefinition = MM.SClientToServer +messageDirection SMethod_WorkspaceWorkspaceFolders = MM.SServerToClient +messageDirection SMethod_WorkspaceConfiguration = MM.SServerToClient +messageDirection SMethod_TextDocumentDocumentColor = MM.SClientToServer +messageDirection SMethod_TextDocumentColorPresentation = MM.SClientToServer +messageDirection SMethod_TextDocumentFoldingRange = MM.SClientToServer +messageDirection SMethod_TextDocumentDeclaration = MM.SClientToServer +messageDirection SMethod_TextDocumentSelectionRange = MM.SClientToServer +messageDirection SMethod_WindowWorkDoneProgressCreate = MM.SServerToClient +messageDirection SMethod_TextDocumentPrepareCallHierarchy = MM.SClientToServer +messageDirection SMethod_CallHierarchyIncomingCalls = MM.SClientToServer +messageDirection SMethod_CallHierarchyOutgoingCalls = MM.SClientToServer +messageDirection SMethod_TextDocumentSemanticTokensFull = MM.SClientToServer +messageDirection SMethod_TextDocumentSemanticTokensFullDelta = MM.SClientToServer +messageDirection SMethod_TextDocumentSemanticTokensRange = MM.SClientToServer +messageDirection SMethod_WorkspaceSemanticTokensRefresh = MM.SServerToClient +messageDirection SMethod_WindowShowDocument = MM.SServerToClient +messageDirection SMethod_TextDocumentLinkedEditingRange = MM.SClientToServer +messageDirection SMethod_WorkspaceWillCreateFiles = MM.SClientToServer +messageDirection SMethod_WorkspaceWillRenameFiles = MM.SClientToServer +messageDirection SMethod_WorkspaceWillDeleteFiles = MM.SClientToServer +messageDirection SMethod_TextDocumentMoniker = MM.SClientToServer +messageDirection SMethod_TextDocumentPrepareTypeHierarchy = MM.SClientToServer +messageDirection SMethod_TypeHierarchySupertypes = MM.SClientToServer +messageDirection SMethod_TypeHierarchySubtypes = MM.SClientToServer +messageDirection SMethod_TextDocumentInlineValue = MM.SClientToServer +messageDirection SMethod_WorkspaceInlineValueRefresh = MM.SServerToClient +messageDirection SMethod_TextDocumentInlayHint = MM.SClientToServer +messageDirection SMethod_InlayHintResolve = MM.SClientToServer +messageDirection SMethod_WorkspaceInlayHintRefresh = MM.SServerToClient +messageDirection SMethod_TextDocumentDiagnostic = MM.SClientToServer +messageDirection SMethod_WorkspaceDiagnostic = MM.SClientToServer +messageDirection SMethod_WorkspaceDiagnosticRefresh = MM.SServerToClient +messageDirection SMethod_ClientRegisterCapability = MM.SServerToClient +messageDirection SMethod_ClientUnregisterCapability = MM.SServerToClient +messageDirection SMethod_Initialize = MM.SClientToServer +messageDirection SMethod_Shutdown = MM.SClientToServer +messageDirection SMethod_WindowShowMessageRequest = MM.SServerToClient +messageDirection SMethod_TextDocumentWillSaveWaitUntil = MM.SClientToServer +messageDirection SMethod_TextDocumentCompletion = MM.SClientToServer +messageDirection SMethod_CompletionItemResolve = MM.SClientToServer +messageDirection SMethod_TextDocumentHover = MM.SClientToServer +messageDirection SMethod_TextDocumentSignatureHelp = MM.SClientToServer +messageDirection SMethod_TextDocumentDefinition = MM.SClientToServer +messageDirection SMethod_TextDocumentReferences = MM.SClientToServer +messageDirection SMethod_TextDocumentDocumentHighlight = MM.SClientToServer +messageDirection SMethod_TextDocumentDocumentSymbol = MM.SClientToServer +messageDirection SMethod_TextDocumentCodeAction = MM.SClientToServer +messageDirection SMethod_CodeActionResolve = MM.SClientToServer +messageDirection SMethod_WorkspaceSymbol = MM.SClientToServer +messageDirection SMethod_WorkspaceSymbolResolve = MM.SClientToServer +messageDirection SMethod_TextDocumentCodeLens = MM.SClientToServer +messageDirection SMethod_CodeLensResolve = MM.SClientToServer +messageDirection SMethod_WorkspaceCodeLensRefresh = MM.SServerToClient +messageDirection SMethod_TextDocumentDocumentLink = MM.SClientToServer +messageDirection SMethod_DocumentLinkResolve = MM.SClientToServer +messageDirection SMethod_TextDocumentFormatting = MM.SClientToServer +messageDirection SMethod_TextDocumentRangeFormatting = MM.SClientToServer +messageDirection SMethod_TextDocumentOnTypeFormatting = MM.SClientToServer +messageDirection SMethod_TextDocumentRename = MM.SClientToServer +messageDirection SMethod_TextDocumentPrepareRename = MM.SClientToServer +messageDirection SMethod_WorkspaceExecuteCommand = MM.SClientToServer +messageDirection SMethod_WorkspaceApplyEdit = MM.SServerToClient +messageDirection SMethod_WorkspaceDidChangeWorkspaceFolders = MM.SClientToServer +messageDirection SMethod_WindowWorkDoneProgressCancel = MM.SClientToServer +messageDirection SMethod_WorkspaceDidCreateFiles = MM.SClientToServer +messageDirection SMethod_WorkspaceDidRenameFiles = MM.SClientToServer +messageDirection SMethod_WorkspaceDidDeleteFiles = MM.SClientToServer +messageDirection SMethod_NotebookDocumentDidOpen = MM.SClientToServer +messageDirection SMethod_NotebookDocumentDidChange = MM.SClientToServer +messageDirection SMethod_NotebookDocumentDidSave = MM.SClientToServer +messageDirection SMethod_NotebookDocumentDidClose = MM.SClientToServer +messageDirection SMethod_Initialized = MM.SClientToServer +messageDirection SMethod_Exit = MM.SClientToServer +messageDirection SMethod_WorkspaceDidChangeConfiguration = MM.SClientToServer +messageDirection SMethod_WindowShowMessage = MM.SServerToClient +messageDirection SMethod_WindowLogMessage = MM.SServerToClient +messageDirection SMethod_TelemetryEvent = MM.SServerToClient +messageDirection SMethod_TextDocumentDidOpen = MM.SClientToServer +messageDirection SMethod_TextDocumentDidChange = MM.SClientToServer +messageDirection SMethod_TextDocumentDidClose = MM.SClientToServer +messageDirection SMethod_TextDocumentDidSave = MM.SClientToServer +messageDirection SMethod_TextDocumentWillSave = MM.SClientToServer +messageDirection SMethod_WorkspaceDidChangeWatchedFiles = MM.SClientToServer +messageDirection SMethod_TextDocumentPublishDiagnostics = MM.SServerToClient +messageDirection SMethod_SetTrace = MM.SClientToServer +messageDirection SMethod_LogTrace = MM.SServerToClient +messageDirection SMethod_CancelRequest = MM.SBothDirections +messageDirection SMethod_Progress = MM.SBothDirections +messageDirection (SMethod_CustomMethod _) = MM.SBothDirections + +-- | Get a singleton witness for the message kind of a 'SMethod'. +messageKind :: forall f t (m :: Method f t) . SMethod m -> MM.SMessageKind t +messageKind SMethod_TextDocumentImplementation = MM.SRequest +messageKind SMethod_TextDocumentTypeDefinition = MM.SRequest +messageKind SMethod_WorkspaceWorkspaceFolders = MM.SRequest +messageKind SMethod_WorkspaceConfiguration = MM.SRequest +messageKind SMethod_TextDocumentDocumentColor = MM.SRequest +messageKind SMethod_TextDocumentColorPresentation = MM.SRequest +messageKind SMethod_TextDocumentFoldingRange = MM.SRequest +messageKind SMethod_TextDocumentDeclaration = MM.SRequest +messageKind SMethod_TextDocumentSelectionRange = MM.SRequest +messageKind SMethod_WindowWorkDoneProgressCreate = MM.SRequest +messageKind SMethod_TextDocumentPrepareCallHierarchy = MM.SRequest +messageKind SMethod_CallHierarchyIncomingCalls = MM.SRequest +messageKind SMethod_CallHierarchyOutgoingCalls = MM.SRequest +messageKind SMethod_TextDocumentSemanticTokensFull = MM.SRequest +messageKind SMethod_TextDocumentSemanticTokensFullDelta = MM.SRequest +messageKind SMethod_TextDocumentSemanticTokensRange = MM.SRequest +messageKind SMethod_WorkspaceSemanticTokensRefresh = MM.SRequest +messageKind SMethod_WindowShowDocument = MM.SRequest +messageKind SMethod_TextDocumentLinkedEditingRange = MM.SRequest +messageKind SMethod_WorkspaceWillCreateFiles = MM.SRequest +messageKind SMethod_WorkspaceWillRenameFiles = MM.SRequest +messageKind SMethod_WorkspaceWillDeleteFiles = MM.SRequest +messageKind SMethod_TextDocumentMoniker = MM.SRequest +messageKind SMethod_TextDocumentPrepareTypeHierarchy = MM.SRequest +messageKind SMethod_TypeHierarchySupertypes = MM.SRequest +messageKind SMethod_TypeHierarchySubtypes = MM.SRequest +messageKind SMethod_TextDocumentInlineValue = MM.SRequest +messageKind SMethod_WorkspaceInlineValueRefresh = MM.SRequest +messageKind SMethod_TextDocumentInlayHint = MM.SRequest +messageKind SMethod_InlayHintResolve = MM.SRequest +messageKind SMethod_WorkspaceInlayHintRefresh = MM.SRequest +messageKind SMethod_TextDocumentDiagnostic = MM.SRequest +messageKind SMethod_WorkspaceDiagnostic = MM.SRequest +messageKind SMethod_WorkspaceDiagnosticRefresh = MM.SRequest +messageKind SMethod_ClientRegisterCapability = MM.SRequest +messageKind SMethod_ClientUnregisterCapability = MM.SRequest +messageKind SMethod_Initialize = MM.SRequest +messageKind SMethod_Shutdown = MM.SRequest +messageKind SMethod_WindowShowMessageRequest = MM.SRequest +messageKind SMethod_TextDocumentWillSaveWaitUntil = MM.SRequest +messageKind SMethod_TextDocumentCompletion = MM.SRequest +messageKind SMethod_CompletionItemResolve = MM.SRequest +messageKind SMethod_TextDocumentHover = MM.SRequest +messageKind SMethod_TextDocumentSignatureHelp = MM.SRequest +messageKind SMethod_TextDocumentDefinition = MM.SRequest +messageKind SMethod_TextDocumentReferences = MM.SRequest +messageKind SMethod_TextDocumentDocumentHighlight = MM.SRequest +messageKind SMethod_TextDocumentDocumentSymbol = MM.SRequest +messageKind SMethod_TextDocumentCodeAction = MM.SRequest +messageKind SMethod_CodeActionResolve = MM.SRequest +messageKind SMethod_WorkspaceSymbol = MM.SRequest +messageKind SMethod_WorkspaceSymbolResolve = MM.SRequest +messageKind SMethod_TextDocumentCodeLens = MM.SRequest +messageKind SMethod_CodeLensResolve = MM.SRequest +messageKind SMethod_WorkspaceCodeLensRefresh = MM.SRequest +messageKind SMethod_TextDocumentDocumentLink = MM.SRequest +messageKind SMethod_DocumentLinkResolve = MM.SRequest +messageKind SMethod_TextDocumentFormatting = MM.SRequest +messageKind SMethod_TextDocumentRangeFormatting = MM.SRequest +messageKind SMethod_TextDocumentOnTypeFormatting = MM.SRequest +messageKind SMethod_TextDocumentRename = MM.SRequest +messageKind SMethod_TextDocumentPrepareRename = MM.SRequest +messageKind SMethod_WorkspaceExecuteCommand = MM.SRequest +messageKind SMethod_WorkspaceApplyEdit = MM.SRequest +messageKind SMethod_WorkspaceDidChangeWorkspaceFolders = MM.SNotification +messageKind SMethod_WindowWorkDoneProgressCancel = MM.SNotification +messageKind SMethod_WorkspaceDidCreateFiles = MM.SNotification +messageKind SMethod_WorkspaceDidRenameFiles = MM.SNotification +messageKind SMethod_WorkspaceDidDeleteFiles = MM.SNotification +messageKind SMethod_NotebookDocumentDidOpen = MM.SNotification +messageKind SMethod_NotebookDocumentDidChange = MM.SNotification +messageKind SMethod_NotebookDocumentDidSave = MM.SNotification +messageKind SMethod_NotebookDocumentDidClose = MM.SNotification +messageKind SMethod_Initialized = MM.SNotification +messageKind SMethod_Exit = MM.SNotification +messageKind SMethod_WorkspaceDidChangeConfiguration = MM.SNotification +messageKind SMethod_WindowShowMessage = MM.SNotification +messageKind SMethod_WindowLogMessage = MM.SNotification +messageKind SMethod_TelemetryEvent = MM.SNotification +messageKind SMethod_TextDocumentDidOpen = MM.SNotification +messageKind SMethod_TextDocumentDidChange = MM.SNotification +messageKind SMethod_TextDocumentDidClose = MM.SNotification +messageKind SMethod_TextDocumentDidSave = MM.SNotification +messageKind SMethod_TextDocumentWillSave = MM.SNotification +messageKind SMethod_WorkspaceDidChangeWatchedFiles = MM.SNotification +messageKind SMethod_TextDocumentPublishDiagnostics = MM.SNotification +messageKind SMethod_SetTrace = MM.SNotification +messageKind SMethod_LogTrace = MM.SNotification +messageKind SMethod_CancelRequest = MM.SNotification +messageKind SMethod_Progress = MM.SNotification +messageKind (SMethod_CustomMethod _) = MM.SBothTypes \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types.hs new file mode 100644 index 000000000..fa75b3519 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types.hs @@ -0,0 +1,378 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types (module Export) where + +import Language.LSP.Protocol.Internal.Types.AnnotatedTextEdit as Export +import Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditParams as Export +import Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditResult as Export +import Language.LSP.Protocol.Internal.Types.BaseSymbolInformation as Export +import Language.LSP.Protocol.Internal.Types.CallHierarchyClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCall as Export +import Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCallsParams as Export +import Language.LSP.Protocol.Internal.Types.CallHierarchyItem as Export +import Language.LSP.Protocol.Internal.Types.CallHierarchyOptions as Export +import Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCall as Export +import Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCallsParams as Export +import Language.LSP.Protocol.Internal.Types.CallHierarchyPrepareParams as Export +import Language.LSP.Protocol.Internal.Types.CallHierarchyRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.CancelParams as Export +import Language.LSP.Protocol.Internal.Types.ChangeAnnotation as Export +import Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier as Export +import Language.LSP.Protocol.Internal.Types.ClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.CodeAction as Export +import Language.LSP.Protocol.Internal.Types.CodeActionClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.CodeActionContext as Export +import Language.LSP.Protocol.Internal.Types.CodeActionKind as Export +import Language.LSP.Protocol.Internal.Types.CodeActionOptions as Export +import Language.LSP.Protocol.Internal.Types.CodeActionParams as Export +import Language.LSP.Protocol.Internal.Types.CodeActionRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.CodeActionTriggerKind as Export +import Language.LSP.Protocol.Internal.Types.CodeDescription as Export +import Language.LSP.Protocol.Internal.Types.CodeLens as Export +import Language.LSP.Protocol.Internal.Types.CodeLensClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.CodeLensOptions as Export +import Language.LSP.Protocol.Internal.Types.CodeLensParams as Export +import Language.LSP.Protocol.Internal.Types.CodeLensRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.CodeLensWorkspaceClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.Color as Export +import Language.LSP.Protocol.Internal.Types.ColorInformation as Export +import Language.LSP.Protocol.Internal.Types.ColorPresentation as Export +import Language.LSP.Protocol.Internal.Types.ColorPresentationParams as Export +import Language.LSP.Protocol.Internal.Types.Command as Export +import Language.LSP.Protocol.Internal.Types.CompletionClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.CompletionContext as Export +import Language.LSP.Protocol.Internal.Types.CompletionItem as Export +import Language.LSP.Protocol.Internal.Types.CompletionItemKind as Export +import Language.LSP.Protocol.Internal.Types.CompletionItemLabelDetails as Export +import Language.LSP.Protocol.Internal.Types.CompletionItemTag as Export +import Language.LSP.Protocol.Internal.Types.CompletionList as Export +import Language.LSP.Protocol.Internal.Types.CompletionOptions as Export +import Language.LSP.Protocol.Internal.Types.CompletionParams as Export +import Language.LSP.Protocol.Internal.Types.CompletionRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.CompletionTriggerKind as Export +import Language.LSP.Protocol.Internal.Types.ConfigurationItem as Export +import Language.LSP.Protocol.Internal.Types.ConfigurationParams as Export +import Language.LSP.Protocol.Internal.Types.CreateFile as Export +import Language.LSP.Protocol.Internal.Types.CreateFileOptions as Export +import Language.LSP.Protocol.Internal.Types.CreateFilesParams as Export +import Language.LSP.Protocol.Internal.Types.Declaration as Export +import Language.LSP.Protocol.Internal.Types.DeclarationClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DeclarationLink as Export +import Language.LSP.Protocol.Internal.Types.DeclarationOptions as Export +import Language.LSP.Protocol.Internal.Types.DeclarationParams as Export +import Language.LSP.Protocol.Internal.Types.DeclarationRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.Definition as Export +import Language.LSP.Protocol.Internal.Types.DefinitionClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DefinitionLink as Export +import Language.LSP.Protocol.Internal.Types.DefinitionOptions as Export +import Language.LSP.Protocol.Internal.Types.DefinitionParams as Export +import Language.LSP.Protocol.Internal.Types.DefinitionRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.DeleteFile as Export +import Language.LSP.Protocol.Internal.Types.DeleteFileOptions as Export +import Language.LSP.Protocol.Internal.Types.DeleteFilesParams as Export +import Language.LSP.Protocol.Internal.Types.Diagnostic as Export +import Language.LSP.Protocol.Internal.Types.DiagnosticClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DiagnosticOptions as Export +import Language.LSP.Protocol.Internal.Types.DiagnosticRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.DiagnosticRelatedInformation as Export +import Language.LSP.Protocol.Internal.Types.DiagnosticServerCancellationData as Export +import Language.LSP.Protocol.Internal.Types.DiagnosticSeverity as Export +import Language.LSP.Protocol.Internal.Types.DiagnosticTag as Export +import Language.LSP.Protocol.Internal.Types.DiagnosticWorkspaceClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DidChangeConfigurationClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DidChangeConfigurationParams as Export +import Language.LSP.Protocol.Internal.Types.DidChangeConfigurationRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.DidChangeNotebookDocumentParams as Export +import Language.LSP.Protocol.Internal.Types.DidChangeTextDocumentParams as Export +import Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesParams as Export +import Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.DidChangeWorkspaceFoldersParams as Export +import Language.LSP.Protocol.Internal.Types.DidCloseNotebookDocumentParams as Export +import Language.LSP.Protocol.Internal.Types.DidCloseTextDocumentParams as Export +import Language.LSP.Protocol.Internal.Types.DidOpenNotebookDocumentParams as Export +import Language.LSP.Protocol.Internal.Types.DidOpenTextDocumentParams as Export +import Language.LSP.Protocol.Internal.Types.DidSaveNotebookDocumentParams as Export +import Language.LSP.Protocol.Internal.Types.DidSaveTextDocumentParams as Export +import Language.LSP.Protocol.Internal.Types.DocumentColorClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DocumentColorOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentColorParams as Export +import Language.LSP.Protocol.Internal.Types.DocumentColorRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentDiagnosticParams as Export +import Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReport as Export +import Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReportKind as Export +import Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReportPartialResult as Export +import Language.LSP.Protocol.Internal.Types.DocumentFilter as Export +import Language.LSP.Protocol.Internal.Types.DocumentFormattingClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DocumentFormattingOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentFormattingParams as Export +import Language.LSP.Protocol.Internal.Types.DocumentFormattingRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentHighlight as Export +import Language.LSP.Protocol.Internal.Types.DocumentHighlightClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DocumentHighlightKind as Export +import Language.LSP.Protocol.Internal.Types.DocumentHighlightOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentHighlightParams as Export +import Language.LSP.Protocol.Internal.Types.DocumentHighlightRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentLink as Export +import Language.LSP.Protocol.Internal.Types.DocumentLinkClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DocumentLinkOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentLinkParams as Export +import Language.LSP.Protocol.Internal.Types.DocumentLinkRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingParams as Export +import Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingParams as Export +import Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentSelector as Export +import Language.LSP.Protocol.Internal.Types.DocumentSymbol as Export +import Language.LSP.Protocol.Internal.Types.DocumentSymbolClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.DocumentSymbolOptions as Export +import Language.LSP.Protocol.Internal.Types.DocumentSymbolParams as Export +import Language.LSP.Protocol.Internal.Types.DocumentSymbolRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.ErrorCodes as Export +import Language.LSP.Protocol.Internal.Types.ExecuteCommandClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.ExecuteCommandOptions as Export +import Language.LSP.Protocol.Internal.Types.ExecuteCommandParams as Export +import Language.LSP.Protocol.Internal.Types.ExecuteCommandRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.ExecutionSummary as Export +import Language.LSP.Protocol.Internal.Types.FailureHandlingKind as Export +import Language.LSP.Protocol.Internal.Types.FileChangeType as Export +import Language.LSP.Protocol.Internal.Types.FileCreate as Export +import Language.LSP.Protocol.Internal.Types.FileDelete as Export +import Language.LSP.Protocol.Internal.Types.FileEvent as Export +import Language.LSP.Protocol.Internal.Types.FileOperationClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.FileOperationFilter as Export +import Language.LSP.Protocol.Internal.Types.FileOperationOptions as Export +import Language.LSP.Protocol.Internal.Types.FileOperationPattern as Export +import Language.LSP.Protocol.Internal.Types.FileOperationPatternKind as Export +import Language.LSP.Protocol.Internal.Types.FileOperationPatternOptions as Export +import Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.FileRename as Export +import Language.LSP.Protocol.Internal.Types.FileSystemWatcher as Export +import Language.LSP.Protocol.Internal.Types.FoldingRange as Export +import Language.LSP.Protocol.Internal.Types.FoldingRangeClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.FoldingRangeKind as Export +import Language.LSP.Protocol.Internal.Types.FoldingRangeOptions as Export +import Language.LSP.Protocol.Internal.Types.FoldingRangeParams as Export +import Language.LSP.Protocol.Internal.Types.FoldingRangeRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.FormattingOptions as Export +import Language.LSP.Protocol.Internal.Types.FullDocumentDiagnosticReport as Export +import Language.LSP.Protocol.Internal.Types.GeneralClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.GlobPattern as Export +import Language.LSP.Protocol.Internal.Types.Hover as Export +import Language.LSP.Protocol.Internal.Types.HoverClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.HoverOptions as Export +import Language.LSP.Protocol.Internal.Types.HoverParams as Export +import Language.LSP.Protocol.Internal.Types.HoverRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.ImplementationClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.ImplementationOptions as Export +import Language.LSP.Protocol.Internal.Types.ImplementationParams as Export +import Language.LSP.Protocol.Internal.Types.ImplementationRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.InitializeError as Export +import Language.LSP.Protocol.Internal.Types.InitializeParams as Export +import Language.LSP.Protocol.Internal.Types.InitializeResult as Export +import Language.LSP.Protocol.Internal.Types.InitializedParams as Export +import Language.LSP.Protocol.Internal.Types.InlayHint as Export +import Language.LSP.Protocol.Internal.Types.InlayHintClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.InlayHintKind as Export +import Language.LSP.Protocol.Internal.Types.InlayHintLabelPart as Export +import Language.LSP.Protocol.Internal.Types.InlayHintOptions as Export +import Language.LSP.Protocol.Internal.Types.InlayHintParams as Export +import Language.LSP.Protocol.Internal.Types.InlayHintRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.InlayHintWorkspaceClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.InlineValue as Export +import Language.LSP.Protocol.Internal.Types.InlineValueClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.InlineValueContext as Export +import Language.LSP.Protocol.Internal.Types.InlineValueEvaluatableExpression as Export +import Language.LSP.Protocol.Internal.Types.InlineValueOptions as Export +import Language.LSP.Protocol.Internal.Types.InlineValueParams as Export +import Language.LSP.Protocol.Internal.Types.InlineValueRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.InlineValueText as Export +import Language.LSP.Protocol.Internal.Types.InlineValueVariableLookup as Export +import Language.LSP.Protocol.Internal.Types.InlineValueWorkspaceClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.InsertReplaceEdit as Export +import Language.LSP.Protocol.Internal.Types.InsertTextFormat as Export +import Language.LSP.Protocol.Internal.Types.InsertTextMode as Export +import Language.LSP.Protocol.Internal.Types.LSPAny as Export +import Language.LSP.Protocol.Internal.Types.LSPArray as Export +import Language.LSP.Protocol.Internal.Types.LSPErrorCodes as Export +import Language.LSP.Protocol.Internal.Types.LSPObject as Export +import Language.LSP.Protocol.Internal.Types.LinkedEditingRangeClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.LinkedEditingRangeOptions as Export +import Language.LSP.Protocol.Internal.Types.LinkedEditingRangeParams as Export +import Language.LSP.Protocol.Internal.Types.LinkedEditingRangeRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.LinkedEditingRanges as Export +import Language.LSP.Protocol.Internal.Types.Location as Export +import Language.LSP.Protocol.Internal.Types.LocationLink as Export +import Language.LSP.Protocol.Internal.Types.LogMessageParams as Export +import Language.LSP.Protocol.Internal.Types.LogTraceParams as Export +import Language.LSP.Protocol.Internal.Types.MarkdownClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.MarkedString as Export +import Language.LSP.Protocol.Internal.Types.MarkupContent as Export +import Language.LSP.Protocol.Internal.Types.MarkupKind as Export +import Language.LSP.Protocol.Internal.Types.MessageActionItem as Export +import Language.LSP.Protocol.Internal.Types.MessageType as Export +import Language.LSP.Protocol.Internal.Types.Moniker as Export +import Language.LSP.Protocol.Internal.Types.MonikerClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.MonikerKind as Export +import Language.LSP.Protocol.Internal.Types.MonikerOptions as Export +import Language.LSP.Protocol.Internal.Types.MonikerParams as Export +import Language.LSP.Protocol.Internal.Types.MonikerRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.NotebookCell as Export +import Language.LSP.Protocol.Internal.Types.NotebookCellArrayChange as Export +import Language.LSP.Protocol.Internal.Types.NotebookCellKind as Export +import Language.LSP.Protocol.Internal.Types.NotebookCellTextDocumentFilter as Export +import Language.LSP.Protocol.Internal.Types.NotebookDocument as Export +import Language.LSP.Protocol.Internal.Types.NotebookDocumentChangeEvent as Export +import Language.LSP.Protocol.Internal.Types.NotebookDocumentClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter as Export +import Language.LSP.Protocol.Internal.Types.NotebookDocumentIdentifier as Export +import Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncOptions as Export +import Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.OptionalVersionedTextDocumentIdentifier as Export +import Language.LSP.Protocol.Internal.Types.ParameterInformation as Export +import Language.LSP.Protocol.Internal.Types.PartialResultParams as Export +import Language.LSP.Protocol.Internal.Types.Pattern as Export +import Language.LSP.Protocol.Internal.Types.Position as Export +import Language.LSP.Protocol.Internal.Types.PositionEncodingKind as Export +import Language.LSP.Protocol.Internal.Types.PrepareRenameParams as Export +import Language.LSP.Protocol.Internal.Types.PrepareRenameResult as Export +import Language.LSP.Protocol.Internal.Types.PrepareSupportDefaultBehavior as Export +import Language.LSP.Protocol.Internal.Types.PreviousResultId as Export +import Language.LSP.Protocol.Internal.Types.ProgressParams as Export +import Language.LSP.Protocol.Internal.Types.ProgressToken as Export +import Language.LSP.Protocol.Internal.Types.PublishDiagnosticsClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.PublishDiagnosticsParams as Export +import Language.LSP.Protocol.Internal.Types.Range as Export +import Language.LSP.Protocol.Internal.Types.ReferenceClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.ReferenceContext as Export +import Language.LSP.Protocol.Internal.Types.ReferenceOptions as Export +import Language.LSP.Protocol.Internal.Types.ReferenceParams as Export +import Language.LSP.Protocol.Internal.Types.ReferenceRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.Registration as Export +import Language.LSP.Protocol.Internal.Types.RegistrationParams as Export +import Language.LSP.Protocol.Internal.Types.RegularExpressionsClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.RelatedFullDocumentDiagnosticReport as Export +import Language.LSP.Protocol.Internal.Types.RelatedUnchangedDocumentDiagnosticReport as Export +import Language.LSP.Protocol.Internal.Types.RelativePattern as Export +import Language.LSP.Protocol.Internal.Types.RenameClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.RenameFile as Export +import Language.LSP.Protocol.Internal.Types.RenameFileOptions as Export +import Language.LSP.Protocol.Internal.Types.RenameFilesParams as Export +import Language.LSP.Protocol.Internal.Types.RenameOptions as Export +import Language.LSP.Protocol.Internal.Types.RenameParams as Export +import Language.LSP.Protocol.Internal.Types.RenameRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.ResourceOperation as Export +import Language.LSP.Protocol.Internal.Types.ResourceOperationKind as Export +import Language.LSP.Protocol.Internal.Types.SaveOptions as Export +import Language.LSP.Protocol.Internal.Types.SelectionRange as Export +import Language.LSP.Protocol.Internal.Types.SelectionRangeClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.SelectionRangeOptions as Export +import Language.LSP.Protocol.Internal.Types.SelectionRangeParams as Export +import Language.LSP.Protocol.Internal.Types.SelectionRangeRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokenModifiers as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokenTypes as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokens as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokensClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokensDelta as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokensDeltaParams as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokensDeltaPartialResult as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokensEdit as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokensLegend as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokensOptions as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokensParams as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokensPartialResult as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokensRangeParams as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokensRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.SemanticTokensWorkspaceClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.ServerCapabilities as Export +import Language.LSP.Protocol.Internal.Types.SetTraceParams as Export +import Language.LSP.Protocol.Internal.Types.ShowDocumentClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.ShowDocumentParams as Export +import Language.LSP.Protocol.Internal.Types.ShowDocumentResult as Export +import Language.LSP.Protocol.Internal.Types.ShowMessageParams as Export +import Language.LSP.Protocol.Internal.Types.ShowMessageRequestClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.ShowMessageRequestParams as Export +import Language.LSP.Protocol.Internal.Types.SignatureHelp as Export +import Language.LSP.Protocol.Internal.Types.SignatureHelpClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.SignatureHelpContext as Export +import Language.LSP.Protocol.Internal.Types.SignatureHelpOptions as Export +import Language.LSP.Protocol.Internal.Types.SignatureHelpParams as Export +import Language.LSP.Protocol.Internal.Types.SignatureHelpRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.SignatureHelpTriggerKind as Export +import Language.LSP.Protocol.Internal.Types.SignatureInformation as Export +import Language.LSP.Protocol.Internal.Types.StaticRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.SymbolInformation as Export +import Language.LSP.Protocol.Internal.Types.SymbolKind as Export +import Language.LSP.Protocol.Internal.Types.SymbolTag as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentChangeRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentEdit as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentFilter as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentItem as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentPositionParams as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentSaveReason as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentSaveRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentSyncClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentSyncKind as Export +import Language.LSP.Protocol.Internal.Types.TextDocumentSyncOptions as Export +import Language.LSP.Protocol.Internal.Types.TextEdit as Export +import Language.LSP.Protocol.Internal.Types.TokenFormat as Export +import Language.LSP.Protocol.Internal.Types.TraceValues as Export +import Language.LSP.Protocol.Internal.Types.TypeDefinitionClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.TypeDefinitionOptions as Export +import Language.LSP.Protocol.Internal.Types.TypeDefinitionParams as Export +import Language.LSP.Protocol.Internal.Types.TypeDefinitionRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.TypeHierarchyClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.TypeHierarchyItem as Export +import Language.LSP.Protocol.Internal.Types.TypeHierarchyOptions as Export +import Language.LSP.Protocol.Internal.Types.TypeHierarchyPrepareParams as Export +import Language.LSP.Protocol.Internal.Types.TypeHierarchyRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.TypeHierarchySubtypesParams as Export +import Language.LSP.Protocol.Internal.Types.TypeHierarchySupertypesParams as Export +import Language.LSP.Protocol.Internal.Types.UInitializeParams as Export +import Language.LSP.Protocol.Internal.Types.UnchangedDocumentDiagnosticReport as Export +import Language.LSP.Protocol.Internal.Types.UniquenessLevel as Export +import Language.LSP.Protocol.Internal.Types.Unregistration as Export +import Language.LSP.Protocol.Internal.Types.UnregistrationParams as Export +import Language.LSP.Protocol.Internal.Types.VersionedNotebookDocumentIdentifier as Export +import Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier as Export +import Language.LSP.Protocol.Internal.Types.WatchKind as Export +import Language.LSP.Protocol.Internal.Types.WillSaveTextDocumentParams as Export +import Language.LSP.Protocol.Internal.Types.WindowClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.WorkDoneProgressBegin as Export +import Language.LSP.Protocol.Internal.Types.WorkDoneProgressCancelParams as Export +import Language.LSP.Protocol.Internal.Types.WorkDoneProgressCreateParams as Export +import Language.LSP.Protocol.Internal.Types.WorkDoneProgressEnd as Export +import Language.LSP.Protocol.Internal.Types.WorkDoneProgressOptions as Export +import Language.LSP.Protocol.Internal.Types.WorkDoneProgressParams as Export +import Language.LSP.Protocol.Internal.Types.WorkDoneProgressReport as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticParams as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticReport as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticReportPartialResult as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceDocumentDiagnosticReport as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceEdit as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceEditClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceFolder as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceFoldersChangeEvent as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceFoldersInitializeParams as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceFoldersServerCapabilities as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceFullDocumentDiagnosticReport as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceSymbol as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceSymbolClientCapabilities as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceSymbolOptions as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceSymbolParams as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceSymbolRegistrationOptions as Export +import Language.LSP.Protocol.Internal.Types.WorkspaceUnchangedDocumentDiagnosticReport as Export + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/AnnotatedTextEdit.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/AnnotatedTextEdit.hs new file mode 100644 index 000000000..cbc1124a1 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/AnnotatedTextEdit.hs @@ -0,0 +1,49 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.AnnotatedTextEdit where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +A special text edit with an additional change annotation. + +@since 3.16.0. + +-} +data AnnotatedTextEdit = AnnotatedTextEdit + { {-| + The range of the text document to be manipulated. To insert + text into a document create a range where start === end. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The string to be inserted. For delete operations use an + empty string. + + -} + _newText :: Data.Text.Text + , {-| + The actual identifier of the change annotation + + -} + _annotationId :: Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON AnnotatedTextEdit where + toJSON (AnnotatedTextEdit arg0 arg1 arg2) = Aeson.object $ concat $ [["range" Aeson..= arg0] + ,["newText" Aeson..= arg1] + ,["annotationId" Aeson..= arg2]] + +instance Aeson.FromJSON AnnotatedTextEdit where + parseJSON = Aeson.withObject "AnnotatedTextEdit" $ \arg -> AnnotatedTextEdit <$> arg Aeson..: "range" <*> arg Aeson..: "newText" <*> arg Aeson..: "annotationId" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditParams.hs new file mode 100644 index 000000000..3153d1c90 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditParams.hs @@ -0,0 +1,40 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceEdit +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters passed via a apply workspace edit request. + +-} +data ApplyWorkspaceEditParams = ApplyWorkspaceEditParams + { {-| + An optional label of the workspace edit. This label is + presented in the user interface for example on an undo + stack to undo the workspace edit. + + -} + _label :: (Maybe Data.Text.Text) + , {-| + The edits to apply. + + -} + _edit :: Language.LSP.Protocol.Internal.Types.WorkspaceEdit.WorkspaceEdit + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ApplyWorkspaceEditParams where + toJSON (ApplyWorkspaceEditParams arg0 arg1) = Aeson.object $ concat $ ["label" Language.LSP.Protocol.Types.Common..=? arg0 + ,["edit" Aeson..= arg1]] + +instance Aeson.FromJSON ApplyWorkspaceEditParams where + parseJSON = Aeson.withObject "ApplyWorkspaceEditParams" $ \arg -> ApplyWorkspaceEditParams <$> arg Aeson..:! "label" <*> arg Aeson..: "edit" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditResult.hs new file mode 100644 index 000000000..9d12cf7bd --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditResult.hs @@ -0,0 +1,49 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditResult where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +The result returned from the apply workspace edit request. + +@since 3.17 renamed from ApplyWorkspaceEditResponse + +-} +data ApplyWorkspaceEditResult = ApplyWorkspaceEditResult + { {-| + Indicates whether the edit was applied or not. + + -} + _applied :: Bool + , {-| + An optional textual description for why the edit was not applied. + This may be used by the server for diagnostic logging or to provide + a suitable error for a request that triggered the edit. + + -} + _failureReason :: (Maybe Data.Text.Text) + , {-| + Depending on the client's failure handling strategy `failedChange` might + contain the index of the change that failed. This property is only available + if the client signals a `failureHandlingStrategy` in its client capabilities. + + -} + _failedChange :: (Maybe Language.LSP.Protocol.Types.Common.UInt) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ApplyWorkspaceEditResult where + toJSON (ApplyWorkspaceEditResult arg0 arg1 arg2) = Aeson.object $ concat $ [["applied" Aeson..= arg0] + ,"failureReason" Language.LSP.Protocol.Types.Common..=? arg1 + ,"failedChange" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON ApplyWorkspaceEditResult where + parseJSON = Aeson.withObject "ApplyWorkspaceEditResult" $ \arg -> ApplyWorkspaceEditResult <$> arg Aeson..: "applied" <*> arg Aeson..:! "failureReason" <*> arg Aeson..:! "failedChange" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/BaseSymbolInformation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/BaseSymbolInformation.hs new file mode 100644 index 000000000..cb8029503 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/BaseSymbolInformation.hs @@ -0,0 +1,56 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.BaseSymbolInformation where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.SymbolKind +import qualified Language.LSP.Protocol.Internal.Types.SymbolTag +import qualified Language.LSP.Protocol.Types.Common + +{-| +A base for all symbol information. + +-} +data BaseSymbolInformation = BaseSymbolInformation + { {-| + The name of this symbol. + + -} + _name :: Data.Text.Text + , {-| + The kind of this symbol. + + -} + _kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind + , {-| + Tags for this symbol. + + @since 3.16.0 + + -} + _tags :: (Maybe [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag]) + , {-| + The name of the symbol containing this symbol. This information is for + user interface purposes (e.g. to render a qualifier in the user interface + if necessary). It can't be used to re-infer a hierarchy for the document + symbols. + + -} + _containerName :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON BaseSymbolInformation where + toJSON (BaseSymbolInformation arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["name" Aeson..= arg0] + ,["kind" Aeson..= arg1] + ,"tags" Language.LSP.Protocol.Types.Common..=? arg2 + ,"containerName" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON BaseSymbolInformation where + parseJSON = Aeson.withObject "BaseSymbolInformation" $ \arg -> BaseSymbolInformation <$> arg Aeson..: "name" <*> arg Aeson..: "kind" <*> arg Aeson..:! "tags" <*> arg Aeson..:! "containerName" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyClientCapabilities.hs new file mode 100644 index 000000000..a4373eace --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyClientCapabilities.hs @@ -0,0 +1,32 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CallHierarchyClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data CallHierarchyClientCapabilities = CallHierarchyClientCapabilities + { {-| + Whether implementation supports dynamic registration. If this is set to `true` + the client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)` + return value for the corresponding server capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CallHierarchyClientCapabilities where + toJSON (CallHierarchyClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON CallHierarchyClientCapabilities where + parseJSON = Aeson.withObject "CallHierarchyClientCapabilities" $ \arg -> CallHierarchyClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCall.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCall.hs new file mode 100644 index 000000000..11099d7d6 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCall.hs @@ -0,0 +1,41 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCall where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyItem +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents an incoming call, e.g. a caller of a method or constructor. + +@since 3.16.0 + +-} +data CallHierarchyIncomingCall = CallHierarchyIncomingCall + { {-| + The item that makes the call. + + -} + _from :: Language.LSP.Protocol.Internal.Types.CallHierarchyItem.CallHierarchyItem + , {-| + The ranges at which the calls appear. This is relative to the caller + denoted by `CallHierarchyIncomingCall.from`. + + -} + _fromRanges :: [Language.LSP.Protocol.Internal.Types.Range.Range] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CallHierarchyIncomingCall where + toJSON (CallHierarchyIncomingCall arg0 arg1) = Aeson.object $ concat $ [["from" Aeson..= arg0] + ,["fromRanges" Aeson..= arg1]] + +instance Aeson.FromJSON CallHierarchyIncomingCall where + parseJSON = Aeson.withObject "CallHierarchyIncomingCall" $ \arg -> CallHierarchyIncomingCall <$> arg Aeson..: "from" <*> arg Aeson..: "fromRanges" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCallsParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCallsParams.hs new file mode 100644 index 000000000..81c3a4d37 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCallsParams.hs @@ -0,0 +1,46 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCallsParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyItem +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameter of a `callHierarchy/incomingCalls` request. + +@since 3.16.0 + +-} +data CallHierarchyIncomingCallsParams = CallHierarchyIncomingCallsParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + + -} + _item :: Language.LSP.Protocol.Internal.Types.CallHierarchyItem.CallHierarchyItem + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CallHierarchyIncomingCallsParams where + toJSON (CallHierarchyIncomingCallsParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["item" Aeson..= arg2]] + +instance Aeson.FromJSON CallHierarchyIncomingCallsParams where + parseJSON = Aeson.withObject "CallHierarchyIncomingCallsParams" $ \arg -> CallHierarchyIncomingCallsParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "item" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyItem.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyItem.hs new file mode 100644 index 000000000..d5af73cc0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyItem.hs @@ -0,0 +1,83 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CallHierarchyItem where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Internal.Types.SymbolKind +import qualified Language.LSP.Protocol.Internal.Types.SymbolTag +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +Represents programming constructs like functions or constructors in the context +of call hierarchy. + +@since 3.16.0 + +-} +data CallHierarchyItem = CallHierarchyItem + { {-| + The name of this item. + + -} + _name :: Data.Text.Text + , {-| + The kind of this item. + + -} + _kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind + , {-| + Tags for this item. + + -} + _tags :: (Maybe [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag]) + , {-| + More detail for this item, e.g. the signature of a function. + + -} + _detail :: (Maybe Data.Text.Text) + , {-| + The resource identifier of this item. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The range enclosing this symbol not including leading/trailing whitespace but everything else, e.g. comments and code. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The range that should be selected and revealed when this symbol is being picked, e.g. the name of a function. + Must be contained by the `CallHierarchyItem.range`. + + -} + _selectionRange :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + A data entry field that is preserved between a call hierarchy prepare and + incoming calls or outgoing calls requests. + + -} + _data_ :: (Maybe Data.Aeson.Value) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CallHierarchyItem where + toJSON (CallHierarchyItem arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7) = Aeson.object $ concat $ [["name" Aeson..= arg0] + ,["kind" Aeson..= arg1] + ,"tags" Language.LSP.Protocol.Types.Common..=? arg2 + ,"detail" Language.LSP.Protocol.Types.Common..=? arg3 + ,["uri" Aeson..= arg4] + ,["range" Aeson..= arg5] + ,["selectionRange" Aeson..= arg6] + ,"data" Language.LSP.Protocol.Types.Common..=? arg7] + +instance Aeson.FromJSON CallHierarchyItem where + parseJSON = Aeson.withObject "CallHierarchyItem" $ \arg -> CallHierarchyItem <$> arg Aeson..: "name" <*> arg Aeson..: "kind" <*> arg Aeson..:! "tags" <*> arg Aeson..:! "detail" <*> arg Aeson..: "uri" <*> arg Aeson..: "range" <*> arg Aeson..: "selectionRange" <*> arg Aeson..:! "data" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOptions.hs new file mode 100644 index 000000000..97cae261b --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOptions.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CallHierarchyOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Call hierarchy options used during static registration. + +@since 3.16.0 + +-} +data CallHierarchyOptions = CallHierarchyOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CallHierarchyOptions where + toJSON (CallHierarchyOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON CallHierarchyOptions where + parseJSON = Aeson.withObject "CallHierarchyOptions" $ \arg -> CallHierarchyOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCall.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCall.hs new file mode 100644 index 000000000..e584ff357 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCall.hs @@ -0,0 +1,42 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCall where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyItem +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents an outgoing call, e.g. calling a getter from a method or a method from a constructor etc. + +@since 3.16.0 + +-} +data CallHierarchyOutgoingCall = CallHierarchyOutgoingCall + { {-| + The item that is called. + + -} + _to :: Language.LSP.Protocol.Internal.Types.CallHierarchyItem.CallHierarchyItem + , {-| + The range at which this item is called. This is the range relative to the caller, e.g the item + passed to `CallHierarchyItemProvider.provideCallHierarchyOutgoingCalls` + and not `CallHierarchyOutgoingCall.to`. + + -} + _fromRanges :: [Language.LSP.Protocol.Internal.Types.Range.Range] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CallHierarchyOutgoingCall where + toJSON (CallHierarchyOutgoingCall arg0 arg1) = Aeson.object $ concat $ [["to" Aeson..= arg0] + ,["fromRanges" Aeson..= arg1]] + +instance Aeson.FromJSON CallHierarchyOutgoingCall where + parseJSON = Aeson.withObject "CallHierarchyOutgoingCall" $ \arg -> CallHierarchyOutgoingCall <$> arg Aeson..: "to" <*> arg Aeson..: "fromRanges" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCallsParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCallsParams.hs new file mode 100644 index 000000000..d29573225 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCallsParams.hs @@ -0,0 +1,46 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCallsParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyItem +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameter of a `callHierarchy/outgoingCalls` request. + +@since 3.16.0 + +-} +data CallHierarchyOutgoingCallsParams = CallHierarchyOutgoingCallsParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + + -} + _item :: Language.LSP.Protocol.Internal.Types.CallHierarchyItem.CallHierarchyItem + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CallHierarchyOutgoingCallsParams where + toJSON (CallHierarchyOutgoingCallsParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["item" Aeson..= arg2]] + +instance Aeson.FromJSON CallHierarchyOutgoingCallsParams where + parseJSON = Aeson.withObject "CallHierarchyOutgoingCallsParams" $ \arg -> CallHierarchyOutgoingCallsParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "item" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyPrepareParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyPrepareParams.hs new file mode 100644 index 000000000..1fbd58369 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyPrepareParams.hs @@ -0,0 +1,47 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CallHierarchyPrepareParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameter of a `textDocument/prepareCallHierarchy` request. + +@since 3.16.0 + +-} +data CallHierarchyPrepareParams = CallHierarchyPrepareParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CallHierarchyPrepareParams where + toJSON (CallHierarchyPrepareParams arg0 arg1 arg2) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON CallHierarchyPrepareParams where + parseJSON = Aeson.withObject "CallHierarchyPrepareParams" $ \arg -> CallHierarchyPrepareParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyRegistrationOptions.hs new file mode 100644 index 000000000..edaebc775 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyRegistrationOptions.hs @@ -0,0 +1,47 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CallHierarchyRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Call hierarchy options used during static or dynamic registration. + +@since 3.16.0 + +-} +data CallHierarchyRegistrationOptions = CallHierarchyRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CallHierarchyRegistrationOptions where + toJSON (CallHierarchyRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"id" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON CallHierarchyRegistrationOptions where + parseJSON = Aeson.withObject "CallHierarchyRegistrationOptions" $ \arg -> CallHierarchyRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CancelParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CancelParams.hs new file mode 100644 index 000000000..f6b6e11c4 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CancelParams.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CancelParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data CancelParams = CancelParams + { {-| + The request id to cancel. + + -} + _id :: (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CancelParams where + toJSON (CancelParams arg0) = Aeson.object $ concat $ [["id" Aeson..= arg0]] + +instance Aeson.FromJSON CancelParams where + parseJSON = Aeson.withObject "CancelParams" $ \arg -> CancelParams <$> arg Aeson..: "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotation.hs new file mode 100644 index 000000000..1df09406a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotation.hs @@ -0,0 +1,48 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ChangeAnnotation where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Additional information that describes document changes. + +@since 3.16.0 + +-} +data ChangeAnnotation = ChangeAnnotation + { {-| + A human-readable string describing the actual change. The string + is rendered prominent in the user interface. + + -} + _label :: Data.Text.Text + , {-| + A flag which indicates that user confirmation is needed + before applying the change. + + -} + _needsConfirmation :: (Maybe Bool) + , {-| + A human-readable string which is rendered less prominent in + the user interface. + + -} + _description :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ChangeAnnotation where + toJSON (ChangeAnnotation arg0 arg1 arg2) = Aeson.object $ concat $ [["label" Aeson..= arg0] + ,"needsConfirmation" Language.LSP.Protocol.Types.Common..=? arg1 + ,"description" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON ChangeAnnotation where + parseJSON = Aeson.withObject "ChangeAnnotation" $ \arg -> ChangeAnnotation <$> arg Aeson..: "label" <*> arg Aeson..:! "needsConfirmation" <*> arg Aeson..:! "description" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotationIdentifier.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotationIdentifier.hs new file mode 100644 index 000000000..555ce92ff --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotationIdentifier.hs @@ -0,0 +1,22 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text + +{-| +An identifier to refer to a change annotation stored with a workspace edit. + +-} +newtype ChangeAnnotationIdentifier = ChangeAnnotationIdentifier Data.Text.Text + deriving stock (Show, Eq, Ord, Generic) + deriving newtype ( Aeson.ToJSON + , Aeson.FromJSON + , Aeson.ToJSONKey + , Aeson.FromJSONKey ) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCapabilities.hs new file mode 100644 index 000000000..5bc2bfe89 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCapabilities.hs @@ -0,0 +1,70 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.GeneralClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.WindowClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceClientCapabilities +import qualified Language.LSP.Protocol.Types.Common + +{-| +Defines the capabilities provided by the client. + +-} +data ClientCapabilities = ClientCapabilities + { {-| + Workspace specific client capabilities. + + -} + _workspace :: (Maybe Language.LSP.Protocol.Internal.Types.WorkspaceClientCapabilities.WorkspaceClientCapabilities) + , {-| + Text document specific client capabilities. + + -} + _textDocument :: (Maybe Language.LSP.Protocol.Internal.Types.TextDocumentClientCapabilities.TextDocumentClientCapabilities) + , {-| + Capabilities specific to the notebook document support. + + @since 3.17.0 + + -} + _notebookDocument :: (Maybe Language.LSP.Protocol.Internal.Types.NotebookDocumentClientCapabilities.NotebookDocumentClientCapabilities) + , {-| + Window specific client capabilities. + + -} + _window :: (Maybe Language.LSP.Protocol.Internal.Types.WindowClientCapabilities.WindowClientCapabilities) + , {-| + General client capabilities. + + @since 3.16.0 + + -} + _general :: (Maybe Language.LSP.Protocol.Internal.Types.GeneralClientCapabilities.GeneralClientCapabilities) + , {-| + Experimental client capabilities. + + -} + _experimental :: (Maybe Data.Aeson.Value) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ClientCapabilities where + toJSON (ClientCapabilities arg0 arg1 arg2 arg3 arg4 arg5) = Aeson.object $ concat $ ["workspace" Language.LSP.Protocol.Types.Common..=? arg0 + ,"textDocument" Language.LSP.Protocol.Types.Common..=? arg1 + ,"notebookDocument" Language.LSP.Protocol.Types.Common..=? arg2 + ,"window" Language.LSP.Protocol.Types.Common..=? arg3 + ,"general" Language.LSP.Protocol.Types.Common..=? arg4 + ,"experimental" Language.LSP.Protocol.Types.Common..=? arg5] + +instance Aeson.FromJSON ClientCapabilities where + parseJSON = Aeson.withObject "ClientCapabilities" $ \arg -> ClientCapabilities <$> arg Aeson..:! "workspace" <*> arg Aeson..:! "textDocument" <*> arg Aeson..:! "notebookDocument" <*> arg Aeson..:! "window" <*> arg Aeson..:! "general" <*> arg Aeson..:! "experimental" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeAction.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeAction.hs new file mode 100644 index 000000000..d641b61a0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeAction.hs @@ -0,0 +1,109 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeAction where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.CodeActionKind +import qualified Language.LSP.Protocol.Internal.Types.Command +import qualified Language.LSP.Protocol.Internal.Types.Diagnostic +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceEdit +import qualified Language.LSP.Protocol.Types.Common + +{-| +A code action represents a change that can be performed in code, e.g. to fix a problem or +to refactor code. + +A CodeAction must set either `edit` and/or a `command`. If both are supplied, the `edit` is applied first, then the `command` is executed. + +-} +data CodeAction = CodeAction + { {-| + A short, human-readable, title for this code action. + + -} + _title :: Data.Text.Text + , {-| + The kind of the code action. + + Used to filter code actions. + + -} + _kind :: (Maybe Language.LSP.Protocol.Internal.Types.CodeActionKind.CodeActionKind) + , {-| + The diagnostics that this code action resolves. + + -} + _diagnostics :: (Maybe [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic]) + , {-| + Marks this as a preferred action. Preferred actions are used by the `auto fix` command and can be targeted + by keybindings. + + A quick fix should be marked preferred if it properly addresses the underlying error. + A refactoring should be marked preferred if it is the most reasonable choice of actions to take. + + @since 3.15.0 + + -} + _isPreferred :: (Maybe Bool) + , {-| + Marks that the code action cannot currently be applied. + + Clients should follow the following guidelines regarding disabled code actions: + + - Disabled code actions are not shown in automatic [lightbulbs](https://code.visualstudio.com/docs/editor/editingevolved#_code-action) + code action menus. + + - Disabled actions are shown as faded out in the code action menu when the user requests a more specific type + of code action, such as refactorings. + + - If the user has a [keybinding](https://code.visualstudio.com/docs/editor/refactoring#_keybindings-for-code-actions) + that auto applies a code action and only disabled code actions are returned, the client should show the user an + error message with `reason` in the editor. + + @since 3.16.0 + + -} + _disabled :: (Maybe (Row.Rec ("reason" Row..== Data.Text.Text Row..+ Row.Empty))) + , {-| + The workspace edit this code action performs. + + -} + _edit :: (Maybe Language.LSP.Protocol.Internal.Types.WorkspaceEdit.WorkspaceEdit) + , {-| + A command this code action executes. If a code action + provides an edit and a command, first the edit is + executed and then the command. + + -} + _command :: (Maybe Language.LSP.Protocol.Internal.Types.Command.Command) + , {-| + A data entry field that is preserved on a code action between + a `textDocument/codeAction` and a `codeAction/resolve` request. + + @since 3.16.0 + + -} + _data_ :: (Maybe Data.Aeson.Value) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeAction where + toJSON (CodeAction arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7) = Aeson.object $ concat $ [["title" Aeson..= arg0] + ,"kind" Language.LSP.Protocol.Types.Common..=? arg1 + ,"diagnostics" Language.LSP.Protocol.Types.Common..=? arg2 + ,"isPreferred" Language.LSP.Protocol.Types.Common..=? arg3 + ,"disabled" Language.LSP.Protocol.Types.Common..=? arg4 + ,"edit" Language.LSP.Protocol.Types.Common..=? arg5 + ,"command" Language.LSP.Protocol.Types.Common..=? arg6 + ,"data" Language.LSP.Protocol.Types.Common..=? arg7] + +instance Aeson.FromJSON CodeAction where + parseJSON = Aeson.withObject "CodeAction" $ \arg -> CodeAction <$> arg Aeson..: "title" <*> arg Aeson..:! "kind" <*> arg Aeson..:! "diagnostics" <*> arg Aeson..:! "isPreferred" <*> arg Aeson..:! "disabled" <*> arg Aeson..:! "edit" <*> arg Aeson..:! "command" <*> arg Aeson..:! "data" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionClientCapabilities.hs new file mode 100644 index 000000000..82258be6a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionClientCapabilities.hs @@ -0,0 +1,90 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeActionClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.CodeActionKind +import qualified Language.LSP.Protocol.Types.Common + +{-| +The Client Capabilities of a `CodeActionRequest`. + +-} +data CodeActionClientCapabilities = CodeActionClientCapabilities + { {-| + Whether code action supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + The client support code action literals of type `CodeAction` as a valid + response of the `textDocument/codeAction` request. If the property is not + set the request can only return `Command` literals. + + @since 3.8.0 + + -} + _codeActionLiteralSupport :: (Maybe (Row.Rec ("codeActionKind" Row..== (Row.Rec ("valueSet" Row..== [Language.LSP.Protocol.Internal.Types.CodeActionKind.CodeActionKind] Row..+ Row.Empty)) Row..+ Row.Empty))) + , {-| + Whether code action supports the `isPreferred` property. + + @since 3.15.0 + + -} + _isPreferredSupport :: (Maybe Bool) + , {-| + Whether code action supports the `disabled` property. + + @since 3.16.0 + + -} + _disabledSupport :: (Maybe Bool) + , {-| + Whether code action supports the `data` property which is + preserved between a `textDocument/codeAction` and a + `codeAction/resolve` request. + + @since 3.16.0 + + -} + _dataSupport :: (Maybe Bool) + , {-| + Whether the client supports resolving additional code action + properties via a separate `codeAction/resolve` request. + + @since 3.16.0 + + -} + _resolveSupport :: (Maybe (Row.Rec ("properties" Row..== [Data.Text.Text] Row..+ Row.Empty))) + , {-| + Whether the client honors the change annotations in + text edits and resource operations returned via the + `CodeAction#edit` property by for example presenting + the workspace edit in the user interface and asking + for confirmation. + + @since 3.16.0 + + -} + _honorsChangeAnnotations :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeActionClientCapabilities where + toJSON (CodeActionClientCapabilities arg0 arg1 arg2 arg3 arg4 arg5 arg6) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"codeActionLiteralSupport" Language.LSP.Protocol.Types.Common..=? arg1 + ,"isPreferredSupport" Language.LSP.Protocol.Types.Common..=? arg2 + ,"disabledSupport" Language.LSP.Protocol.Types.Common..=? arg3 + ,"dataSupport" Language.LSP.Protocol.Types.Common..=? arg4 + ,"resolveSupport" Language.LSP.Protocol.Types.Common..=? arg5 + ,"honorsChangeAnnotations" Language.LSP.Protocol.Types.Common..=? arg6] + +instance Aeson.FromJSON CodeActionClientCapabilities where + parseJSON = Aeson.withObject "CodeActionClientCapabilities" $ \arg -> CodeActionClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "codeActionLiteralSupport" <*> arg Aeson..:! "isPreferredSupport" <*> arg Aeson..:! "disabledSupport" <*> arg Aeson..:! "dataSupport" <*> arg Aeson..:! "resolveSupport" <*> arg Aeson..:! "honorsChangeAnnotations" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionContext.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionContext.hs new file mode 100644 index 000000000..e091b06ba --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionContext.hs @@ -0,0 +1,55 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeActionContext where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.CodeActionKind +import qualified Language.LSP.Protocol.Internal.Types.CodeActionTriggerKind +import qualified Language.LSP.Protocol.Internal.Types.Diagnostic +import qualified Language.LSP.Protocol.Types.Common + +{-| +Contains additional diagnostic information about the context in which +a `CodeActionProvider.provideCodeActions` is run. + +-} +data CodeActionContext = CodeActionContext + { {-| + An array of diagnostics known on the client side overlapping the range provided to the + `textDocument/codeAction` request. They are provided so that the server knows which + errors are currently presented to the user for the given range. There is no guarantee + that these accurately reflect the error state of the resource. The primary parameter + to compute code actions is the provided range. + + -} + _diagnostics :: [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic] + , {-| + Requested kind of actions to return. + + Actions not of this kind are filtered out by the client before being shown. So servers + can omit computing them. + + -} + _only :: (Maybe [Language.LSP.Protocol.Internal.Types.CodeActionKind.CodeActionKind]) + , {-| + The reason why code actions were requested. + + @since 3.17.0 + + -} + _triggerKind :: (Maybe Language.LSP.Protocol.Internal.Types.CodeActionTriggerKind.CodeActionTriggerKind) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeActionContext where + toJSON (CodeActionContext arg0 arg1 arg2) = Aeson.object $ concat $ [["diagnostics" Aeson..= arg0] + ,"only" Language.LSP.Protocol.Types.Common..=? arg1 + ,"triggerKind" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON CodeActionContext where + parseJSON = Aeson.withObject "CodeActionContext" $ \arg -> CodeActionContext <$> arg Aeson..: "diagnostics" <*> arg Aeson..:! "only" <*> arg Aeson..:! "triggerKind" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionKind.hs new file mode 100644 index 000000000..6acc9946a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionKind.hs @@ -0,0 +1,136 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeActionKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +A set of predefined code action kinds + +-} +data CodeActionKind = + {-| + Empty kind. + + -} + CodeActionKind_Empty + | {-| + Base kind for quickfix actions: 'quickfix' + + -} + CodeActionKind_QuickFix + | {-| + Base kind for refactoring actions: 'refactor' + + -} + CodeActionKind_Refactor + | {-| + Base kind for refactoring extraction actions: 'refactor.extract' + + Example extract actions: + + - Extract method + - Extract function + - Extract variable + - Extract interface from class + - ... + + -} + CodeActionKind_RefactorExtract + | {-| + Base kind for refactoring inline actions: 'refactor.inline' + + Example inline actions: + + - Inline function + - Inline variable + - Inline constant + - ... + + -} + CodeActionKind_RefactorInline + | {-| + Base kind for refactoring rewrite actions: 'refactor.rewrite' + + Example rewrite actions: + + - Convert JavaScript function to class + - Add or remove parameter + - Encapsulate field + - Make method static + - Move method to base class + - ... + + -} + CodeActionKind_RefactorRewrite + | {-| + Base kind for source actions: `source` + + Source code actions apply to the entire file. + + -} + CodeActionKind_Source + | {-| + Base kind for an organize imports source action: `source.organizeImports` + + -} + CodeActionKind_SourceOrganizeImports + | {-| + Base kind for auto-fix source actions: `source.fixAll`. + + Fix all actions automatically fix errors that have a clear fix that do not require user input. + They should not suppress errors or perform unsafe fixes such as generating new types or classes. + + @since 3.15.0 + + -} + CodeActionKind_SourceFixAll + | CodeActionKind_Custom Data.Text.Text + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON + , Data.String.IsString ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum CodeActionKind Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum CodeActionKind where + knownValues = Data.Set.fromList [CodeActionKind_Empty + ,CodeActionKind_QuickFix + ,CodeActionKind_Refactor + ,CodeActionKind_RefactorExtract + ,CodeActionKind_RefactorInline + ,CodeActionKind_RefactorRewrite + ,CodeActionKind_Source + ,CodeActionKind_SourceOrganizeImports + ,CodeActionKind_SourceFixAll] + type EnumBaseType CodeActionKind = Data.Text.Text + toEnumBaseType CodeActionKind_Empty = "" + toEnumBaseType CodeActionKind_QuickFix = "quickfix" + toEnumBaseType CodeActionKind_Refactor = "refactor" + toEnumBaseType CodeActionKind_RefactorExtract = "refactor.extract" + toEnumBaseType CodeActionKind_RefactorInline = "refactor.inline" + toEnumBaseType CodeActionKind_RefactorRewrite = "refactor.rewrite" + toEnumBaseType CodeActionKind_Source = "source" + toEnumBaseType CodeActionKind_SourceOrganizeImports = "source.organizeImports" + toEnumBaseType CodeActionKind_SourceFixAll = "source.fixAll" + toEnumBaseType (CodeActionKind_Custom arg) = arg + +instance Language.LSP.Protocol.Types.LspEnum.LspOpenEnum CodeActionKind where + fromOpenEnumBaseType "" = CodeActionKind_Empty + fromOpenEnumBaseType "quickfix" = CodeActionKind_QuickFix + fromOpenEnumBaseType "refactor" = CodeActionKind_Refactor + fromOpenEnumBaseType "refactor.extract" = CodeActionKind_RefactorExtract + fromOpenEnumBaseType "refactor.inline" = CodeActionKind_RefactorInline + fromOpenEnumBaseType "refactor.rewrite" = CodeActionKind_RefactorRewrite + fromOpenEnumBaseType "source" = CodeActionKind_Source + fromOpenEnumBaseType "source.organizeImports" = CodeActionKind_SourceOrganizeImports + fromOpenEnumBaseType "source.fixAll" = CodeActionKind_SourceFixAll + fromOpenEnumBaseType arg = CodeActionKind_Custom arg + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionOptions.hs new file mode 100644 index 000000000..2d4710606 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionOptions.hs @@ -0,0 +1,48 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeActionOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.CodeActionKind +import qualified Language.LSP.Protocol.Types.Common + +{-| +Provider options for a `CodeActionRequest`. + +-} +data CodeActionOptions = CodeActionOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + CodeActionKinds that this server may return. + + The list of kinds may be generic, such as `CodeActionKind.Refactor`, or the server + may list out every specific kind they provide. + + -} + _codeActionKinds :: (Maybe [Language.LSP.Protocol.Internal.Types.CodeActionKind.CodeActionKind]) + , {-| + The server provides support to resolve additional + information for a code action. + + @since 3.16.0 + + -} + _resolveProvider :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeActionOptions where + toJSON (CodeActionOptions arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"codeActionKinds" Language.LSP.Protocol.Types.Common..=? arg1 + ,"resolveProvider" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON CodeActionOptions where + parseJSON = Aeson.withObject "CodeActionOptions" $ \arg -> CodeActionOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "codeActionKinds" <*> arg Aeson..:! "resolveProvider" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionParams.hs new file mode 100644 index 000000000..434b7d306 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionParams.hs @@ -0,0 +1,59 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeActionParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.CodeActionContext +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a `CodeActionRequest`. + +-} +data CodeActionParams = CodeActionParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The document in which the command was invoked. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The range for which the command was invoked. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + Context carrying additional information. + + -} + _context :: Language.LSP.Protocol.Internal.Types.CodeActionContext.CodeActionContext + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeActionParams where + toJSON (CodeActionParams arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["textDocument" Aeson..= arg2] + ,["range" Aeson..= arg3] + ,["context" Aeson..= arg4]] + +instance Aeson.FromJSON CodeActionParams where + parseJSON = Aeson.withObject "CodeActionParams" $ \arg -> CodeActionParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "textDocument" <*> arg Aeson..: "range" <*> arg Aeson..: "context" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionRegistrationOptions.hs new file mode 100644 index 000000000..c48c3b726 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionRegistrationOptions.hs @@ -0,0 +1,56 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeActionRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.CodeActionKind +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `CodeActionRequest`. + +-} +data CodeActionRegistrationOptions = CodeActionRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + CodeActionKinds that this server may return. + + The list of kinds may be generic, such as `CodeActionKind.Refactor`, or the server + may list out every specific kind they provide. + + -} + _codeActionKinds :: (Maybe [Language.LSP.Protocol.Internal.Types.CodeActionKind.CodeActionKind]) + , {-| + The server provides support to resolve additional + information for a code action. + + @since 3.16.0 + + -} + _resolveProvider :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeActionRegistrationOptions where + toJSON (CodeActionRegistrationOptions arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"codeActionKinds" Language.LSP.Protocol.Types.Common..=? arg2 + ,"resolveProvider" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON CodeActionRegistrationOptions where + parseJSON = Aeson.withObject "CodeActionRegistrationOptions" $ \arg -> CodeActionRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "codeActionKinds" <*> arg Aeson..:! "resolveProvider" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionTriggerKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionTriggerKind.hs new file mode 100644 index 000000000..13f36bf04 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionTriggerKind.hs @@ -0,0 +1,49 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeActionTriggerKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +The reason why code actions were requested. + +@since 3.17.0 + +-} +data CodeActionTriggerKind = + {-| + Code actions were explicitly requested by the user or by an extension. + + -} + CodeActionTriggerKind_Invoked + | {-| + Code actions were requested automatically. + + This typically happens when current selection in a file changes, but can + also be triggered when file content changes. + + -} + CodeActionTriggerKind_Automatic + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum CodeActionTriggerKind Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum CodeActionTriggerKind where + knownValues = Data.Set.fromList [CodeActionTriggerKind_Invoked + ,CodeActionTriggerKind_Automatic] + type EnumBaseType CodeActionTriggerKind = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType CodeActionTriggerKind_Invoked = 1 + toEnumBaseType CodeActionTriggerKind_Automatic = 2 + fromEnumBaseType 1 = pure CodeActionTriggerKind_Invoked + fromEnumBaseType 2 = pure CodeActionTriggerKind_Automatic + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeDescription.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeDescription.hs new file mode 100644 index 000000000..6c8109d4c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeDescription.hs @@ -0,0 +1,33 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeDescription where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +Structure to capture a description for an error code. + +@since 3.16.0 + +-} +data CodeDescription = CodeDescription + { {-| + An URI to open with more information about the diagnostic error. + + -} + _href :: Language.LSP.Protocol.Types.Uri.Uri + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeDescription where + toJSON (CodeDescription arg0) = Aeson.object $ concat $ [["href" Aeson..= arg0]] + +instance Aeson.FromJSON CodeDescription where + parseJSON = Aeson.withObject "CodeDescription" $ \arg -> CodeDescription <$> arg Aeson..: "href" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLens.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLens.hs new file mode 100644 index 000000000..6e6582cd5 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLens.hs @@ -0,0 +1,50 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeLens where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Command +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +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. + +-} +data CodeLens = CodeLens + { {-| + The range in which this code lens is valid. Should only span a single line. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The command this code lens represents. + + -} + _command :: (Maybe Language.LSP.Protocol.Internal.Types.Command.Command) + , {-| + A data entry field that is preserved on a code lens item between + a `CodeLensRequest` and a `CodeLensResolveRequest` + + -} + _data_ :: (Maybe Data.Aeson.Value) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeLens where + toJSON (CodeLens arg0 arg1 arg2) = Aeson.object $ concat $ [["range" Aeson..= arg0] + ,"command" Language.LSP.Protocol.Types.Common..=? arg1 + ,"data" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON CodeLens where + parseJSON = Aeson.withObject "CodeLens" $ \arg -> CodeLens <$> arg Aeson..: "range" <*> arg Aeson..:! "command" <*> arg Aeson..:! "data" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensClientCapabilities.hs new file mode 100644 index 000000000..7b217b7a7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensClientCapabilities.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeLensClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +The client capabilities of a `CodeLensRequest`. + +-} +data CodeLensClientCapabilities = CodeLensClientCapabilities + { {-| + Whether code lens supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeLensClientCapabilities where + toJSON (CodeLensClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON CodeLensClientCapabilities where + parseJSON = Aeson.withObject "CodeLensClientCapabilities" $ \arg -> CodeLensClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensOptions.hs new file mode 100644 index 000000000..d32b50104 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensOptions.hs @@ -0,0 +1,35 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeLensOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Code Lens provider options of a `CodeLensRequest`. + +-} +data CodeLensOptions = CodeLensOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + Code lens has a resolve provider as well. + + -} + _resolveProvider :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeLensOptions where + toJSON (CodeLensOptions arg0 arg1) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"resolveProvider" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON CodeLensOptions where + parseJSON = Aeson.withObject "CodeLensOptions" $ \arg -> CodeLensOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "resolveProvider" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensParams.hs new file mode 100644 index 000000000..69df20686 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensParams.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeLensParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a `CodeLensRequest`. + +-} +data CodeLensParams = CodeLensParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The document to request code lens for. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeLensParams where + toJSON (CodeLensParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["textDocument" Aeson..= arg2]] + +instance Aeson.FromJSON CodeLensParams where + parseJSON = Aeson.withObject "CodeLensParams" $ \arg -> CodeLensParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "textDocument" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensRegistrationOptions.hs new file mode 100644 index 000000000..df2fcaa3a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensRegistrationOptions.hs @@ -0,0 +1,43 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeLensRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `CodeLensRequest`. + +-} +data CodeLensRegistrationOptions = CodeLensRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + Code lens has a resolve provider as well. + + -} + _resolveProvider :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeLensRegistrationOptions where + toJSON (CodeLensRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"resolveProvider" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON CodeLensRegistrationOptions where + parseJSON = Aeson.withObject "CodeLensRegistrationOptions" $ \arg -> CodeLensRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "resolveProvider" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensWorkspaceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensWorkspaceClientCapabilities.hs new file mode 100644 index 000000000..0caa34d5d --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensWorkspaceClientCapabilities.hs @@ -0,0 +1,36 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CodeLensWorkspaceClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data CodeLensWorkspaceClientCapabilities = CodeLensWorkspaceClientCapabilities + { {-| + Whether the client implementation supports a refresh request sent from the + server to the client. + + Note that this event is global and will force the client to refresh all + code lenses currently shown. It should be used with absolute care and is + useful for situation where a server for example detect a project wide + change that requires such a calculation. + + -} + _refreshSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CodeLensWorkspaceClientCapabilities where + toJSON (CodeLensWorkspaceClientCapabilities arg0) = Aeson.object $ concat $ ["refreshSupport" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON CodeLensWorkspaceClientCapabilities where + parseJSON = Aeson.withObject "CodeLensWorkspaceClientCapabilities" $ \arg -> CodeLensWorkspaceClientCapabilities <$> arg Aeson..:! "refreshSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Color.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Color.hs new file mode 100644 index 000000000..d44ae8936 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Color.hs @@ -0,0 +1,48 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Color where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents a color in RGBA space. + +-} +data Color = Color + { {-| + The red component of this color in the range [0-1]. + + -} + _red :: Float + , {-| + The green component of this color in the range [0-1]. + + -} + _green :: Float + , {-| + The blue component of this color in the range [0-1]. + + -} + _blue :: Float + , {-| + The alpha component of this color in the range [0-1]. + + -} + _alpha :: Float + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON Color where + toJSON (Color arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["red" Aeson..= arg0] + ,["green" Aeson..= arg1] + ,["blue" Aeson..= arg2] + ,["alpha" Aeson..= arg3]] + +instance Aeson.FromJSON Color where + parseJSON = Aeson.withObject "Color" $ \arg -> Color <$> arg Aeson..: "red" <*> arg Aeson..: "green" <*> arg Aeson..: "blue" <*> arg Aeson..: "alpha" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorInformation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorInformation.hs new file mode 100644 index 000000000..7db851196 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorInformation.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ColorInformation where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Color +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents a color range from a document. + +-} +data ColorInformation = ColorInformation + { {-| + The range in the document where this color appears. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The actual color value for this color range. + + -} + _color :: Language.LSP.Protocol.Internal.Types.Color.Color + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ColorInformation where + toJSON (ColorInformation arg0 arg1) = Aeson.object $ concat $ [["range" Aeson..= arg0] + ,["color" Aeson..= arg1]] + +instance Aeson.FromJSON ColorInformation where + parseJSON = Aeson.withObject "ColorInformation" $ \arg -> ColorInformation <$> arg Aeson..: "range" <*> arg Aeson..: "color" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentation.hs new file mode 100644 index 000000000..8ca607faf --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentation.hs @@ -0,0 +1,48 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ColorPresentation where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.TextEdit +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data ColorPresentation = ColorPresentation + { {-| + The label of this color presentation. It will be shown on the color + picker header. By default this is also the text that is inserted when selecting + this color presentation. + + -} + _label :: Data.Text.Text + , {-| + An `TextEdit` which is applied to a document when selecting + this presentation for the color. When `falsy` the `ColorPresentation.label` + is used. + + -} + _textEdit :: (Maybe Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit) + , {-| + An optional array of additional `TextEdit` that are applied when + selecting this color presentation. Edits must not overlap with the main `ColorPresentation.textEdit` nor with themselves. + + -} + _additionalTextEdits :: (Maybe [Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ColorPresentation where + toJSON (ColorPresentation arg0 arg1 arg2) = Aeson.object $ concat $ [["label" Aeson..= arg0] + ,"textEdit" Language.LSP.Protocol.Types.Common..=? arg1 + ,"additionalTextEdits" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON ColorPresentation where + parseJSON = Aeson.withObject "ColorPresentation" $ \arg -> ColorPresentation <$> arg Aeson..: "label" <*> arg Aeson..:! "textEdit" <*> arg Aeson..:! "additionalTextEdits" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentationParams.hs new file mode 100644 index 000000000..0a715d076 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentationParams.hs @@ -0,0 +1,59 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ColorPresentationParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Color +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +Parameters for a `ColorPresentationRequest`. + +-} +data ColorPresentationParams = ColorPresentationParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The color to request presentations for. + + -} + _color :: Language.LSP.Protocol.Internal.Types.Color.Color + , {-| + The range where the color would be inserted. Serves as a context. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ColorPresentationParams where + toJSON (ColorPresentationParams arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["textDocument" Aeson..= arg2] + ,["color" Aeson..= arg3] + ,["range" Aeson..= arg4]] + +instance Aeson.FromJSON ColorPresentationParams where + parseJSON = Aeson.withObject "ColorPresentationParams" $ \arg -> ColorPresentationParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "textDocument" <*> arg Aeson..: "color" <*> arg Aeson..: "range" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Command.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Command.hs new file mode 100644 index 000000000..15742d1ed --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Command.hs @@ -0,0 +1,48 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Command where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents a reference to a command. Provides a title which +will be used to represent a command in the UI and, optionally, +an array of arguments which will be passed to the command handler +function when invoked. + +-} +data Command = Command + { {-| + Title of the command, like `save`. + + -} + _title :: Data.Text.Text + , {-| + The identifier of the actual command handler. + + -} + _command :: Data.Text.Text + , {-| + Arguments that the command handler should be + invoked with. + + -} + _arguments :: (Maybe [Data.Aeson.Value]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON Command where + toJSON (Command arg0 arg1 arg2) = Aeson.object $ concat $ [["title" Aeson..= arg0] + ,["command" Aeson..= arg1] + ,"arguments" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON Command where + parseJSON = Aeson.withObject "Command" $ \arg -> Command <$> arg Aeson..: "title" <*> arg Aeson..: "command" <*> arg Aeson..:! "arguments" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionClientCapabilities.hs new file mode 100644 index 000000000..c7d899c84 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionClientCapabilities.hs @@ -0,0 +1,74 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CompletionClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.CompletionItemKind +import qualified Language.LSP.Protocol.Internal.Types.CompletionItemTag +import qualified Language.LSP.Protocol.Internal.Types.InsertTextMode +import qualified Language.LSP.Protocol.Internal.Types.MarkupKind +import qualified Language.LSP.Protocol.Types.Common + +{-| +Completion client capabilities + +-} +data CompletionClientCapabilities = CompletionClientCapabilities + { {-| + Whether completion supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + The client supports the following `CompletionItem` specific + capabilities. + + -} + _completionItem :: (Maybe (Row.Rec ("snippetSupport" Row..== (Maybe Bool) Row..+ ("commitCharactersSupport" Row..== (Maybe Bool) Row..+ ("documentationFormat" Row..== (Maybe [Language.LSP.Protocol.Internal.Types.MarkupKind.MarkupKind]) Row..+ ("deprecatedSupport" Row..== (Maybe Bool) Row..+ ("preselectSupport" Row..== (Maybe Bool) Row..+ ("tagSupport" Row..== (Maybe (Row.Rec ("valueSet" Row..== [Language.LSP.Protocol.Internal.Types.CompletionItemTag.CompletionItemTag] Row..+ Row.Empty))) Row..+ ("insertReplaceSupport" Row..== (Maybe Bool) Row..+ ("resolveSupport" Row..== (Maybe (Row.Rec ("properties" Row..== [Data.Text.Text] Row..+ Row.Empty))) Row..+ ("insertTextModeSupport" Row..== (Maybe (Row.Rec ("valueSet" Row..== [Language.LSP.Protocol.Internal.Types.InsertTextMode.InsertTextMode] Row..+ Row.Empty))) Row..+ ("labelDetailsSupport" Row..== (Maybe Bool) Row..+ Row.Empty)))))))))))) + , {-| + + -} + _completionItemKind :: (Maybe (Row.Rec ("valueSet" Row..== (Maybe [Language.LSP.Protocol.Internal.Types.CompletionItemKind.CompletionItemKind]) Row..+ Row.Empty))) + , {-| + Defines how the client handles whitespace and indentation + when accepting a completion item that uses multi line + text in either `insertText` or `textEdit`. + + @since 3.17.0 + + -} + _insertTextMode :: (Maybe Language.LSP.Protocol.Internal.Types.InsertTextMode.InsertTextMode) + , {-| + The client supports to send additional context information for a + `textDocument/completion` request. + + -} + _contextSupport :: (Maybe Bool) + , {-| + The client supports the following `CompletionList` specific + capabilities. + + @since 3.17.0 + + -} + _completionList :: (Maybe (Row.Rec ("itemDefaults" Row..== (Maybe [Data.Text.Text]) Row..+ Row.Empty))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CompletionClientCapabilities where + toJSON (CompletionClientCapabilities arg0 arg1 arg2 arg3 arg4 arg5) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"completionItem" Language.LSP.Protocol.Types.Common..=? arg1 + ,"completionItemKind" Language.LSP.Protocol.Types.Common..=? arg2 + ,"insertTextMode" Language.LSP.Protocol.Types.Common..=? arg3 + ,"contextSupport" Language.LSP.Protocol.Types.Common..=? arg4 + ,"completionList" Language.LSP.Protocol.Types.Common..=? arg5] + +instance Aeson.FromJSON CompletionClientCapabilities where + parseJSON = Aeson.withObject "CompletionClientCapabilities" $ \arg -> CompletionClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "completionItem" <*> arg Aeson..:! "completionItemKind" <*> arg Aeson..:! "insertTextMode" <*> arg Aeson..:! "contextSupport" <*> arg Aeson..:! "completionList" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionContext.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionContext.hs new file mode 100644 index 000000000..50d06387a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionContext.hs @@ -0,0 +1,39 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CompletionContext where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.CompletionTriggerKind +import qualified Language.LSP.Protocol.Types.Common + +{-| +Contains additional information about the context in which a completion request is triggered. + +-} +data CompletionContext = CompletionContext + { {-| + How the completion was triggered. + + -} + _triggerKind :: Language.LSP.Protocol.Internal.Types.CompletionTriggerKind.CompletionTriggerKind + , {-| + The trigger character (a single character) that has trigger code complete. + Is undefined if `triggerKind !== CompletionTriggerKind.TriggerCharacter` + + -} + _triggerCharacter :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CompletionContext where + toJSON (CompletionContext arg0 arg1) = Aeson.object $ concat $ [["triggerKind" Aeson..= arg0] + ,"triggerCharacter" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON CompletionContext where + parseJSON = Aeson.withObject "CompletionContext" $ \arg -> CompletionContext <$> arg Aeson..: "triggerKind" <*> arg Aeson..:! "triggerCharacter" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItem.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItem.hs new file mode 100644 index 000000000..08b5da9fd --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItem.hs @@ -0,0 +1,230 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CompletionItem where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Command +import qualified Language.LSP.Protocol.Internal.Types.CompletionItemKind +import qualified Language.LSP.Protocol.Internal.Types.CompletionItemLabelDetails +import qualified Language.LSP.Protocol.Internal.Types.CompletionItemTag +import qualified Language.LSP.Protocol.Internal.Types.InsertReplaceEdit +import qualified Language.LSP.Protocol.Internal.Types.InsertTextFormat +import qualified Language.LSP.Protocol.Internal.Types.InsertTextMode +import qualified Language.LSP.Protocol.Internal.Types.MarkupContent +import qualified Language.LSP.Protocol.Internal.Types.TextEdit +import qualified Language.LSP.Protocol.Types.Common + +{-# DEPRECATED _deprecated "Use `tags` instead." #-} +{-| +A completion item represents a text snippet that is +proposed to complete text that is being typed. + +-} +data CompletionItem = CompletionItem + { {-| + The label of this completion item. + + The label property is also by default the text that + is inserted when selecting this completion. + + If label details are provided the label itself should + be an unqualified name of the completion item. + + -} + _label :: Data.Text.Text + , {-| + Additional details for the label + + @since 3.17.0 + + -} + _labelDetails :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionItemLabelDetails.CompletionItemLabelDetails) + , {-| + The kind of this completion item. Based of the kind + an icon is chosen by the editor. + + -} + _kind :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionItemKind.CompletionItemKind) + , {-| + Tags for this completion item. + + @since 3.15.0 + + -} + _tags :: (Maybe [Language.LSP.Protocol.Internal.Types.CompletionItemTag.CompletionItemTag]) + , {-| + A human-readable string with additional information + about this item, like type or symbol information. + + -} + _detail :: (Maybe Data.Text.Text) + , {-| + A human-readable string that represents a doc-comment. + + -} + _documentation :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.MarkupContent.MarkupContent)) + , {-| + Indicates if this item is deprecated. + @deprecated Use `tags` instead. + + -} + _deprecated :: (Maybe Bool) + , {-| + Select this item when showing. + + *Note* that only one completion item can be selected and that the + tool / client decides which item that is. The rule is that the *first* + item of those that match best is selected. + + -} + _preselect :: (Maybe Bool) + , {-| + A string that should be used when comparing this item + with other items. When `falsy` the `CompletionItem.label` + is used. + + -} + _sortText :: (Maybe Data.Text.Text) + , {-| + A string that should be used when filtering a set of + completion items. When `falsy` the `CompletionItem.label` + is used. + + -} + _filterText :: (Maybe Data.Text.Text) + , {-| + A string that should be inserted into a document when selecting + this completion. When `falsy` the `CompletionItem.label` + is used. + + The `insertText` is subject to interpretation by the client side. + Some tools might not take the string literally. For example + VS Code when code complete is requested in this example + `con` and a completion item with an `insertText` of + `console` is provided it will only insert `sole`. Therefore it is + recommended to use `textEdit` instead since it avoids additional client + side interpretation. + + -} + _insertText :: (Maybe Data.Text.Text) + , {-| + The format of the insert text. The format applies to both the + `insertText` property and the `newText` property of a provided + `textEdit`. If omitted defaults to `InsertTextFormat.PlainText`. + + Please note that the insertTextFormat doesn't apply to + `additionalTextEdits`. + + -} + _insertTextFormat :: (Maybe Language.LSP.Protocol.Internal.Types.InsertTextFormat.InsertTextFormat) + , {-| + How whitespace and indentation is handled during completion + item insertion. If not provided the clients default value depends on + the `textDocument.completion.insertTextMode` client capability. + + @since 3.16.0 + + -} + _insertTextMode :: (Maybe Language.LSP.Protocol.Internal.Types.InsertTextMode.InsertTextMode) + , {-| + An `TextEdit` which is applied to a document when selecting + this completion. When an edit is provided the value of + `CompletionItem.insertText` is ignored. + + Most editors support two different operations when accepting a completion + item. One is to insert a completion text and the other is to replace an + existing text with a completion text. Since this can usually not be + predetermined by a server it can report both ranges. Clients need to + signal support for `InsertReplaceEdits` via the + `textDocument.completion.insertReplaceSupport` client capability + property. + + *Note 1:* The text edit's range as well as both ranges from an insert + replace edit must be a [single line] and they must contain the position + at which completion has been requested. + *Note 2:* If an `InsertReplaceEdit` is returned the edit's insert range + must be a prefix of the edit's replace range, that means it must be + contained and starting at the same position. + + @since 3.16.0 additional type `InsertReplaceEdit` + + -} + _textEdit :: (Maybe (Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.InsertReplaceEdit.InsertReplaceEdit)) + , {-| + The edit text used if the completion item is part of a CompletionList and + CompletionList defines an item default for the text edit range. + + Clients will only honor this property if they opt into completion list + item defaults using the capability `completionList.itemDefaults`. + + If not provided and a list's default range is provided the label + property is used as a text. + + @since 3.17.0 + + -} + _textEditText :: (Maybe Data.Text.Text) + , {-| + An optional array of additional `TextEdit` that are applied when + selecting this completion. Edits must not overlap (including the same insert position) + with the main `CompletionItem.textEdit` nor with themselves. + + Additional text edits should be used to change text unrelated to the current cursor position + (for example adding an import statement at the top of the file if the completion item will + insert an unqualified type). + + -} + _additionalTextEdits :: (Maybe [Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit]) + , {-| + An optional set of characters that when pressed while this completion is active will accept it first and + then type that character. *Note* that all commit characters should have `length=1` and that superfluous + characters will be ignored. + + -} + _commitCharacters :: (Maybe [Data.Text.Text]) + , {-| + An optional `Command` that is executed *after* inserting this completion. *Note* that + additional modifications to the current document should be described with the + `CompletionItem.additionalTextEdits`-property. + + -} + _command :: (Maybe Language.LSP.Protocol.Internal.Types.Command.Command) + , {-| + A data entry field that is preserved on a completion item between a + `CompletionRequest`. + + -} + _data_ :: (Maybe Data.Aeson.Value) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CompletionItem where + toJSON (CompletionItem arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18) = Aeson.object $ concat $ [["label" Aeson..= arg0] + ,"labelDetails" Language.LSP.Protocol.Types.Common..=? arg1 + ,"kind" Language.LSP.Protocol.Types.Common..=? arg2 + ,"tags" Language.LSP.Protocol.Types.Common..=? arg3 + ,"detail" Language.LSP.Protocol.Types.Common..=? arg4 + ,"documentation" Language.LSP.Protocol.Types.Common..=? arg5 + ,"deprecated" Language.LSP.Protocol.Types.Common..=? arg6 + ,"preselect" Language.LSP.Protocol.Types.Common..=? arg7 + ,"sortText" Language.LSP.Protocol.Types.Common..=? arg8 + ,"filterText" Language.LSP.Protocol.Types.Common..=? arg9 + ,"insertText" Language.LSP.Protocol.Types.Common..=? arg10 + ,"insertTextFormat" Language.LSP.Protocol.Types.Common..=? arg11 + ,"insertTextMode" Language.LSP.Protocol.Types.Common..=? arg12 + ,"textEdit" Language.LSP.Protocol.Types.Common..=? arg13 + ,"textEditText" Language.LSP.Protocol.Types.Common..=? arg14 + ,"additionalTextEdits" Language.LSP.Protocol.Types.Common..=? arg15 + ,"commitCharacters" Language.LSP.Protocol.Types.Common..=? arg16 + ,"command" Language.LSP.Protocol.Types.Common..=? arg17 + ,"data" Language.LSP.Protocol.Types.Common..=? arg18] + +instance Aeson.FromJSON CompletionItem where + parseJSON = Aeson.withObject "CompletionItem" $ \arg -> CompletionItem <$> arg Aeson..: "label" <*> arg Aeson..:! "labelDetails" <*> arg Aeson..:! "kind" <*> arg Aeson..:! "tags" <*> arg Aeson..:! "detail" <*> arg Aeson..:! "documentation" <*> arg Aeson..:! "deprecated" <*> arg Aeson..:! "preselect" <*> arg Aeson..:! "sortText" <*> arg Aeson..:! "filterText" <*> arg Aeson..:! "insertText" <*> arg Aeson..:! "insertTextFormat" <*> arg Aeson..:! "insertTextMode" <*> arg Aeson..:! "textEdit" <*> arg Aeson..:! "textEditText" <*> arg Aeson..:! "additionalTextEdits" <*> arg Aeson..:! "commitCharacters" <*> arg Aeson..:! "command" <*> arg Aeson..:! "data" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemKind.hs new file mode 100644 index 000000000..c57b4d27f --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemKind.hs @@ -0,0 +1,203 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CompletionItemKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +The kind of a completion entry. + +-} +data CompletionItemKind = + {-| + + -} + CompletionItemKind_Text + | {-| + + -} + CompletionItemKind_Method + | {-| + + -} + CompletionItemKind_Function + | {-| + + -} + CompletionItemKind_Constructor + | {-| + + -} + CompletionItemKind_Field + | {-| + + -} + CompletionItemKind_Variable + | {-| + + -} + CompletionItemKind_Class + | {-| + + -} + CompletionItemKind_Interface + | {-| + + -} + CompletionItemKind_Module + | {-| + + -} + CompletionItemKind_Property + | {-| + + -} + CompletionItemKind_Unit + | {-| + + -} + CompletionItemKind_Value + | {-| + + -} + CompletionItemKind_Enum + | {-| + + -} + CompletionItemKind_Keyword + | {-| + + -} + CompletionItemKind_Snippet + | {-| + + -} + CompletionItemKind_Color + | {-| + + -} + CompletionItemKind_File + | {-| + + -} + CompletionItemKind_Reference + | {-| + + -} + CompletionItemKind_Folder + | {-| + + -} + CompletionItemKind_EnumMember + | {-| + + -} + CompletionItemKind_Constant + | {-| + + -} + CompletionItemKind_Struct + | {-| + + -} + CompletionItemKind_Event + | {-| + + -} + CompletionItemKind_Operator + | {-| + + -} + CompletionItemKind_TypeParameter + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum CompletionItemKind Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum CompletionItemKind where + knownValues = Data.Set.fromList [CompletionItemKind_Text + ,CompletionItemKind_Method + ,CompletionItemKind_Function + ,CompletionItemKind_Constructor + ,CompletionItemKind_Field + ,CompletionItemKind_Variable + ,CompletionItemKind_Class + ,CompletionItemKind_Interface + ,CompletionItemKind_Module + ,CompletionItemKind_Property + ,CompletionItemKind_Unit + ,CompletionItemKind_Value + ,CompletionItemKind_Enum + ,CompletionItemKind_Keyword + ,CompletionItemKind_Snippet + ,CompletionItemKind_Color + ,CompletionItemKind_File + ,CompletionItemKind_Reference + ,CompletionItemKind_Folder + ,CompletionItemKind_EnumMember + ,CompletionItemKind_Constant + ,CompletionItemKind_Struct + ,CompletionItemKind_Event + ,CompletionItemKind_Operator + ,CompletionItemKind_TypeParameter] + type EnumBaseType CompletionItemKind = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType CompletionItemKind_Text = 1 + toEnumBaseType CompletionItemKind_Method = 2 + toEnumBaseType CompletionItemKind_Function = 3 + toEnumBaseType CompletionItemKind_Constructor = 4 + toEnumBaseType CompletionItemKind_Field = 5 + toEnumBaseType CompletionItemKind_Variable = 6 + toEnumBaseType CompletionItemKind_Class = 7 + toEnumBaseType CompletionItemKind_Interface = 8 + toEnumBaseType CompletionItemKind_Module = 9 + toEnumBaseType CompletionItemKind_Property = 10 + toEnumBaseType CompletionItemKind_Unit = 11 + toEnumBaseType CompletionItemKind_Value = 12 + toEnumBaseType CompletionItemKind_Enum = 13 + toEnumBaseType CompletionItemKind_Keyword = 14 + toEnumBaseType CompletionItemKind_Snippet = 15 + toEnumBaseType CompletionItemKind_Color = 16 + toEnumBaseType CompletionItemKind_File = 17 + toEnumBaseType CompletionItemKind_Reference = 18 + toEnumBaseType CompletionItemKind_Folder = 19 + toEnumBaseType CompletionItemKind_EnumMember = 20 + toEnumBaseType CompletionItemKind_Constant = 21 + toEnumBaseType CompletionItemKind_Struct = 22 + toEnumBaseType CompletionItemKind_Event = 23 + toEnumBaseType CompletionItemKind_Operator = 24 + toEnumBaseType CompletionItemKind_TypeParameter = 25 + fromEnumBaseType 1 = pure CompletionItemKind_Text + fromEnumBaseType 2 = pure CompletionItemKind_Method + fromEnumBaseType 3 = pure CompletionItemKind_Function + fromEnumBaseType 4 = pure CompletionItemKind_Constructor + fromEnumBaseType 5 = pure CompletionItemKind_Field + fromEnumBaseType 6 = pure CompletionItemKind_Variable + fromEnumBaseType 7 = pure CompletionItemKind_Class + fromEnumBaseType 8 = pure CompletionItemKind_Interface + fromEnumBaseType 9 = pure CompletionItemKind_Module + fromEnumBaseType 10 = pure CompletionItemKind_Property + fromEnumBaseType 11 = pure CompletionItemKind_Unit + fromEnumBaseType 12 = pure CompletionItemKind_Value + fromEnumBaseType 13 = pure CompletionItemKind_Enum + fromEnumBaseType 14 = pure CompletionItemKind_Keyword + fromEnumBaseType 15 = pure CompletionItemKind_Snippet + fromEnumBaseType 16 = pure CompletionItemKind_Color + fromEnumBaseType 17 = pure CompletionItemKind_File + fromEnumBaseType 18 = pure CompletionItemKind_Reference + fromEnumBaseType 19 = pure CompletionItemKind_Folder + fromEnumBaseType 20 = pure CompletionItemKind_EnumMember + fromEnumBaseType 21 = pure CompletionItemKind_Constant + fromEnumBaseType 22 = pure CompletionItemKind_Struct + fromEnumBaseType 23 = pure CompletionItemKind_Event + fromEnumBaseType 24 = pure CompletionItemKind_Operator + fromEnumBaseType 25 = pure CompletionItemKind_TypeParameter + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemLabelDetails.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemLabelDetails.hs new file mode 100644 index 000000000..de7d896ec --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemLabelDetails.hs @@ -0,0 +1,41 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CompletionItemLabelDetails where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Additional details for a completion item label. + +@since 3.17.0 + +-} +data CompletionItemLabelDetails = CompletionItemLabelDetails + { {-| + An optional string which is rendered less prominently directly after `CompletionItem.label`, + without any spacing. Should be used for function signatures and type annotations. + + -} + _detail :: (Maybe Data.Text.Text) + , {-| + An optional string which is rendered less prominently after `CompletionItem.detail`. Should be used + for fully qualified names and file paths. + + -} + _description :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CompletionItemLabelDetails where + toJSON (CompletionItemLabelDetails arg0 arg1) = Aeson.object $ concat $ ["detail" Language.LSP.Protocol.Types.Common..=? arg0 + ,"description" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON CompletionItemLabelDetails where + parseJSON = Aeson.withObject "CompletionItemLabelDetails" $ \arg -> CompletionItemLabelDetails <$> arg Aeson..:! "detail" <*> arg Aeson..:! "description" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemTag.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemTag.hs new file mode 100644 index 000000000..a3998de17 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemTag.hs @@ -0,0 +1,39 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CompletionItemTag where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +Completion item tags are extra annotations that tweak the rendering of a completion +item. + +@since 3.15.0 + +-} +data CompletionItemTag = + {-| + Render a completion as obsolete, usually using a strike-out. + + -} + CompletionItemTag_Deprecated + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum CompletionItemTag Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum CompletionItemTag where + knownValues = Data.Set.fromList [CompletionItemTag_Deprecated] + type EnumBaseType CompletionItemTag = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType CompletionItemTag_Deprecated = 1 + fromEnumBaseType 1 = pure CompletionItemTag_Deprecated + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionList.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionList.hs new file mode 100644 index 000000000..463a11606 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionList.hs @@ -0,0 +1,65 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CompletionList where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.CompletionItem +import qualified Language.LSP.Protocol.Internal.Types.InsertTextFormat +import qualified Language.LSP.Protocol.Internal.Types.InsertTextMode +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents a collection of `CompletionItem` to be presented +in the editor. + +-} +data CompletionList = CompletionList + { {-| + This list it not complete. Further typing results in recomputing this list. + + Recomputed lists have all their items replaced (not appended) in the + incomplete completion sessions. + + -} + _isIncomplete :: Bool + , {-| + In many cases the items of an actual completion result share the same + value for properties like `commitCharacters` or the range of a text + edit. A completion list can therefore define item defaults which will + be used if a completion item itself doesn't specify the value. + + If a completion list specifies a default value and a completion item + also specifies a corresponding value the one from the item is used. + + Servers are only allowed to return default values if the client + signals support for this via the `completionList.itemDefaults` + capability. + + @since 3.17.0 + + -} + _itemDefaults :: (Maybe (Row.Rec ("commitCharacters" Row..== (Maybe [Data.Text.Text]) Row..+ ("editRange" Row..== (Maybe (Language.LSP.Protocol.Internal.Types.Range.Range Language.LSP.Protocol.Types.Common.|? (Row.Rec ("insert" Row..== Language.LSP.Protocol.Internal.Types.Range.Range Row..+ ("replace" Row..== Language.LSP.Protocol.Internal.Types.Range.Range Row..+ Row.Empty))))) Row..+ ("insertTextFormat" Row..== (Maybe Language.LSP.Protocol.Internal.Types.InsertTextFormat.InsertTextFormat) Row..+ ("insertTextMode" Row..== (Maybe Language.LSP.Protocol.Internal.Types.InsertTextMode.InsertTextMode) Row..+ ("data" Row..== (Maybe Data.Aeson.Value) Row..+ Row.Empty))))))) + , {-| + The completion items. + + -} + _items :: [Language.LSP.Protocol.Internal.Types.CompletionItem.CompletionItem] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CompletionList where + toJSON (CompletionList arg0 arg1 arg2) = Aeson.object $ concat $ [["isIncomplete" Aeson..= arg0] + ,"itemDefaults" Language.LSP.Protocol.Types.Common..=? arg1 + ,["items" Aeson..= arg2]] + +instance Aeson.FromJSON CompletionList where + parseJSON = Aeson.withObject "CompletionList" $ \arg -> CompletionList <$> arg Aeson..: "isIncomplete" <*> arg Aeson..:! "itemDefaults" <*> arg Aeson..: "items" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionOptions.hs new file mode 100644 index 000000000..5f1cd4830 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionOptions.hs @@ -0,0 +1,73 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CompletionOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Completion options. + +-} +data CompletionOptions = CompletionOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + Most tools trigger completion request automatically without explicitly requesting + it using a keyboard shortcut (e.g. Ctrl+Space). Typically they do so when the user + starts to type an identifier. For example if the user types `c` in a JavaScript file + code complete will automatically pop up present `console` besides others as a + completion item. Characters that make up identifiers don't need to be listed here. + + If code complete should automatically be trigger on characters not being valid inside + an identifier (for example `.` in JavaScript) list them in `triggerCharacters`. + + -} + _triggerCharacters :: (Maybe [Data.Text.Text]) + , {-| + The list of all possible characters that commit a completion. This field can be used + if clients don't support individual commit characters per completion item. See + `ClientCapabilities.textDocument.completion.completionItem.commitCharactersSupport` + + If a server provides both `allCommitCharacters` and commit characters on an individual + completion item the ones on the completion item win. + + @since 3.2.0 + + -} + _allCommitCharacters :: (Maybe [Data.Text.Text]) + , {-| + The server provides support to resolve additional + information for a completion item. + + -} + _resolveProvider :: (Maybe Bool) + , {-| + The server supports the following `CompletionItem` specific + capabilities. + + @since 3.17.0 + + -} + _completionItem :: (Maybe (Row.Rec ("labelDetailsSupport" Row..== (Maybe Bool) Row..+ Row.Empty))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CompletionOptions where + toJSON (CompletionOptions arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"triggerCharacters" Language.LSP.Protocol.Types.Common..=? arg1 + ,"allCommitCharacters" Language.LSP.Protocol.Types.Common..=? arg2 + ,"resolveProvider" Language.LSP.Protocol.Types.Common..=? arg3 + ,"completionItem" Language.LSP.Protocol.Types.Common..=? arg4] + +instance Aeson.FromJSON CompletionOptions where + parseJSON = Aeson.withObject "CompletionOptions" $ \arg -> CompletionOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "triggerCharacters" <*> arg Aeson..:! "allCommitCharacters" <*> arg Aeson..:! "resolveProvider" <*> arg Aeson..:! "completionItem" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionParams.hs new file mode 100644 index 000000000..3ce368f74 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionParams.hs @@ -0,0 +1,60 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CompletionParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.CompletionContext +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +Completion parameters + +-} +data CompletionParams = CompletionParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The completion context. This is only available it the client specifies + to send this using the client capability `textDocument.completion.contextSupport === true` + + -} + _context :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionContext.CompletionContext) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CompletionParams where + toJSON (CompletionParams arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg3 + ,"context" Language.LSP.Protocol.Types.Common..=? arg4] + +instance Aeson.FromJSON CompletionParams where + parseJSON = Aeson.withObject "CompletionParams" $ \arg -> CompletionParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..:! "context" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionRegistrationOptions.hs new file mode 100644 index 000000000..b7e185cfc --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionRegistrationOptions.hs @@ -0,0 +1,81 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CompletionRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `CompletionRequest`. + +-} +data CompletionRegistrationOptions = CompletionRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + Most tools trigger completion request automatically without explicitly requesting + it using a keyboard shortcut (e.g. Ctrl+Space). Typically they do so when the user + starts to type an identifier. For example if the user types `c` in a JavaScript file + code complete will automatically pop up present `console` besides others as a + completion item. Characters that make up identifiers don't need to be listed here. + + If code complete should automatically be trigger on characters not being valid inside + an identifier (for example `.` in JavaScript) list them in `triggerCharacters`. + + -} + _triggerCharacters :: (Maybe [Data.Text.Text]) + , {-| + The list of all possible characters that commit a completion. This field can be used + if clients don't support individual commit characters per completion item. See + `ClientCapabilities.textDocument.completion.completionItem.commitCharactersSupport` + + If a server provides both `allCommitCharacters` and commit characters on an individual + completion item the ones on the completion item win. + + @since 3.2.0 + + -} + _allCommitCharacters :: (Maybe [Data.Text.Text]) + , {-| + The server provides support to resolve additional + information for a completion item. + + -} + _resolveProvider :: (Maybe Bool) + , {-| + The server supports the following `CompletionItem` specific + capabilities. + + @since 3.17.0 + + -} + _completionItem :: (Maybe (Row.Rec ("labelDetailsSupport" Row..== (Maybe Bool) Row..+ Row.Empty))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CompletionRegistrationOptions where + toJSON (CompletionRegistrationOptions arg0 arg1 arg2 arg3 arg4 arg5) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"triggerCharacters" Language.LSP.Protocol.Types.Common..=? arg2 + ,"allCommitCharacters" Language.LSP.Protocol.Types.Common..=? arg3 + ,"resolveProvider" Language.LSP.Protocol.Types.Common..=? arg4 + ,"completionItem" Language.LSP.Protocol.Types.Common..=? arg5] + +instance Aeson.FromJSON CompletionRegistrationOptions where + parseJSON = Aeson.withObject "CompletionRegistrationOptions" $ \arg -> CompletionRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "triggerCharacters" <*> arg Aeson..:! "allCommitCharacters" <*> arg Aeson..:! "resolveProvider" <*> arg Aeson..:! "completionItem" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionTriggerKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionTriggerKind.hs new file mode 100644 index 000000000..360dd143e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionTriggerKind.hs @@ -0,0 +1,54 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CompletionTriggerKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +How a completion was triggered + +-} +data CompletionTriggerKind = + {-| + Completion was triggered by typing an identifier (24x7 code + complete), manual invocation (e.g Ctrl+Space) or via API. + + -} + CompletionTriggerKind_Invoked + | {-| + Completion was triggered by a trigger character specified by + the `triggerCharacters` properties of the `CompletionRegistrationOptions`. + + -} + CompletionTriggerKind_TriggerCharacter + | {-| + Completion was re-triggered as current completion list is incomplete + + -} + CompletionTriggerKind_TriggerForIncompleteCompletions + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum CompletionTriggerKind Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum CompletionTriggerKind where + knownValues = Data.Set.fromList [CompletionTriggerKind_Invoked + ,CompletionTriggerKind_TriggerCharacter + ,CompletionTriggerKind_TriggerForIncompleteCompletions] + type EnumBaseType CompletionTriggerKind = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType CompletionTriggerKind_Invoked = 1 + toEnumBaseType CompletionTriggerKind_TriggerCharacter = 2 + toEnumBaseType CompletionTriggerKind_TriggerForIncompleteCompletions = 3 + fromEnumBaseType 1 = pure CompletionTriggerKind_Invoked + fromEnumBaseType 2 = pure CompletionTriggerKind_TriggerCharacter + fromEnumBaseType 3 = pure CompletionTriggerKind_TriggerForIncompleteCompletions + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationItem.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationItem.hs new file mode 100644 index 000000000..330958257 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationItem.hs @@ -0,0 +1,36 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ConfigurationItem where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data ConfigurationItem = ConfigurationItem + { {-| + The scope to get the configuration section for. + + -} + _scopeUri :: (Maybe Data.Text.Text) + , {-| + The configuration section asked for. + + -} + _section :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ConfigurationItem where + toJSON (ConfigurationItem arg0 arg1) = Aeson.object $ concat $ ["scopeUri" Language.LSP.Protocol.Types.Common..=? arg0 + ,"section" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON ConfigurationItem where + parseJSON = Aeson.withObject "ConfigurationItem" $ \arg -> ConfigurationItem <$> arg Aeson..:! "scopeUri" <*> arg Aeson..:! "section" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationParams.hs new file mode 100644 index 000000000..8440e18f0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationParams.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ConfigurationParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ConfigurationItem +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a configuration request. + +-} +data ConfigurationParams = ConfigurationParams + { {-| + + -} + _items :: [Language.LSP.Protocol.Internal.Types.ConfigurationItem.ConfigurationItem] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ConfigurationParams where + toJSON (ConfigurationParams arg0) = Aeson.object $ concat $ [["items" Aeson..= arg0]] + +instance Aeson.FromJSON ConfigurationParams where + parseJSON = Aeson.withObject "ConfigurationParams" $ \arg -> ConfigurationParams <$> arg Aeson..: "items" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFile.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFile.hs new file mode 100644 index 000000000..68d3d9a21 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFile.hs @@ -0,0 +1,54 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CreateFile where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier +import qualified Language.LSP.Protocol.Internal.Types.CreateFileOptions +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Singletons +import qualified Language.LSP.Protocol.Types.Uri + +{-| +Create file operation. + +-} +data CreateFile = CreateFile + { {-| + An optional annotation identifier describing the operation. + + @since 3.16.0 + + -} + _annotationId :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier) + , {-| + A create + + -} + _kind :: (Language.LSP.Protocol.Types.Singletons.AString "create") + , {-| + The resource to create. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + Additional options + + -} + _options :: (Maybe Language.LSP.Protocol.Internal.Types.CreateFileOptions.CreateFileOptions) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CreateFile where + toJSON (CreateFile arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["annotationId" Language.LSP.Protocol.Types.Common..=? arg0 + ,["kind" Aeson..= arg1] + ,["uri" Aeson..= arg2] + ,"options" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON CreateFile where + parseJSON = Aeson.withObject "CreateFile" $ \arg -> CreateFile <$> arg Aeson..:! "annotationId" <*> arg Aeson..: "kind" <*> arg Aeson..: "uri" <*> arg Aeson..:! "options" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFileOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFileOptions.hs new file mode 100644 index 000000000..4d064f814 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFileOptions.hs @@ -0,0 +1,36 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CreateFileOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Options to create a file. + +-} +data CreateFileOptions = CreateFileOptions + { {-| + Overwrite existing file. Overwrite wins over `ignoreIfExists` + + -} + _overwrite :: (Maybe Bool) + , {-| + Ignore if exists. + + -} + _ignoreIfExists :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CreateFileOptions where + toJSON (CreateFileOptions arg0 arg1) = Aeson.object $ concat $ ["overwrite" Language.LSP.Protocol.Types.Common..=? arg0 + ,"ignoreIfExists" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON CreateFileOptions where + parseJSON = Aeson.withObject "CreateFileOptions" $ \arg -> CreateFileOptions <$> arg Aeson..:! "overwrite" <*> arg Aeson..:! "ignoreIfExists" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFilesParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFilesParams.hs new file mode 100644 index 000000000..c844bec90 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFilesParams.hs @@ -0,0 +1,34 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.CreateFilesParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FileCreate +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters sent in notifications/requests for user-initiated creation of +files. + +@since 3.16.0 + +-} +data CreateFilesParams = CreateFilesParams + { {-| + An array of all files/folders created in this operation. + + -} + _files :: [Language.LSP.Protocol.Internal.Types.FileCreate.FileCreate] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON CreateFilesParams where + toJSON (CreateFilesParams arg0) = Aeson.object $ concat $ [["files" Aeson..= arg0]] + +instance Aeson.FromJSON CreateFilesParams where + parseJSON = Aeson.withObject "CreateFilesParams" $ \arg -> CreateFilesParams <$> arg Aeson..: "files" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Declaration.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Declaration.hs new file mode 100644 index 000000000..fdbd00a8a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Declaration.hs @@ -0,0 +1,20 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Declaration where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Location +import qualified Language.LSP.Protocol.Types.Common + +{-| +The declaration of a symbol representation as one or many `Location`. + +-} +newtype Declaration = Declaration (Language.LSP.Protocol.Internal.Types.Location.Location Language.LSP.Protocol.Types.Common.|? [Language.LSP.Protocol.Internal.Types.Location.Location]) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationClientCapabilities.hs new file mode 100644 index 000000000..87df53375 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationClientCapabilities.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DeclarationClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.14.0 + +-} +data DeclarationClientCapabilities = DeclarationClientCapabilities + { {-| + Whether declaration supports dynamic registration. If this is set to `true` + the client supports the new `DeclarationRegistrationOptions` return value + for the corresponding server capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + The client supports additional metadata in the form of declaration links. + + -} + _linkSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DeclarationClientCapabilities where + toJSON (DeclarationClientCapabilities arg0 arg1) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"linkSupport" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DeclarationClientCapabilities where + parseJSON = Aeson.withObject "DeclarationClientCapabilities" $ \arg -> DeclarationClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "linkSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationLink.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationLink.hs new file mode 100644 index 000000000..7e859a196 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationLink.hs @@ -0,0 +1,25 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DeclarationLink where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.LocationLink + +{-| +Information about where a symbol is declared. + +Provides additional metadata over normal `Location` declarations, including the range of +the declaring symbol. + +Servers should prefer returning `DeclarationLink` over `Declaration` if supported +by the client. + +-} +newtype DeclarationLink = DeclarationLink Language.LSP.Protocol.Internal.Types.LocationLink.LocationLink + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationOptions.hs new file mode 100644 index 000000000..c0f61f29f --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationOptions.hs @@ -0,0 +1,28 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DeclarationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data DeclarationOptions = DeclarationOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DeclarationOptions where + toJSON (DeclarationOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DeclarationOptions where + parseJSON = Aeson.withObject "DeclarationOptions" $ \arg -> DeclarationOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationParams.hs new file mode 100644 index 000000000..032d4dd50 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationParams.hs @@ -0,0 +1,51 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DeclarationParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data DeclarationParams = DeclarationParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DeclarationParams where + toJSON (DeclarationParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON DeclarationParams where + parseJSON = Aeson.withObject "DeclarationParams" $ \arg -> DeclarationParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationRegistrationOptions.hs new file mode 100644 index 000000000..0df0951ea --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationRegistrationOptions.hs @@ -0,0 +1,44 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DeclarationRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data DeclarationRegistrationOptions = DeclarationRegistrationOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DeclarationRegistrationOptions where + toJSON (DeclarationRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,["documentSelector" Aeson..= arg1] + ,"id" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON DeclarationRegistrationOptions where + parseJSON = Aeson.withObject "DeclarationRegistrationOptions" $ \arg -> DeclarationRegistrationOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..: "documentSelector" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Definition.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Definition.hs new file mode 100644 index 000000000..e6123c3ad --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Definition.hs @@ -0,0 +1,25 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Definition where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Location +import qualified Language.LSP.Protocol.Types.Common + +{-| +The definition of a symbol represented as one or many `Location`. +For most programming languages there is only one location at which a symbol is +defined. + +Servers should prefer returning `DefinitionLink` over `Definition` if supported +by the client. + +-} +newtype Definition = Definition (Language.LSP.Protocol.Internal.Types.Location.Location Language.LSP.Protocol.Types.Common.|? [Language.LSP.Protocol.Internal.Types.Location.Location]) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionClientCapabilities.hs new file mode 100644 index 000000000..4e56f45be --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionClientCapabilities.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DefinitionClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client Capabilities for a `DefinitionRequest`. + +-} +data DefinitionClientCapabilities = DefinitionClientCapabilities + { {-| + Whether definition supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + The client supports additional metadata in the form of definition links. + + @since 3.14.0 + + -} + _linkSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DefinitionClientCapabilities where + toJSON (DefinitionClientCapabilities arg0 arg1) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"linkSupport" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DefinitionClientCapabilities where + parseJSON = Aeson.withObject "DefinitionClientCapabilities" $ \arg -> DefinitionClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "linkSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionLink.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionLink.hs new file mode 100644 index 000000000..c0222b365 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionLink.hs @@ -0,0 +1,22 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DefinitionLink where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.LocationLink + +{-| +Information about where a symbol is defined. + +Provides additional metadata over normal `Location` definitions, including the range of +the defining symbol + +-} +newtype DefinitionLink = DefinitionLink Language.LSP.Protocol.Internal.Types.LocationLink.LocationLink + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionOptions.hs new file mode 100644 index 000000000..2524be509 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionOptions.hs @@ -0,0 +1,29 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DefinitionOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Server Capabilities for a `DefinitionRequest`. + +-} +data DefinitionOptions = DefinitionOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DefinitionOptions where + toJSON (DefinitionOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DefinitionOptions where + parseJSON = Aeson.withObject "DefinitionOptions" $ \arg -> DefinitionOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionParams.hs new file mode 100644 index 000000000..3f7176918 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionParams.hs @@ -0,0 +1,52 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DefinitionParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +Parameters for a `DefinitionRequest`. + +-} +data DefinitionParams = DefinitionParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DefinitionParams where + toJSON (DefinitionParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON DefinitionParams where + parseJSON = Aeson.withObject "DefinitionParams" $ \arg -> DefinitionParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionRegistrationOptions.hs new file mode 100644 index 000000000..491ca3bff --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionRegistrationOptions.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DefinitionRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `DefinitionRequest`. + +-} +data DefinitionRegistrationOptions = DefinitionRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DefinitionRegistrationOptions where + toJSON (DefinitionRegistrationOptions arg0 arg1) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DefinitionRegistrationOptions where + parseJSON = Aeson.withObject "DefinitionRegistrationOptions" $ \arg -> DefinitionRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFile.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFile.hs new file mode 100644 index 000000000..b4218e670 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFile.hs @@ -0,0 +1,54 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DeleteFile where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier +import qualified Language.LSP.Protocol.Internal.Types.DeleteFileOptions +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Singletons +import qualified Language.LSP.Protocol.Types.Uri + +{-| +Delete file operation + +-} +data DeleteFile = DeleteFile + { {-| + An optional annotation identifier describing the operation. + + @since 3.16.0 + + -} + _annotationId :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier) + , {-| + A delete + + -} + _kind :: (Language.LSP.Protocol.Types.Singletons.AString "delete") + , {-| + The file to delete. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + Delete options. + + -} + _options :: (Maybe Language.LSP.Protocol.Internal.Types.DeleteFileOptions.DeleteFileOptions) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DeleteFile where + toJSON (DeleteFile arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["annotationId" Language.LSP.Protocol.Types.Common..=? arg0 + ,["kind" Aeson..= arg1] + ,["uri" Aeson..= arg2] + ,"options" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON DeleteFile where + parseJSON = Aeson.withObject "DeleteFile" $ \arg -> DeleteFile <$> arg Aeson..:! "annotationId" <*> arg Aeson..: "kind" <*> arg Aeson..: "uri" <*> arg Aeson..:! "options" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFileOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFileOptions.hs new file mode 100644 index 000000000..e2d2ca63c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFileOptions.hs @@ -0,0 +1,36 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DeleteFileOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Delete file options + +-} +data DeleteFileOptions = DeleteFileOptions + { {-| + Delete the content recursively if a folder is denoted. + + -} + _recursive :: (Maybe Bool) + , {-| + Ignore the operation if the file doesn't exist. + + -} + _ignoreIfNotExists :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DeleteFileOptions where + toJSON (DeleteFileOptions arg0 arg1) = Aeson.object $ concat $ ["recursive" Language.LSP.Protocol.Types.Common..=? arg0 + ,"ignoreIfNotExists" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DeleteFileOptions where + parseJSON = Aeson.withObject "DeleteFileOptions" $ \arg -> DeleteFileOptions <$> arg Aeson..:! "recursive" <*> arg Aeson..:! "ignoreIfNotExists" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFilesParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFilesParams.hs new file mode 100644 index 000000000..220f88ef5 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFilesParams.hs @@ -0,0 +1,34 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DeleteFilesParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FileDelete +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters sent in notifications/requests for user-initiated deletes of +files. + +@since 3.16.0 + +-} +data DeleteFilesParams = DeleteFilesParams + { {-| + An array of all files/folders deleted in this operation. + + -} + _files :: [Language.LSP.Protocol.Internal.Types.FileDelete.FileDelete] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DeleteFilesParams where + toJSON (DeleteFilesParams arg0) = Aeson.object $ concat $ [["files" Aeson..= arg0]] + +instance Aeson.FromJSON DeleteFilesParams where + parseJSON = Aeson.withObject "DeleteFilesParams" $ \arg -> DeleteFilesParams <$> arg Aeson..: "files" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Diagnostic.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Diagnostic.hs new file mode 100644 index 000000000..b765de269 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Diagnostic.hs @@ -0,0 +1,98 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Diagnostic where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.CodeDescription +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticRelatedInformation +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticSeverity +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticTag +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents a diagnostic, such as a compiler error or warning. Diagnostic objects +are only valid in the scope of a resource. + +-} +data Diagnostic = Diagnostic + { {-| + The range at which the message applies + + -} + _range :: Language.LSP.Protocol.Internal.Types.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 :: (Maybe Language.LSP.Protocol.Internal.Types.DiagnosticSeverity.DiagnosticSeverity) + , {-| + The diagnostic's code, which usually appear in the user interface. + + -} + _code :: (Maybe (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Data.Text.Text)) + , {-| + An optional property to describe the error code. + Requires the code field (above) to be present/not null. + + @since 3.16.0 + + -} + _codeDescription :: (Maybe Language.LSP.Protocol.Internal.Types.CodeDescription.CodeDescription) + , {-| + A human-readable string describing the source of this + diagnostic, e.g. 'typescript' or 'super lint'. It usually + appears in the user interface. + + -} + _source :: (Maybe Data.Text.Text) + , {-| + The diagnostic's message. It usually appears in the user interface + + -} + _message :: Data.Text.Text + , {-| + Additional metadata about the diagnostic. + + @since 3.15.0 + + -} + _tags :: (Maybe [Language.LSP.Protocol.Internal.Types.DiagnosticTag.DiagnosticTag]) + , {-| + An array of related diagnostic information, e.g. when symbol-names within + a scope collide all definitions can be marked via this property. + + -} + _relatedInformation :: (Maybe [Language.LSP.Protocol.Internal.Types.DiagnosticRelatedInformation.DiagnosticRelatedInformation]) + , {-| + A data entry field that is preserved between a `textDocument/publishDiagnostics` + notification and `textDocument/codeAction` request. + + @since 3.16.0 + + -} + _data_ :: (Maybe Data.Aeson.Value) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON Diagnostic where + toJSON (Diagnostic arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8) = Aeson.object $ concat $ [["range" Aeson..= arg0] + ,"severity" Language.LSP.Protocol.Types.Common..=? arg1 + ,"code" Language.LSP.Protocol.Types.Common..=? arg2 + ,"codeDescription" Language.LSP.Protocol.Types.Common..=? arg3 + ,"source" Language.LSP.Protocol.Types.Common..=? arg4 + ,["message" Aeson..= arg5] + ,"tags" Language.LSP.Protocol.Types.Common..=? arg6 + ,"relatedInformation" Language.LSP.Protocol.Types.Common..=? arg7 + ,"data" Language.LSP.Protocol.Types.Common..=? arg8] + +instance Aeson.FromJSON Diagnostic where + parseJSON = Aeson.withObject "Diagnostic" $ \arg -> Diagnostic <$> arg Aeson..: "range" <*> arg Aeson..:! "severity" <*> arg Aeson..:! "code" <*> arg Aeson..:! "codeDescription" <*> arg Aeson..:! "source" <*> arg Aeson..: "message" <*> arg Aeson..:! "tags" <*> arg Aeson..:! "relatedInformation" <*> arg Aeson..:! "data" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticClientCapabilities.hs new file mode 100644 index 000000000..60194ded1 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticClientCapabilities.hs @@ -0,0 +1,40 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DiagnosticClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client capabilities specific to diagnostic pull requests. + +@since 3.17.0 + +-} +data DiagnosticClientCapabilities = DiagnosticClientCapabilities + { {-| + Whether implementation supports dynamic registration. If this is set to `true` + the client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)` + return value for the corresponding server capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + Whether the clients supports related documents for document diagnostic pulls. + + -} + _relatedDocumentSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DiagnosticClientCapabilities where + toJSON (DiagnosticClientCapabilities arg0 arg1) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"relatedDocumentSupport" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DiagnosticClientCapabilities where + parseJSON = Aeson.withObject "DiagnosticClientCapabilities" $ \arg -> DiagnosticClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "relatedDocumentSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticOptions.hs new file mode 100644 index 000000000..58582aeb7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticOptions.hs @@ -0,0 +1,54 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DiagnosticOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Diagnostic options. + +@since 3.17.0 + +-} +data DiagnosticOptions = DiagnosticOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + An optional identifier under which the diagnostics are + managed by the client. + + -} + _identifier :: (Maybe Data.Text.Text) + , {-| + Whether the language has inter file dependencies meaning that + editing code in one file can result in a different diagnostic + set in another file. Inter file dependencies are common for + most programming languages and typically uncommon for linters. + + -} + _interFileDependencies :: Bool + , {-| + The server provides support for workspace diagnostics as well. + + -} + _workspaceDiagnostics :: Bool + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DiagnosticOptions where + toJSON (DiagnosticOptions arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"identifier" Language.LSP.Protocol.Types.Common..=? arg1 + ,["interFileDependencies" Aeson..= arg2] + ,["workspaceDiagnostics" Aeson..= arg3]] + +instance Aeson.FromJSON DiagnosticOptions where + parseJSON = Aeson.withObject "DiagnosticOptions" $ \arg -> DiagnosticOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "identifier" <*> arg Aeson..: "interFileDependencies" <*> arg Aeson..: "workspaceDiagnostics" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRegistrationOptions.hs new file mode 100644 index 000000000..2136537a4 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRegistrationOptions.hs @@ -0,0 +1,69 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DiagnosticRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Diagnostic registration options. + +@since 3.17.0 + +-} +data DiagnosticRegistrationOptions = DiagnosticRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + An optional identifier under which the diagnostics are + managed by the client. + + -} + _identifier :: (Maybe Data.Text.Text) + , {-| + Whether the language has inter file dependencies meaning that + editing code in one file can result in a different diagnostic + set in another file. Inter file dependencies are common for + most programming languages and typically uncommon for linters. + + -} + _interFileDependencies :: Bool + , {-| + The server provides support for workspace diagnostics as well. + + -} + _workspaceDiagnostics :: Bool + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DiagnosticRegistrationOptions where + toJSON (DiagnosticRegistrationOptions arg0 arg1 arg2 arg3 arg4 arg5) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"identifier" Language.LSP.Protocol.Types.Common..=? arg2 + ,["interFileDependencies" Aeson..= arg3] + ,["workspaceDiagnostics" Aeson..= arg4] + ,"id" Language.LSP.Protocol.Types.Common..=? arg5] + +instance Aeson.FromJSON DiagnosticRegistrationOptions where + parseJSON = Aeson.withObject "DiagnosticRegistrationOptions" $ \arg -> DiagnosticRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "identifier" <*> arg Aeson..: "interFileDependencies" <*> arg Aeson..: "workspaceDiagnostics" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRelatedInformation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRelatedInformation.hs new file mode 100644 index 000000000..6bc3c9d1c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRelatedInformation.hs @@ -0,0 +1,40 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DiagnosticRelatedInformation where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Location +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents a related message and source code location for a diagnostic. This should be +used to point to code locations that cause or related to a diagnostics, e.g when duplicating +a symbol in a scope. + +-} +data DiagnosticRelatedInformation = DiagnosticRelatedInformation + { {-| + The location of this related diagnostic information. + + -} + _location :: Language.LSP.Protocol.Internal.Types.Location.Location + , {-| + The message of this related diagnostic information. + + -} + _message :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DiagnosticRelatedInformation where + toJSON (DiagnosticRelatedInformation arg0 arg1) = Aeson.object $ concat $ [["location" Aeson..= arg0] + ,["message" Aeson..= arg1]] + +instance Aeson.FromJSON DiagnosticRelatedInformation where + parseJSON = Aeson.withObject "DiagnosticRelatedInformation" $ \arg -> DiagnosticRelatedInformation <$> arg Aeson..: "location" <*> arg Aeson..: "message" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticServerCancellationData.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticServerCancellationData.hs new file mode 100644 index 000000000..cea0dcc13 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticServerCancellationData.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DiagnosticServerCancellationData where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Cancellation data returned from a diagnostic request. + +@since 3.17.0 + +-} +data DiagnosticServerCancellationData = DiagnosticServerCancellationData + { {-| + + -} + _retriggerRequest :: Bool + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DiagnosticServerCancellationData where + toJSON (DiagnosticServerCancellationData arg0) = Aeson.object $ concat $ [["retriggerRequest" Aeson..= arg0]] + +instance Aeson.FromJSON DiagnosticServerCancellationData where + parseJSON = Aeson.withObject "DiagnosticServerCancellationData" $ \arg -> DiagnosticServerCancellationData <$> arg Aeson..: "retriggerRequest" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticSeverity.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticSeverity.hs new file mode 100644 index 000000000..7d7a7fc2e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticSeverity.hs @@ -0,0 +1,60 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DiagnosticSeverity where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +The diagnostic's severity. + +-} +data DiagnosticSeverity = + {-| + Reports an error. + + -} + DiagnosticSeverity_Error + | {-| + Reports a warning. + + -} + DiagnosticSeverity_Warning + | {-| + Reports an information. + + -} + DiagnosticSeverity_Information + | {-| + Reports a hint. + + -} + DiagnosticSeverity_Hint + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum DiagnosticSeverity Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum DiagnosticSeverity where + knownValues = Data.Set.fromList [DiagnosticSeverity_Error + ,DiagnosticSeverity_Warning + ,DiagnosticSeverity_Information + ,DiagnosticSeverity_Hint] + type EnumBaseType DiagnosticSeverity = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType DiagnosticSeverity_Error = 1 + toEnumBaseType DiagnosticSeverity_Warning = 2 + toEnumBaseType DiagnosticSeverity_Information = 3 + toEnumBaseType DiagnosticSeverity_Hint = 4 + fromEnumBaseType 1 = pure DiagnosticSeverity_Error + fromEnumBaseType 2 = pure DiagnosticSeverity_Warning + fromEnumBaseType 3 = pure DiagnosticSeverity_Information + fromEnumBaseType 4 = pure DiagnosticSeverity_Hint + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticTag.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticTag.hs new file mode 100644 index 000000000..634e74962 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticTag.hs @@ -0,0 +1,51 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DiagnosticTag where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +The diagnostic tags. + +@since 3.15.0 + +-} +data DiagnosticTag = + {-| + Unused or unnecessary code. + + Clients are allowed to render diagnostics with this tag faded out instead of having + an error squiggle. + + -} + DiagnosticTag_Unnecessary + | {-| + Deprecated or obsolete code. + + Clients are allowed to rendered diagnostics with this tag strike through. + + -} + DiagnosticTag_Deprecated + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum DiagnosticTag Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum DiagnosticTag where + knownValues = Data.Set.fromList [DiagnosticTag_Unnecessary + ,DiagnosticTag_Deprecated] + type EnumBaseType DiagnosticTag = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType DiagnosticTag_Unnecessary = 1 + toEnumBaseType DiagnosticTag_Deprecated = 2 + fromEnumBaseType 1 = pure DiagnosticTag_Unnecessary + fromEnumBaseType 2 = pure DiagnosticTag_Deprecated + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticWorkspaceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticWorkspaceClientCapabilities.hs new file mode 100644 index 000000000..e8b3a90f3 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticWorkspaceClientCapabilities.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DiagnosticWorkspaceClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Workspace client capabilities specific to diagnostic pull requests. + +@since 3.17.0 + +-} +data DiagnosticWorkspaceClientCapabilities = DiagnosticWorkspaceClientCapabilities + { {-| + Whether the client implementation supports a refresh request sent from + the server to the client. + + Note that this event is global and will force the client to refresh all + pulled diagnostics currently shown. It should be used with absolute care and + is useful for situation where a server for example detects a project wide + change that requires such a calculation. + + -} + _refreshSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DiagnosticWorkspaceClientCapabilities where + toJSON (DiagnosticWorkspaceClientCapabilities arg0) = Aeson.object $ concat $ ["refreshSupport" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DiagnosticWorkspaceClientCapabilities where + parseJSON = Aeson.withObject "DiagnosticWorkspaceClientCapabilities" $ \arg -> DiagnosticWorkspaceClientCapabilities <$> arg Aeson..:! "refreshSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationClientCapabilities.hs new file mode 100644 index 000000000..a7fd36af5 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationClientCapabilities.hs @@ -0,0 +1,29 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidChangeConfigurationClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data DidChangeConfigurationClientCapabilities = DidChangeConfigurationClientCapabilities + { {-| + Did change configuration notification supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidChangeConfigurationClientCapabilities where + toJSON (DidChangeConfigurationClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DidChangeConfigurationClientCapabilities where + parseJSON = Aeson.withObject "DidChangeConfigurationClientCapabilities" $ \arg -> DidChangeConfigurationClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationParams.hs new file mode 100644 index 000000000..ba5ca2f23 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationParams.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidChangeConfigurationParams where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a change configuration notification. + +-} +data DidChangeConfigurationParams = DidChangeConfigurationParams + { {-| + The actual changed settings + + -} + _settings :: Data.Aeson.Value + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidChangeConfigurationParams where + toJSON (DidChangeConfigurationParams arg0) = Aeson.object $ concat $ [["settings" Aeson..= arg0]] + +instance Aeson.FromJSON DidChangeConfigurationParams where + parseJSON = Aeson.withObject "DidChangeConfigurationParams" $ \arg -> DidChangeConfigurationParams <$> arg Aeson..: "settings" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationRegistrationOptions.hs new file mode 100644 index 000000000..89b905e0e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationRegistrationOptions.hs @@ -0,0 +1,29 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidChangeConfigurationRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data DidChangeConfigurationRegistrationOptions = DidChangeConfigurationRegistrationOptions + { {-| + + -} + _section :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? [Data.Text.Text])) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidChangeConfigurationRegistrationOptions where + toJSON (DidChangeConfigurationRegistrationOptions arg0) = Aeson.object $ concat $ ["section" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DidChangeConfigurationRegistrationOptions where + parseJSON = Aeson.withObject "DidChangeConfigurationRegistrationOptions" $ \arg -> DidChangeConfigurationRegistrationOptions <$> arg Aeson..:! "section" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeNotebookDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeNotebookDocumentParams.hs new file mode 100644 index 000000000..264ad6598 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeNotebookDocumentParams.hs @@ -0,0 +1,55 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidChangeNotebookDocumentParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentChangeEvent +import qualified Language.LSP.Protocol.Internal.Types.VersionedNotebookDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The params sent in a change notebook document notification. + +@since 3.17.0 + +-} +data DidChangeNotebookDocumentParams = DidChangeNotebookDocumentParams + { {-| + The notebook document that did change. The version number points + to the version after all provided changes have been applied. If + only the text document content of a cell changes the notebook version + doesn't necessarily have to change. + + -} + _notebookDocument :: Language.LSP.Protocol.Internal.Types.VersionedNotebookDocumentIdentifier.VersionedNotebookDocumentIdentifier + , {-| + The actual changes to the notebook document. + + The changes describe single state changes to the notebook document. + So if there are two changes c1 (at array index 0) and c2 (at array + index 1) for a notebook in state S then c1 moves the notebook from + S to S' and c2 from S' to S''. So c1 is computed on the state S and + c2 is computed on the state S'. + + To mirror the content of a notebook using change events use the following approach: + - start with the same initial content + - apply the 'notebookDocument/didChange' notifications in the order you receive them. + - apply the `NotebookChangeEvent`s in a single notification in the order + you receive them. + + -} + _change :: Language.LSP.Protocol.Internal.Types.NotebookDocumentChangeEvent.NotebookDocumentChangeEvent + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidChangeNotebookDocumentParams where + toJSON (DidChangeNotebookDocumentParams arg0 arg1) = Aeson.object $ concat $ [["notebookDocument" Aeson..= arg0] + ,["change" Aeson..= arg1]] + +instance Aeson.FromJSON DidChangeNotebookDocumentParams where + parseJSON = Aeson.withObject "DidChangeNotebookDocumentParams" $ \arg -> DidChangeNotebookDocumentParams <$> arg Aeson..: "notebookDocument" <*> arg Aeson..: "change" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeTextDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeTextDocumentParams.hs new file mode 100644 index 000000000..36ef2cbd0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeTextDocumentParams.hs @@ -0,0 +1,50 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidChangeTextDocumentParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent +import qualified Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The change text document notification's parameters. + +-} +data DidChangeTextDocumentParams = DidChangeTextDocumentParams + { {-| + The document that did change. The version number points + to the version after all provided content changes have + been applied. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier.VersionedTextDocumentIdentifier + , {-| + The actual content changes. The content changes describe single state changes + to the document. So if there are two content changes c1 (at array index 0) and + c2 (at array index 1) for a document in state S then c1 moves the document from + S to S' and c2 from S' to S''. So c1 is computed on the state S and c2 is computed + on the state S'. + + To mirror the content of a document using change events use the following approach: + - start with the same initial content + - apply the 'textDocument/didChange' notifications in the order you receive them. + - apply the `TextDocumentContentChangeEvent`s in a single notification in the order + you receive them. + + -} + _contentChanges :: [Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent.TextDocumentContentChangeEvent] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidChangeTextDocumentParams where + toJSON (DidChangeTextDocumentParams arg0 arg1) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["contentChanges" Aeson..= arg1]] + +instance Aeson.FromJSON DidChangeTextDocumentParams where + parseJSON = Aeson.withObject "DidChangeTextDocumentParams" $ \arg -> DidChangeTextDocumentParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "contentChanges" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesClientCapabilities.hs new file mode 100644 index 000000000..aec580833 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesClientCapabilities.hs @@ -0,0 +1,40 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data DidChangeWatchedFilesClientCapabilities = DidChangeWatchedFilesClientCapabilities + { {-| + Did change watched files notification supports dynamic registration. Please note + that the current protocol doesn't support static configuration for file changes + from the server side. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + Whether the client has support for `RelativePattern` + or not. + + @since 3.17.0 + + -} + _relativePatternSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidChangeWatchedFilesClientCapabilities where + toJSON (DidChangeWatchedFilesClientCapabilities arg0 arg1) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"relativePatternSupport" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DidChangeWatchedFilesClientCapabilities where + parseJSON = Aeson.withObject "DidChangeWatchedFilesClientCapabilities" $ \arg -> DidChangeWatchedFilesClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "relativePatternSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesParams.hs new file mode 100644 index 000000000..a4756aed1 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesParams.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FileEvent +import qualified Language.LSP.Protocol.Types.Common + +{-| +The watched files change notification's parameters. + +-} +data DidChangeWatchedFilesParams = DidChangeWatchedFilesParams + { {-| + The actual file events. + + -} + _changes :: [Language.LSP.Protocol.Internal.Types.FileEvent.FileEvent] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidChangeWatchedFilesParams where + toJSON (DidChangeWatchedFilesParams arg0) = Aeson.object $ concat $ [["changes" Aeson..= arg0]] + +instance Aeson.FromJSON DidChangeWatchedFilesParams where + parseJSON = Aeson.withObject "DidChangeWatchedFilesParams" $ \arg -> DidChangeWatchedFilesParams <$> arg Aeson..: "changes" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesRegistrationOptions.hs new file mode 100644 index 000000000..6e7e9a155 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesRegistrationOptions.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FileSystemWatcher +import qualified Language.LSP.Protocol.Types.Common + +{-| +Describe options to be used when registered for text document change events. + +-} +data DidChangeWatchedFilesRegistrationOptions = DidChangeWatchedFilesRegistrationOptions + { {-| + The watchers to register. + + -} + _watchers :: [Language.LSP.Protocol.Internal.Types.FileSystemWatcher.FileSystemWatcher] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidChangeWatchedFilesRegistrationOptions where + toJSON (DidChangeWatchedFilesRegistrationOptions arg0) = Aeson.object $ concat $ [["watchers" Aeson..= arg0]] + +instance Aeson.FromJSON DidChangeWatchedFilesRegistrationOptions where + parseJSON = Aeson.withObject "DidChangeWatchedFilesRegistrationOptions" $ \arg -> DidChangeWatchedFilesRegistrationOptions <$> arg Aeson..: "watchers" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWorkspaceFoldersParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWorkspaceFoldersParams.hs new file mode 100644 index 000000000..8fae75858 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWorkspaceFoldersParams.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidChangeWorkspaceFoldersParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFoldersChangeEvent +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a `workspace/didChangeWorkspaceFolders` notification. + +-} +data DidChangeWorkspaceFoldersParams = DidChangeWorkspaceFoldersParams + { {-| + The actual workspace folder change event. + + -} + _event :: Language.LSP.Protocol.Internal.Types.WorkspaceFoldersChangeEvent.WorkspaceFoldersChangeEvent + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidChangeWorkspaceFoldersParams where + toJSON (DidChangeWorkspaceFoldersParams arg0) = Aeson.object $ concat $ [["event" Aeson..= arg0]] + +instance Aeson.FromJSON DidChangeWorkspaceFoldersParams where + parseJSON = Aeson.withObject "DidChangeWorkspaceFoldersParams" $ \arg -> DidChangeWorkspaceFoldersParams <$> arg Aeson..: "event" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseNotebookDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseNotebookDocumentParams.hs new file mode 100644 index 000000000..dba88ac6b --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseNotebookDocumentParams.hs @@ -0,0 +1,41 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidCloseNotebookDocumentParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentIdentifier +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The params sent in a close notebook document notification. + +@since 3.17.0 + +-} +data DidCloseNotebookDocumentParams = DidCloseNotebookDocumentParams + { {-| + The notebook document that got closed. + + -} + _notebookDocument :: Language.LSP.Protocol.Internal.Types.NotebookDocumentIdentifier.NotebookDocumentIdentifier + , {-| + The text documents that represent the content + of a notebook cell that got closed. + + -} + _cellTextDocuments :: [Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidCloseNotebookDocumentParams where + toJSON (DidCloseNotebookDocumentParams arg0 arg1) = Aeson.object $ concat $ [["notebookDocument" Aeson..= arg0] + ,["cellTextDocuments" Aeson..= arg1]] + +instance Aeson.FromJSON DidCloseNotebookDocumentParams where + parseJSON = Aeson.withObject "DidCloseNotebookDocumentParams" $ \arg -> DidCloseNotebookDocumentParams <$> arg Aeson..: "notebookDocument" <*> arg Aeson..: "cellTextDocuments" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseTextDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseTextDocumentParams.hs new file mode 100644 index 000000000..a1468d164 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseTextDocumentParams.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidCloseTextDocumentParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters sent in a close text document notification + +-} +data DidCloseTextDocumentParams = DidCloseTextDocumentParams + { {-| + The document that was closed. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidCloseTextDocumentParams where + toJSON (DidCloseTextDocumentParams arg0) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0]] + +instance Aeson.FromJSON DidCloseTextDocumentParams where + parseJSON = Aeson.withObject "DidCloseTextDocumentParams" $ \arg -> DidCloseTextDocumentParams <$> arg Aeson..: "textDocument" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenNotebookDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenNotebookDocumentParams.hs new file mode 100644 index 000000000..7b76cd49d --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenNotebookDocumentParams.hs @@ -0,0 +1,41 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidOpenNotebookDocumentParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocument +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentItem +import qualified Language.LSP.Protocol.Types.Common + +{-| +The params sent in an open notebook document notification. + +@since 3.17.0 + +-} +data DidOpenNotebookDocumentParams = DidOpenNotebookDocumentParams + { {-| + The notebook document that got opened. + + -} + _notebookDocument :: Language.LSP.Protocol.Internal.Types.NotebookDocument.NotebookDocument + , {-| + The text documents that represent the content + of a notebook cell. + + -} + _cellTextDocuments :: [Language.LSP.Protocol.Internal.Types.TextDocumentItem.TextDocumentItem] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidOpenNotebookDocumentParams where + toJSON (DidOpenNotebookDocumentParams arg0 arg1) = Aeson.object $ concat $ [["notebookDocument" Aeson..= arg0] + ,["cellTextDocuments" Aeson..= arg1]] + +instance Aeson.FromJSON DidOpenNotebookDocumentParams where + parseJSON = Aeson.withObject "DidOpenNotebookDocumentParams" $ \arg -> DidOpenNotebookDocumentParams <$> arg Aeson..: "notebookDocument" <*> arg Aeson..: "cellTextDocuments" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenTextDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenTextDocumentParams.hs new file mode 100644 index 000000000..6202c66c4 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenTextDocumentParams.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidOpenTextDocumentParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentItem +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters sent in an open text document notification + +-} +data DidOpenTextDocumentParams = DidOpenTextDocumentParams + { {-| + The document that was opened. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentItem.TextDocumentItem + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidOpenTextDocumentParams where + toJSON (DidOpenTextDocumentParams arg0) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0]] + +instance Aeson.FromJSON DidOpenTextDocumentParams where + parseJSON = Aeson.withObject "DidOpenTextDocumentParams" $ \arg -> DidOpenTextDocumentParams <$> arg Aeson..: "textDocument" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveNotebookDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveNotebookDocumentParams.hs new file mode 100644 index 000000000..bc1679ced --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveNotebookDocumentParams.hs @@ -0,0 +1,33 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidSaveNotebookDocumentParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The params sent in a save notebook document notification. + +@since 3.17.0 + +-} +data DidSaveNotebookDocumentParams = DidSaveNotebookDocumentParams + { {-| + The notebook document that got saved. + + -} + _notebookDocument :: Language.LSP.Protocol.Internal.Types.NotebookDocumentIdentifier.NotebookDocumentIdentifier + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidSaveNotebookDocumentParams where + toJSON (DidSaveNotebookDocumentParams arg0) = Aeson.object $ concat $ [["notebookDocument" Aeson..= arg0]] + +instance Aeson.FromJSON DidSaveNotebookDocumentParams where + parseJSON = Aeson.withObject "DidSaveNotebookDocumentParams" $ \arg -> DidSaveNotebookDocumentParams <$> arg Aeson..: "notebookDocument" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveTextDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveTextDocumentParams.hs new file mode 100644 index 000000000..d6859fb6e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveTextDocumentParams.hs @@ -0,0 +1,39 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DidSaveTextDocumentParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters sent in a save text document notification + +-} +data DidSaveTextDocumentParams = DidSaveTextDocumentParams + { {-| + The document that was saved. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + Optional the content when saved. Depends on the includeText value + when the save notification was requested. + + -} + _text :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DidSaveTextDocumentParams where + toJSON (DidSaveTextDocumentParams arg0 arg1) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,"text" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DidSaveTextDocumentParams where + parseJSON = Aeson.withObject "DidSaveTextDocumentParams" $ \arg -> DidSaveTextDocumentParams <$> arg Aeson..: "textDocument" <*> arg Aeson..:! "text" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorClientCapabilities.hs new file mode 100644 index 000000000..3cf822b77 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorClientCapabilities.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentColorClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data DocumentColorClientCapabilities = DocumentColorClientCapabilities + { {-| + Whether implementation supports dynamic registration. If this is set to `true` + the client supports the new `DocumentColorRegistrationOptions` return value + for the corresponding server capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentColorClientCapabilities where + toJSON (DocumentColorClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DocumentColorClientCapabilities where + parseJSON = Aeson.withObject "DocumentColorClientCapabilities" $ \arg -> DocumentColorClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorOptions.hs new file mode 100644 index 000000000..bf2c3d663 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorOptions.hs @@ -0,0 +1,28 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentColorOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data DocumentColorOptions = DocumentColorOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentColorOptions where + toJSON (DocumentColorOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DocumentColorOptions where + parseJSON = Aeson.withObject "DocumentColorOptions" $ \arg -> DocumentColorOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorParams.hs new file mode 100644 index 000000000..03fd015f0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorParams.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentColorParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +Parameters for a `DocumentColorRequest`. + +-} +data DocumentColorParams = DocumentColorParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentColorParams where + toJSON (DocumentColorParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["textDocument" Aeson..= arg2]] + +instance Aeson.FromJSON DocumentColorParams where + parseJSON = Aeson.withObject "DocumentColorParams" $ \arg -> DocumentColorParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "textDocument" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorRegistrationOptions.hs new file mode 100644 index 000000000..0e95470a5 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorRegistrationOptions.hs @@ -0,0 +1,44 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentColorRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data DocumentColorRegistrationOptions = DocumentColorRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentColorRegistrationOptions where + toJSON (DocumentColorRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"id" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON DocumentColorRegistrationOptions where + parseJSON = Aeson.withObject "DocumentColorRegistrationOptions" $ \arg -> DocumentColorRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticParams.hs new file mode 100644 index 000000000..e96fbe03d --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticParams.hs @@ -0,0 +1,60 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentDiagnosticParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +Parameters of the document diagnostic request. + +@since 3.17.0 + +-} +data DocumentDiagnosticParams = DocumentDiagnosticParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The additional identifier provided during registration. + + -} + _identifier :: (Maybe Data.Text.Text) + , {-| + The result id of a previous response if provided. + + -} + _previousResultId :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentDiagnosticParams where + toJSON (DocumentDiagnosticParams arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["textDocument" Aeson..= arg2] + ,"identifier" Language.LSP.Protocol.Types.Common..=? arg3 + ,"previousResultId" Language.LSP.Protocol.Types.Common..=? arg4] + +instance Aeson.FromJSON DocumentDiagnosticParams where + parseJSON = Aeson.withObject "DocumentDiagnosticParams" $ \arg -> DocumentDiagnosticParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "textDocument" <*> arg Aeson..:! "identifier" <*> arg Aeson..:! "previousResultId" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReport.hs new file mode 100644 index 000000000..5c25c3188 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReport.hs @@ -0,0 +1,27 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReport where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.RelatedFullDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.RelatedUnchangedDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Types.Common + +{-| +The result of a document diagnostic pull request. A report can +either be a full report containing all diagnostics for the +requested document or an unchanged report indicating that nothing +has changed in terms of diagnostics in comparison to the last +pull request. + +@since 3.17.0 + +-} +newtype DocumentDiagnosticReport = DocumentDiagnosticReport (Language.LSP.Protocol.Internal.Types.RelatedFullDocumentDiagnosticReport.RelatedFullDocumentDiagnosticReport Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.RelatedUnchangedDocumentDiagnosticReport.RelatedUnchangedDocumentDiagnosticReport) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReportKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReportKind.hs new file mode 100644 index 000000000..3a2c41fa3 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReportKind.hs @@ -0,0 +1,48 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReportKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +The document diagnostic report kinds. + +@since 3.17.0 + +-} +data DocumentDiagnosticReportKind = + {-| + A diagnostic report with a full + set of problems. + + -} + DocumentDiagnosticReportKind_Full + | {-| + A report indicating that the last + returned report is still accurate. + + -} + DocumentDiagnosticReportKind_Unchanged + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum DocumentDiagnosticReportKind Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum DocumentDiagnosticReportKind where + knownValues = Data.Set.fromList [DocumentDiagnosticReportKind_Full + ,DocumentDiagnosticReportKind_Unchanged] + type EnumBaseType DocumentDiagnosticReportKind = Data.Text.Text + toEnumBaseType DocumentDiagnosticReportKind_Full = "full" + toEnumBaseType DocumentDiagnosticReportKind_Unchanged = "unchanged" + fromEnumBaseType "full" = pure DocumentDiagnosticReportKind_Full + fromEnumBaseType "unchanged" = pure DocumentDiagnosticReportKind_Unchanged + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReportPartialResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReportPartialResult.hs new file mode 100644 index 000000000..819a20eb2 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReportPartialResult.hs @@ -0,0 +1,35 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReportPartialResult where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Map +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FullDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.UnchangedDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A partial result for a document diagnostic report. + +@since 3.17.0 + +-} +data DocumentDiagnosticReportPartialResult = DocumentDiagnosticReportPartialResult + { {-| + + -} + _relatedDocuments :: (Data.Map.Map Language.LSP.Protocol.Types.Uri.Uri (Language.LSP.Protocol.Internal.Types.FullDocumentDiagnosticReport.FullDocumentDiagnosticReport Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.UnchangedDocumentDiagnosticReport.UnchangedDocumentDiagnosticReport)) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentDiagnosticReportPartialResult where + toJSON (DocumentDiagnosticReportPartialResult arg0) = Aeson.object $ concat $ [["relatedDocuments" Aeson..= arg0]] + +instance Aeson.FromJSON DocumentDiagnosticReportPartialResult where + parseJSON = Aeson.withObject "DocumentDiagnosticReportPartialResult" $ \arg -> DocumentDiagnosticReportPartialResult <$> arg Aeson..: "relatedDocuments" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFilter.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFilter.hs new file mode 100644 index 000000000..55c23ff9f --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFilter.hs @@ -0,0 +1,24 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentFilter where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.NotebookCellTextDocumentFilter +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentFilter +import qualified Language.LSP.Protocol.Types.Common + +{-| +A document filter describes a top level text document or +a notebook cell document. + +@since 3.17.0 - proposed support for NotebookCellTextDocumentFilter. + +-} +newtype DocumentFilter = DocumentFilter (Language.LSP.Protocol.Internal.Types.TextDocumentFilter.TextDocumentFilter Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookCellTextDocumentFilter.NotebookCellTextDocumentFilter) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingClientCapabilities.hs new file mode 100644 index 000000000..5008eb20c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingClientCapabilities.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentFormattingClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client capabilities of a `DocumentFormattingRequest`. + +-} +data DocumentFormattingClientCapabilities = DocumentFormattingClientCapabilities + { {-| + Whether formatting supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentFormattingClientCapabilities where + toJSON (DocumentFormattingClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DocumentFormattingClientCapabilities where + parseJSON = Aeson.withObject "DocumentFormattingClientCapabilities" $ \arg -> DocumentFormattingClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingOptions.hs new file mode 100644 index 000000000..85e21d71a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingOptions.hs @@ -0,0 +1,29 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentFormattingOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Provider options for a `DocumentFormattingRequest`. + +-} +data DocumentFormattingOptions = DocumentFormattingOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentFormattingOptions where + toJSON (DocumentFormattingOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DocumentFormattingOptions where + parseJSON = Aeson.withObject "DocumentFormattingOptions" $ \arg -> DocumentFormattingOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingParams.hs new file mode 100644 index 000000000..9028aed4f --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingParams.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentFormattingParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FormattingOptions +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a `DocumentFormattingRequest`. + +-} +data DocumentFormattingParams = DocumentFormattingParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The document to format. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The format options. + + -} + _options :: Language.LSP.Protocol.Internal.Types.FormattingOptions.FormattingOptions + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentFormattingParams where + toJSON (DocumentFormattingParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,["textDocument" Aeson..= arg1] + ,["options" Aeson..= arg2]] + +instance Aeson.FromJSON DocumentFormattingParams where + parseJSON = Aeson.withObject "DocumentFormattingParams" $ \arg -> DocumentFormattingParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..: "textDocument" <*> arg Aeson..: "options" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingRegistrationOptions.hs new file mode 100644 index 000000000..b0f2d1344 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingRegistrationOptions.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentFormattingRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `DocumentFormattingRequest`. + +-} +data DocumentFormattingRegistrationOptions = DocumentFormattingRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentFormattingRegistrationOptions where + toJSON (DocumentFormattingRegistrationOptions arg0 arg1) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DocumentFormattingRegistrationOptions where + parseJSON = Aeson.withObject "DocumentFormattingRegistrationOptions" $ \arg -> DocumentFormattingRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlight.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlight.hs new file mode 100644 index 000000000..99f1cfc70 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlight.hs @@ -0,0 +1,40 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentHighlight where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentHighlightKind +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +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. + +-} +data DocumentHighlight = DocumentHighlight + { {-| + The range this highlight applies to. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The highlight kind, default is `DocumentHighlightKind.Text`. + + -} + _kind :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentHighlightKind.DocumentHighlightKind) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentHighlight where + toJSON (DocumentHighlight arg0 arg1) = Aeson.object $ concat $ [["range" Aeson..= arg0] + ,"kind" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DocumentHighlight where + parseJSON = Aeson.withObject "DocumentHighlight" $ \arg -> DocumentHighlight <$> arg Aeson..: "range" <*> arg Aeson..:! "kind" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightClientCapabilities.hs new file mode 100644 index 000000000..f215a2684 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightClientCapabilities.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentHighlightClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client Capabilities for a `DocumentHighlightRequest`. + +-} +data DocumentHighlightClientCapabilities = DocumentHighlightClientCapabilities + { {-| + Whether document highlight supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentHighlightClientCapabilities where + toJSON (DocumentHighlightClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DocumentHighlightClientCapabilities where + parseJSON = Aeson.withObject "DocumentHighlightClientCapabilities" $ \arg -> DocumentHighlightClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightKind.hs new file mode 100644 index 000000000..2b4de7568 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightKind.hs @@ -0,0 +1,52 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentHighlightKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +A document highlight kind. + +-} +data DocumentHighlightKind = + {-| + A textual occurrence. + + -} + DocumentHighlightKind_Text + | {-| + Read-access of a symbol, like reading a variable. + + -} + DocumentHighlightKind_Read + | {-| + Write-access of a symbol, like writing to a variable. + + -} + DocumentHighlightKind_Write + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum DocumentHighlightKind Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum DocumentHighlightKind where + knownValues = Data.Set.fromList [DocumentHighlightKind_Text + ,DocumentHighlightKind_Read + ,DocumentHighlightKind_Write] + type EnumBaseType DocumentHighlightKind = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType DocumentHighlightKind_Text = 1 + toEnumBaseType DocumentHighlightKind_Read = 2 + toEnumBaseType DocumentHighlightKind_Write = 3 + fromEnumBaseType 1 = pure DocumentHighlightKind_Text + fromEnumBaseType 2 = pure DocumentHighlightKind_Read + fromEnumBaseType 3 = pure DocumentHighlightKind_Write + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightOptions.hs new file mode 100644 index 000000000..2aa5e78bd --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightOptions.hs @@ -0,0 +1,29 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentHighlightOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Provider options for a `DocumentHighlightRequest`. + +-} +data DocumentHighlightOptions = DocumentHighlightOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentHighlightOptions where + toJSON (DocumentHighlightOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DocumentHighlightOptions where + parseJSON = Aeson.withObject "DocumentHighlightOptions" $ \arg -> DocumentHighlightOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightParams.hs new file mode 100644 index 000000000..612ba96ee --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightParams.hs @@ -0,0 +1,52 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentHighlightParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +Parameters for a `DocumentHighlightRequest`. + +-} +data DocumentHighlightParams = DocumentHighlightParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentHighlightParams where + toJSON (DocumentHighlightParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON DocumentHighlightParams where + parseJSON = Aeson.withObject "DocumentHighlightParams" $ \arg -> DocumentHighlightParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightRegistrationOptions.hs new file mode 100644 index 000000000..05d65cad0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightRegistrationOptions.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentHighlightRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `DocumentHighlightRequest`. + +-} +data DocumentHighlightRegistrationOptions = DocumentHighlightRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentHighlightRegistrationOptions where + toJSON (DocumentHighlightRegistrationOptions arg0 arg1) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DocumentHighlightRegistrationOptions where + parseJSON = Aeson.withObject "DocumentHighlightRegistrationOptions" $ \arg -> DocumentHighlightRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLink.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLink.hs new file mode 100644 index 000000000..a38641945 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLink.hs @@ -0,0 +1,59 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentLink where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +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. + +-} +data DocumentLink = DocumentLink + { {-| + The range this link applies to. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The uri this link points to. If missing a resolve request is sent later. + + -} + _target :: (Maybe Data.Text.Text) + , {-| + The tooltip text when you hover over this link. + + If a tooltip is provided, is will be displayed in a string that includes instructions on how to + trigger the link, such as `{0} (ctrl + click)`. The specific instructions vary depending on OS, + user settings, and localization. + + @since 3.15.0 + + -} + _tooltip :: (Maybe Data.Text.Text) + , {-| + A data entry field that is preserved on a document link between a + DocumentLinkRequest and a DocumentLinkResolveRequest. + + -} + _data_ :: (Maybe Data.Aeson.Value) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentLink where + toJSON (DocumentLink arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["range" Aeson..= arg0] + ,"target" Language.LSP.Protocol.Types.Common..=? arg1 + ,"tooltip" Language.LSP.Protocol.Types.Common..=? arg2 + ,"data" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON DocumentLink where + parseJSON = Aeson.withObject "DocumentLink" $ \arg -> DocumentLink <$> arg Aeson..: "range" <*> arg Aeson..:! "target" <*> arg Aeson..:! "tooltip" <*> arg Aeson..:! "data" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkClientCapabilities.hs new file mode 100644 index 000000000..a43462445 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkClientCapabilities.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentLinkClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +The client capabilities of a `DocumentLinkRequest`. + +-} +data DocumentLinkClientCapabilities = DocumentLinkClientCapabilities + { {-| + Whether document link supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + Whether the client supports the `tooltip` property on `DocumentLink`. + + @since 3.15.0 + + -} + _tooltipSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentLinkClientCapabilities where + toJSON (DocumentLinkClientCapabilities arg0 arg1) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"tooltipSupport" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DocumentLinkClientCapabilities where + parseJSON = Aeson.withObject "DocumentLinkClientCapabilities" $ \arg -> DocumentLinkClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "tooltipSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkOptions.hs new file mode 100644 index 000000000..148c9d452 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkOptions.hs @@ -0,0 +1,35 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentLinkOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Provider options for a `DocumentLinkRequest`. + +-} +data DocumentLinkOptions = DocumentLinkOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + Document links have a resolve provider as well. + + -} + _resolveProvider :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentLinkOptions where + toJSON (DocumentLinkOptions arg0 arg1) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"resolveProvider" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DocumentLinkOptions where + parseJSON = Aeson.withObject "DocumentLinkOptions" $ \arg -> DocumentLinkOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "resolveProvider" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkParams.hs new file mode 100644 index 000000000..2890876ee --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkParams.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentLinkParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a `DocumentLinkRequest`. + +-} +data DocumentLinkParams = DocumentLinkParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The document to provide document links for. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentLinkParams where + toJSON (DocumentLinkParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["textDocument" Aeson..= arg2]] + +instance Aeson.FromJSON DocumentLinkParams where + parseJSON = Aeson.withObject "DocumentLinkParams" $ \arg -> DocumentLinkParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "textDocument" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkRegistrationOptions.hs new file mode 100644 index 000000000..f1c905442 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkRegistrationOptions.hs @@ -0,0 +1,43 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentLinkRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `DocumentLinkRequest`. + +-} +data DocumentLinkRegistrationOptions = DocumentLinkRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + Document links have a resolve provider as well. + + -} + _resolveProvider :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentLinkRegistrationOptions where + toJSON (DocumentLinkRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"resolveProvider" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON DocumentLinkRegistrationOptions where + parseJSON = Aeson.withObject "DocumentLinkRegistrationOptions" $ \arg -> DocumentLinkRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "resolveProvider" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingClientCapabilities.hs new file mode 100644 index 000000000..1502c78dd --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingClientCapabilities.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client capabilities of a `DocumentOnTypeFormattingRequest`. + +-} +data DocumentOnTypeFormattingClientCapabilities = DocumentOnTypeFormattingClientCapabilities + { {-| + Whether on type formatting supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentOnTypeFormattingClientCapabilities where + toJSON (DocumentOnTypeFormattingClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DocumentOnTypeFormattingClientCapabilities where + parseJSON = Aeson.withObject "DocumentOnTypeFormattingClientCapabilities" $ \arg -> DocumentOnTypeFormattingClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingOptions.hs new file mode 100644 index 000000000..eebef24f2 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingOptions.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Provider options for a `DocumentOnTypeFormattingRequest`. + +-} +data DocumentOnTypeFormattingOptions = DocumentOnTypeFormattingOptions + { {-| + A character on which formatting should be triggered, like `{`. + + -} + _firstTriggerCharacter :: Data.Text.Text + , {-| + More trigger characters. + + -} + _moreTriggerCharacter :: (Maybe [Data.Text.Text]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentOnTypeFormattingOptions where + toJSON (DocumentOnTypeFormattingOptions arg0 arg1) = Aeson.object $ concat $ [["firstTriggerCharacter" Aeson..= arg0] + ,"moreTriggerCharacter" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DocumentOnTypeFormattingOptions where + parseJSON = Aeson.withObject "DocumentOnTypeFormattingOptions" $ \arg -> DocumentOnTypeFormattingOptions <$> arg Aeson..: "firstTriggerCharacter" <*> arg Aeson..:! "moreTriggerCharacter" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingParams.hs new file mode 100644 index 000000000..83b01d7be --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingParams.hs @@ -0,0 +1,57 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.FormattingOptions +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a `DocumentOnTypeFormattingRequest`. + +-} +data DocumentOnTypeFormattingParams = DocumentOnTypeFormattingParams + { {-| + The document to format. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position around which the on type formatting should happen. + This is not necessarily the exact position where the character denoted + by the property `ch` got typed. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + The character that has been typed that triggered the formatting + on type request. That is not necessarily the last character that + got inserted into the document since the client could auto insert + characters as well (e.g. like automatic brace completion). + + -} + _ch :: Data.Text.Text + , {-| + The formatting options. + + -} + _options :: Language.LSP.Protocol.Internal.Types.FormattingOptions.FormattingOptions + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentOnTypeFormattingParams where + toJSON (DocumentOnTypeFormattingParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,["ch" Aeson..= arg2] + ,["options" Aeson..= arg3]] + +instance Aeson.FromJSON DocumentOnTypeFormattingParams where + parseJSON = Aeson.withObject "DocumentOnTypeFormattingParams" $ \arg -> DocumentOnTypeFormattingParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..: "ch" <*> arg Aeson..: "options" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingRegistrationOptions.hs new file mode 100644 index 000000000..2b53970c5 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingRegistrationOptions.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `DocumentOnTypeFormattingRequest`. + +-} +data DocumentOnTypeFormattingRegistrationOptions = DocumentOnTypeFormattingRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + A character on which formatting should be triggered, like `{`. + + -} + _firstTriggerCharacter :: Data.Text.Text + , {-| + More trigger characters. + + -} + _moreTriggerCharacter :: (Maybe [Data.Text.Text]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentOnTypeFormattingRegistrationOptions where + toJSON (DocumentOnTypeFormattingRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,["firstTriggerCharacter" Aeson..= arg1] + ,"moreTriggerCharacter" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON DocumentOnTypeFormattingRegistrationOptions where + parseJSON = Aeson.withObject "DocumentOnTypeFormattingRegistrationOptions" $ \arg -> DocumentOnTypeFormattingRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..: "firstTriggerCharacter" <*> arg Aeson..:! "moreTriggerCharacter" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingClientCapabilities.hs new file mode 100644 index 000000000..8275f6a55 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingClientCapabilities.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client capabilities of a `DocumentRangeFormattingRequest`. + +-} +data DocumentRangeFormattingClientCapabilities = DocumentRangeFormattingClientCapabilities + { {-| + Whether range formatting supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentRangeFormattingClientCapabilities where + toJSON (DocumentRangeFormattingClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DocumentRangeFormattingClientCapabilities where + parseJSON = Aeson.withObject "DocumentRangeFormattingClientCapabilities" $ \arg -> DocumentRangeFormattingClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingOptions.hs new file mode 100644 index 000000000..ea493bd2e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingOptions.hs @@ -0,0 +1,29 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Provider options for a `DocumentRangeFormattingRequest`. + +-} +data DocumentRangeFormattingOptions = DocumentRangeFormattingOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentRangeFormattingOptions where + toJSON (DocumentRangeFormattingOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON DocumentRangeFormattingOptions where + parseJSON = Aeson.withObject "DocumentRangeFormattingOptions" $ \arg -> DocumentRangeFormattingOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingParams.hs new file mode 100644 index 000000000..f56f0d46b --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingParams.hs @@ -0,0 +1,52 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FormattingOptions +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a `DocumentRangeFormattingRequest`. + +-} +data DocumentRangeFormattingParams = DocumentRangeFormattingParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The document to format. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The range to format + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The format options + + -} + _options :: Language.LSP.Protocol.Internal.Types.FormattingOptions.FormattingOptions + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentRangeFormattingParams where + toJSON (DocumentRangeFormattingParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,["textDocument" Aeson..= arg1] + ,["range" Aeson..= arg2] + ,["options" Aeson..= arg3]] + +instance Aeson.FromJSON DocumentRangeFormattingParams where + parseJSON = Aeson.withObject "DocumentRangeFormattingParams" $ \arg -> DocumentRangeFormattingParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..: "textDocument" <*> arg Aeson..: "range" <*> arg Aeson..: "options" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingRegistrationOptions.hs new file mode 100644 index 000000000..f928a272b --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingRegistrationOptions.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `DocumentRangeFormattingRequest`. + +-} +data DocumentRangeFormattingRegistrationOptions = DocumentRangeFormattingRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentRangeFormattingRegistrationOptions where + toJSON (DocumentRangeFormattingRegistrationOptions arg0 arg1) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DocumentRangeFormattingRegistrationOptions where + parseJSON = Aeson.withObject "DocumentRangeFormattingRegistrationOptions" $ \arg -> DocumentRangeFormattingRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSelector.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSelector.hs new file mode 100644 index 000000000..d55bc66d1 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSelector.hs @@ -0,0 +1,23 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentSelector where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentFilter + +{-| +A document selector is the combination of one or many document filters. + +@sample `let sel:DocumentSelector = [{ language: 'typescript' }, { language: 'json', pattern: '**∕tsconfig.json' }]`; + +The use of a string as a document filter is deprecated @since 3.16.0. + +-} +newtype DocumentSelector = DocumentSelector [Language.LSP.Protocol.Internal.Types.DocumentFilter.DocumentFilter] + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbol.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbol.hs new file mode 100644 index 000000000..fd14803f0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbol.hs @@ -0,0 +1,88 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentSymbol where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Internal.Types.SymbolKind +import qualified Language.LSP.Protocol.Internal.Types.SymbolTag +import qualified Language.LSP.Protocol.Types.Common + +{-# DEPRECATED _deprecated "Use tags instead" #-} +{-| +Represents programming constructs like variables, classes, interfaces etc. +that appear in a document. Document symbols can be hierarchical and they +have two ranges: one that encloses its definition and one that points to +its most interesting range, e.g. the range of an identifier. + +-} +data DocumentSymbol = DocumentSymbol + { {-| + The name of this symbol. Will be displayed in the user interface and therefore must not be + an empty string or a string only consisting of white spaces. + + -} + _name :: Data.Text.Text + , {-| + More detail for this symbol, e.g the signature of a function. + + -} + _detail :: (Maybe Data.Text.Text) + , {-| + The kind of this symbol. + + -} + _kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind + , {-| + Tags for this document symbol. + + @since 3.16.0 + + -} + _tags :: (Maybe [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag]) + , {-| + Indicates if this symbol is deprecated. + + @deprecated Use tags instead + + -} + _deprecated :: (Maybe Bool) + , {-| + The range enclosing this symbol not including leading/trailing whitespace but everything else + like comments. This information is typically used to determine if the clients cursor is + inside the symbol to reveal in the symbol in the UI. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The range that should be selected and revealed when this symbol is being picked, e.g the name of a function. + Must be contained by the `range`. + + -} + _selectionRange :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + Children of this symbol, e.g. properties of a class. + + -} + _children :: (Maybe [Language.LSP.Protocol.Internal.Types.DocumentSymbol.DocumentSymbol]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentSymbol where + toJSON (DocumentSymbol arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7) = Aeson.object $ concat $ [["name" Aeson..= arg0] + ,"detail" Language.LSP.Protocol.Types.Common..=? arg1 + ,["kind" Aeson..= arg2] + ,"tags" Language.LSP.Protocol.Types.Common..=? arg3 + ,"deprecated" Language.LSP.Protocol.Types.Common..=? arg4 + ,["range" Aeson..= arg5] + ,["selectionRange" Aeson..= arg6] + ,"children" Language.LSP.Protocol.Types.Common..=? arg7] + +instance Aeson.FromJSON DocumentSymbol where + parseJSON = Aeson.withObject "DocumentSymbol" $ \arg -> DocumentSymbol <$> arg Aeson..: "name" <*> arg Aeson..:! "detail" <*> arg Aeson..: "kind" <*> arg Aeson..:! "tags" <*> arg Aeson..:! "deprecated" <*> arg Aeson..: "range" <*> arg Aeson..: "selectionRange" <*> arg Aeson..:! "children" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolClientCapabilities.hs new file mode 100644 index 000000000..bad6438dd --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolClientCapabilities.hs @@ -0,0 +1,65 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentSymbolClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.SymbolKind +import qualified Language.LSP.Protocol.Internal.Types.SymbolTag +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client Capabilities for a `DocumentSymbolRequest`. + +-} +data DocumentSymbolClientCapabilities = DocumentSymbolClientCapabilities + { {-| + Whether document symbol supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + Specific capabilities for the `SymbolKind` in the + `textDocument/documentSymbol` request. + + -} + _symbolKind :: (Maybe (Row.Rec ("valueSet" Row..== (Maybe [Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind]) Row..+ Row.Empty))) + , {-| + The client supports hierarchical document symbols. + + -} + _hierarchicalDocumentSymbolSupport :: (Maybe Bool) + , {-| + The client supports tags on `SymbolInformation`. Tags are supported on + `DocumentSymbol` if `hierarchicalDocumentSymbolSupport` is set to true. + Clients supporting tags have to handle unknown tags gracefully. + + @since 3.16.0 + + -} + _tagSupport :: (Maybe (Row.Rec ("valueSet" Row..== [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag] Row..+ Row.Empty))) + , {-| + The client supports an additional label presented in the UI when + registering a document symbol provider. + + @since 3.16.0 + + -} + _labelSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentSymbolClientCapabilities where + toJSON (DocumentSymbolClientCapabilities arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"symbolKind" Language.LSP.Protocol.Types.Common..=? arg1 + ,"hierarchicalDocumentSymbolSupport" Language.LSP.Protocol.Types.Common..=? arg2 + ,"tagSupport" Language.LSP.Protocol.Types.Common..=? arg3 + ,"labelSupport" Language.LSP.Protocol.Types.Common..=? arg4] + +instance Aeson.FromJSON DocumentSymbolClientCapabilities where + parseJSON = Aeson.withObject "DocumentSymbolClientCapabilities" $ \arg -> DocumentSymbolClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "symbolKind" <*> arg Aeson..:! "hierarchicalDocumentSymbolSupport" <*> arg Aeson..:! "tagSupport" <*> arg Aeson..:! "labelSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolOptions.hs new file mode 100644 index 000000000..ca6a6061c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolOptions.hs @@ -0,0 +1,39 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentSymbolOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Provider options for a `DocumentSymbolRequest`. + +-} +data DocumentSymbolOptions = DocumentSymbolOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + A human-readable string that is shown when multiple outlines trees + are shown for the same document. + + @since 3.16.0 + + -} + _label :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentSymbolOptions where + toJSON (DocumentSymbolOptions arg0 arg1) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"label" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON DocumentSymbolOptions where + parseJSON = Aeson.withObject "DocumentSymbolOptions" $ \arg -> DocumentSymbolOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "label" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolParams.hs new file mode 100644 index 000000000..95a296444 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolParams.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentSymbolParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +Parameters for a `DocumentSymbolRequest`. + +-} +data DocumentSymbolParams = DocumentSymbolParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentSymbolParams where + toJSON (DocumentSymbolParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["textDocument" Aeson..= arg2]] + +instance Aeson.FromJSON DocumentSymbolParams where + parseJSON = Aeson.withObject "DocumentSymbolParams" $ \arg -> DocumentSymbolParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "textDocument" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolRegistrationOptions.hs new file mode 100644 index 000000000..7bce1b673 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolRegistrationOptions.hs @@ -0,0 +1,47 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.DocumentSymbolRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `DocumentSymbolRequest`. + +-} +data DocumentSymbolRegistrationOptions = DocumentSymbolRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + A human-readable string that is shown when multiple outlines trees + are shown for the same document. + + @since 3.16.0 + + -} + _label :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON DocumentSymbolRegistrationOptions where + toJSON (DocumentSymbolRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"label" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON DocumentSymbolRegistrationOptions where + parseJSON = Aeson.withObject "DocumentSymbolRegistrationOptions" $ \arg -> DocumentSymbolRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "label" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ErrorCodes.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ErrorCodes.hs new file mode 100644 index 000000000..d1f3a79be --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ErrorCodes.hs @@ -0,0 +1,83 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ErrorCodes where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +Predefined error codes. + +-} +data ErrorCodes = + {-| + + -} + ErrorCodes_ParseError + | {-| + + -} + ErrorCodes_InvalidRequest + | {-| + + -} + ErrorCodes_MethodNotFound + | {-| + + -} + ErrorCodes_InvalidParams + | {-| + + -} + ErrorCodes_InternalError + | {-| + Error code indicating that a server received a notification or + request before the server has received the `initialize` request. + + -} + ErrorCodes_ServerNotInitialized + | {-| + + -} + ErrorCodes_UnknownErrorCode + | ErrorCodes_Custom Language.LSP.Protocol.Types.Common.Int32 + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum ErrorCodes Language.LSP.Protocol.Types.Common.Int32) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum ErrorCodes where + knownValues = Data.Set.fromList [ErrorCodes_ParseError + ,ErrorCodes_InvalidRequest + ,ErrorCodes_MethodNotFound + ,ErrorCodes_InvalidParams + ,ErrorCodes_InternalError + ,ErrorCodes_ServerNotInitialized + ,ErrorCodes_UnknownErrorCode] + type EnumBaseType ErrorCodes = Language.LSP.Protocol.Types.Common.Int32 + toEnumBaseType ErrorCodes_ParseError = -32700 + toEnumBaseType ErrorCodes_InvalidRequest = -32600 + toEnumBaseType ErrorCodes_MethodNotFound = -32601 + toEnumBaseType ErrorCodes_InvalidParams = -32602 + toEnumBaseType ErrorCodes_InternalError = -32603 + toEnumBaseType ErrorCodes_ServerNotInitialized = -32002 + toEnumBaseType ErrorCodes_UnknownErrorCode = -32001 + toEnumBaseType (ErrorCodes_Custom arg) = arg + +instance Language.LSP.Protocol.Types.LspEnum.LspOpenEnum ErrorCodes where + fromOpenEnumBaseType -32700 = ErrorCodes_ParseError + fromOpenEnumBaseType -32600 = ErrorCodes_InvalidRequest + fromOpenEnumBaseType -32601 = ErrorCodes_MethodNotFound + fromOpenEnumBaseType -32602 = ErrorCodes_InvalidParams + fromOpenEnumBaseType -32603 = ErrorCodes_InternalError + fromOpenEnumBaseType -32002 = ErrorCodes_ServerNotInitialized + fromOpenEnumBaseType -32001 = ErrorCodes_UnknownErrorCode + fromOpenEnumBaseType arg = ErrorCodes_Custom arg + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandClientCapabilities.hs new file mode 100644 index 000000000..091897276 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandClientCapabilities.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ExecuteCommandClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +The client capabilities of a `ExecuteCommandRequest`. + +-} +data ExecuteCommandClientCapabilities = ExecuteCommandClientCapabilities + { {-| + Execute command supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ExecuteCommandClientCapabilities where + toJSON (ExecuteCommandClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON ExecuteCommandClientCapabilities where + parseJSON = Aeson.withObject "ExecuteCommandClientCapabilities" $ \arg -> ExecuteCommandClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandOptions.hs new file mode 100644 index 000000000..404d13e9d --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandOptions.hs @@ -0,0 +1,36 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ExecuteCommandOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +The server capabilities of a `ExecuteCommandRequest`. + +-} +data ExecuteCommandOptions = ExecuteCommandOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The commands to be executed on the server + + -} + _commands :: [Data.Text.Text] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ExecuteCommandOptions where + toJSON (ExecuteCommandOptions arg0 arg1) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,["commands" Aeson..= arg1]] + +instance Aeson.FromJSON ExecuteCommandOptions where + parseJSON = Aeson.withObject "ExecuteCommandOptions" $ \arg -> ExecuteCommandOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..: "commands" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandParams.hs new file mode 100644 index 000000000..92fe7641a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandParams.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ExecuteCommandParams where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a `ExecuteCommandRequest`. + +-} +data ExecuteCommandParams = ExecuteCommandParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The identifier of the actual command handler. + + -} + _command :: Data.Text.Text + , {-| + Arguments that the command should be invoked with. + + -} + _arguments :: (Maybe [Data.Aeson.Value]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ExecuteCommandParams where + toJSON (ExecuteCommandParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,["command" Aeson..= arg1] + ,"arguments" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON ExecuteCommandParams where + parseJSON = Aeson.withObject "ExecuteCommandParams" $ \arg -> ExecuteCommandParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..: "command" <*> arg Aeson..:! "arguments" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandRegistrationOptions.hs new file mode 100644 index 000000000..b9549eb8e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandRegistrationOptions.hs @@ -0,0 +1,36 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ExecuteCommandRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `ExecuteCommandRequest`. + +-} +data ExecuteCommandRegistrationOptions = ExecuteCommandRegistrationOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The commands to be executed on the server + + -} + _commands :: [Data.Text.Text] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ExecuteCommandRegistrationOptions where + toJSON (ExecuteCommandRegistrationOptions arg0 arg1) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,["commands" Aeson..= arg1]] + +instance Aeson.FromJSON ExecuteCommandRegistrationOptions where + parseJSON = Aeson.withObject "ExecuteCommandRegistrationOptions" $ \arg -> ExecuteCommandRegistrationOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..: "commands" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecutionSummary.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecutionSummary.hs new file mode 100644 index 000000000..5eb499899 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecutionSummary.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ExecutionSummary where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data ExecutionSummary = ExecutionSummary + { {-| + A strict monotonically increasing value + indicating the execution order of a cell + inside a notebook. + + -} + _executionOrder :: Language.LSP.Protocol.Types.Common.UInt + , {-| + Whether the execution was successful or + not if known by the client. + + -} + _success :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ExecutionSummary where + toJSON (ExecutionSummary arg0 arg1) = Aeson.object $ concat $ [["executionOrder" Aeson..= arg0] + ,"success" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON ExecutionSummary where + parseJSON = Aeson.withObject "ExecutionSummary" $ \arg -> ExecutionSummary <$> arg Aeson..: "executionOrder" <*> arg Aeson..:! "success" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FailureHandlingKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FailureHandlingKind.hs new file mode 100644 index 000000000..3c7843e0c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FailureHandlingKind.hs @@ -0,0 +1,64 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FailureHandlingKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| + +-} +data FailureHandlingKind = + {-| + Applying the workspace change is simply aborted if one of the changes provided + fails. All operations executed before the failing operation stay executed. + + -} + FailureHandlingKind_Abort + | {-| + All operations are executed transactional. That means they either all + succeed or no changes at all are applied to the workspace. + + -} + FailureHandlingKind_Transactional + | {-| + If the workspace edit contains only textual file changes they are executed transactional. + If resource changes (create, rename or delete file) are part of the change the failure + handling strategy is abort. + + -} + FailureHandlingKind_TextOnlyTransactional + | {-| + The client tries to undo the operations already executed. But there is no + guarantee that this is succeeding. + + -} + FailureHandlingKind_Undo + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum FailureHandlingKind Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum FailureHandlingKind where + knownValues = Data.Set.fromList [FailureHandlingKind_Abort + ,FailureHandlingKind_Transactional + ,FailureHandlingKind_TextOnlyTransactional + ,FailureHandlingKind_Undo] + type EnumBaseType FailureHandlingKind = Data.Text.Text + toEnumBaseType FailureHandlingKind_Abort = "abort" + toEnumBaseType FailureHandlingKind_Transactional = "transactional" + toEnumBaseType FailureHandlingKind_TextOnlyTransactional = "textOnlyTransactional" + toEnumBaseType FailureHandlingKind_Undo = "undo" + fromEnumBaseType "abort" = pure FailureHandlingKind_Abort + fromEnumBaseType "transactional" = pure FailureHandlingKind_Transactional + fromEnumBaseType "textOnlyTransactional" = pure FailureHandlingKind_TextOnlyTransactional + fromEnumBaseType "undo" = pure FailureHandlingKind_Undo + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileChangeType.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileChangeType.hs new file mode 100644 index 000000000..480e34319 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileChangeType.hs @@ -0,0 +1,52 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileChangeType where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +The file event type + +-} +data FileChangeType = + {-| + The file got created. + + -} + FileChangeType_Created + | {-| + The file got changed. + + -} + FileChangeType_Changed + | {-| + The file got deleted. + + -} + FileChangeType_Deleted + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum FileChangeType Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum FileChangeType where + knownValues = Data.Set.fromList [FileChangeType_Created + ,FileChangeType_Changed + ,FileChangeType_Deleted] + type EnumBaseType FileChangeType = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType FileChangeType_Created = 1 + toEnumBaseType FileChangeType_Changed = 2 + toEnumBaseType FileChangeType_Deleted = 3 + fromEnumBaseType 1 = pure FileChangeType_Created + fromEnumBaseType 2 = pure FileChangeType_Changed + fromEnumBaseType 3 = pure FileChangeType_Deleted + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileCreate.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileCreate.hs new file mode 100644 index 000000000..85c2db237 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileCreate.hs @@ -0,0 +1,33 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileCreate where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents information on a file/folder create. + +@since 3.16.0 + +-} +data FileCreate = FileCreate + { {-| + A file:// URI for the location of the file/folder being created. + + -} + _uri :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FileCreate where + toJSON (FileCreate arg0) = Aeson.object $ concat $ [["uri" Aeson..= arg0]] + +instance Aeson.FromJSON FileCreate where + parseJSON = Aeson.withObject "FileCreate" $ \arg -> FileCreate <$> arg Aeson..: "uri" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileDelete.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileDelete.hs new file mode 100644 index 000000000..6fe264d35 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileDelete.hs @@ -0,0 +1,33 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileDelete where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents information on a file/folder delete. + +@since 3.16.0 + +-} +data FileDelete = FileDelete + { {-| + A file:// URI for the location of the file/folder being deleted. + + -} + _uri :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FileDelete where + toJSON (FileDelete arg0) = Aeson.object $ concat $ [["uri" Aeson..= arg0]] + +instance Aeson.FromJSON FileDelete where + parseJSON = Aeson.withObject "FileDelete" $ \arg -> FileDelete <$> arg Aeson..: "uri" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileEvent.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileEvent.hs new file mode 100644 index 000000000..13bf40e46 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileEvent.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileEvent where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FileChangeType +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +An event describing a file change. + +-} +data FileEvent = FileEvent + { {-| + The file's uri. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The change type. + + -} + _type_ :: Language.LSP.Protocol.Internal.Types.FileChangeType.FileChangeType + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FileEvent where + toJSON (FileEvent arg0 arg1) = Aeson.object $ concat $ [["uri" Aeson..= arg0] + ,["type" Aeson..= arg1]] + +instance Aeson.FromJSON FileEvent where + parseJSON = Aeson.withObject "FileEvent" $ \arg -> FileEvent <$> arg Aeson..: "uri" <*> arg Aeson..: "type" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationClientCapabilities.hs new file mode 100644 index 000000000..76743b09a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationClientCapabilities.hs @@ -0,0 +1,71 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileOperationClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Capabilities relating to events from file operations by the user in the client. + +These events do not come from the file system, they come from user operations +like renaming a file in the UI. + +@since 3.16.0 + +-} +data FileOperationClientCapabilities = FileOperationClientCapabilities + { {-| + Whether the client supports dynamic registration for file requests/notifications. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + The client has support for sending didCreateFiles notifications. + + -} + _didCreate :: (Maybe Bool) + , {-| + The client has support for sending willCreateFiles requests. + + -} + _willCreate :: (Maybe Bool) + , {-| + The client has support for sending didRenameFiles notifications. + + -} + _didRename :: (Maybe Bool) + , {-| + The client has support for sending willRenameFiles requests. + + -} + _willRename :: (Maybe Bool) + , {-| + The client has support for sending didDeleteFiles notifications. + + -} + _didDelete :: (Maybe Bool) + , {-| + The client has support for sending willDeleteFiles requests. + + -} + _willDelete :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FileOperationClientCapabilities where + toJSON (FileOperationClientCapabilities arg0 arg1 arg2 arg3 arg4 arg5 arg6) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"didCreate" Language.LSP.Protocol.Types.Common..=? arg1 + ,"willCreate" Language.LSP.Protocol.Types.Common..=? arg2 + ,"didRename" Language.LSP.Protocol.Types.Common..=? arg3 + ,"willRename" Language.LSP.Protocol.Types.Common..=? arg4 + ,"didDelete" Language.LSP.Protocol.Types.Common..=? arg5 + ,"willDelete" Language.LSP.Protocol.Types.Common..=? arg6] + +instance Aeson.FromJSON FileOperationClientCapabilities where + parseJSON = Aeson.withObject "FileOperationClientCapabilities" $ \arg -> FileOperationClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "didCreate" <*> arg Aeson..:! "willCreate" <*> arg Aeson..:! "didRename" <*> arg Aeson..:! "willRename" <*> arg Aeson..:! "didDelete" <*> arg Aeson..:! "willDelete" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationFilter.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationFilter.hs new file mode 100644 index 000000000..f48cfcbcc --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationFilter.hs @@ -0,0 +1,41 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileOperationFilter where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.FileOperationPattern +import qualified Language.LSP.Protocol.Types.Common + +{-| +A filter to describe in which file operation requests or notifications +the server is interested in receiving. + +@since 3.16.0 + +-} +data FileOperationFilter = FileOperationFilter + { {-| + A Uri scheme like `file` or `untitled`. + + -} + _scheme :: (Maybe Data.Text.Text) + , {-| + The actual file operation pattern. + + -} + _pattern :: Language.LSP.Protocol.Internal.Types.FileOperationPattern.FileOperationPattern + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FileOperationFilter where + toJSON (FileOperationFilter arg0 arg1) = Aeson.object $ concat $ ["scheme" Language.LSP.Protocol.Types.Common..=? arg0 + ,["pattern" Aeson..= arg1]] + +instance Aeson.FromJSON FileOperationFilter where + parseJSON = Aeson.withObject "FileOperationFilter" $ \arg -> FileOperationFilter <$> arg Aeson..:! "scheme" <*> arg Aeson..: "pattern" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationOptions.hs new file mode 100644 index 000000000..f4627e06e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationOptions.hs @@ -0,0 +1,63 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileOperationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions +import qualified Language.LSP.Protocol.Types.Common + +{-| +Options for notifications/requests for user operations on files. + +@since 3.16.0 + +-} +data FileOperationOptions = FileOperationOptions + { {-| + The server is interested in receiving didCreateFiles notifications. + + -} + _didCreate :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions) + , {-| + The server is interested in receiving willCreateFiles requests. + + -} + _willCreate :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions) + , {-| + The server is interested in receiving didRenameFiles notifications. + + -} + _didRename :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions) + , {-| + The server is interested in receiving willRenameFiles requests. + + -} + _willRename :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions) + , {-| + The server is interested in receiving didDeleteFiles file notifications. + + -} + _didDelete :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions) + , {-| + The server is interested in receiving willDeleteFiles file requests. + + -} + _willDelete :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FileOperationOptions where + toJSON (FileOperationOptions arg0 arg1 arg2 arg3 arg4 arg5) = Aeson.object $ concat $ ["didCreate" Language.LSP.Protocol.Types.Common..=? arg0 + ,"willCreate" Language.LSP.Protocol.Types.Common..=? arg1 + ,"didRename" Language.LSP.Protocol.Types.Common..=? arg2 + ,"willRename" Language.LSP.Protocol.Types.Common..=? arg3 + ,"didDelete" Language.LSP.Protocol.Types.Common..=? arg4 + ,"willDelete" Language.LSP.Protocol.Types.Common..=? arg5] + +instance Aeson.FromJSON FileOperationOptions where + parseJSON = Aeson.withObject "FileOperationOptions" $ \arg -> FileOperationOptions <$> arg Aeson..:! "didCreate" <*> arg Aeson..:! "willCreate" <*> arg Aeson..:! "didRename" <*> arg Aeson..:! "willRename" <*> arg Aeson..:! "didDelete" <*> arg Aeson..:! "willDelete" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPattern.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPattern.hs new file mode 100644 index 000000000..4e73ab582 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPattern.hs @@ -0,0 +1,56 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileOperationPattern where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.FileOperationPatternKind +import qualified Language.LSP.Protocol.Internal.Types.FileOperationPatternOptions +import qualified Language.LSP.Protocol.Types.Common + +{-| +A pattern to describe in which file operation requests or notifications +the server is interested in receiving. + +@since 3.16.0 + +-} +data FileOperationPattern = FileOperationPattern + { {-| + The glob pattern to match. Glob patterns can have the following syntax: + - `*` to match one or more characters in a path segment + - `?` to match on one character in a path segment + - `**` to match any number of path segments, including none + - `{}` to group sub patterns into an OR expression. (e.g. `**​/*.{ts,js}` matches all TypeScript and JavaScript files) + - `[]` to declare a range of characters to match in a path segment (e.g., `example.[0-9]` to match on `example.0`, `example.1`, …) + - `[!...]` to negate a range of characters to match in a path segment (e.g., `example.[!0-9]` to match on `example.a`, `example.b`, but not `example.0`) + + -} + _glob :: Data.Text.Text + , {-| + Whether to match files or folders with this pattern. + + Matches both if undefined. + + -} + _matches :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationPatternKind.FileOperationPatternKind) + , {-| + Additional options used during matching. + + -} + _options :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationPatternOptions.FileOperationPatternOptions) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FileOperationPattern where + toJSON (FileOperationPattern arg0 arg1 arg2) = Aeson.object $ concat $ [["glob" Aeson..= arg0] + ,"matches" Language.LSP.Protocol.Types.Common..=? arg1 + ,"options" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON FileOperationPattern where + parseJSON = Aeson.withObject "FileOperationPattern" $ \arg -> FileOperationPattern <$> arg Aeson..: "glob" <*> arg Aeson..:! "matches" <*> arg Aeson..:! "options" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPatternKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPatternKind.hs new file mode 100644 index 000000000..d5e6be43a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPatternKind.hs @@ -0,0 +1,47 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileOperationPatternKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +A pattern kind describing if a glob pattern matches a file a folder or +both. + +@since 3.16.0 + +-} +data FileOperationPatternKind = + {-| + The pattern matches a file only. + + -} + FileOperationPatternKind_File + | {-| + The pattern matches a folder only. + + -} + FileOperationPatternKind_Folder + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum FileOperationPatternKind Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum FileOperationPatternKind where + knownValues = Data.Set.fromList [FileOperationPatternKind_File + ,FileOperationPatternKind_Folder] + type EnumBaseType FileOperationPatternKind = Data.Text.Text + toEnumBaseType FileOperationPatternKind_File = "file" + toEnumBaseType FileOperationPatternKind_Folder = "folder" + fromEnumBaseType "file" = pure FileOperationPatternKind_File + fromEnumBaseType "folder" = pure FileOperationPatternKind_Folder + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPatternOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPatternOptions.hs new file mode 100644 index 000000000..b3f0a34a5 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPatternOptions.hs @@ -0,0 +1,32 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileOperationPatternOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Matching options for the file operation pattern. + +@since 3.16.0 + +-} +data FileOperationPatternOptions = FileOperationPatternOptions + { {-| + The pattern should be matched ignoring casing. + + -} + _ignoreCase :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FileOperationPatternOptions where + toJSON (FileOperationPatternOptions arg0) = Aeson.object $ concat $ ["ignoreCase" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON FileOperationPatternOptions where + parseJSON = Aeson.withObject "FileOperationPatternOptions" $ \arg -> FileOperationPatternOptions <$> arg Aeson..:! "ignoreCase" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationRegistrationOptions.hs new file mode 100644 index 000000000..52a3c3724 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationRegistrationOptions.hs @@ -0,0 +1,33 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FileOperationFilter +import qualified Language.LSP.Protocol.Types.Common + +{-| +The options to register for file operations. + +@since 3.16.0 + +-} +data FileOperationRegistrationOptions = FileOperationRegistrationOptions + { {-| + The actual filters. + + -} + _filters :: [Language.LSP.Protocol.Internal.Types.FileOperationFilter.FileOperationFilter] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FileOperationRegistrationOptions where + toJSON (FileOperationRegistrationOptions arg0) = Aeson.object $ concat $ [["filters" Aeson..= arg0]] + +instance Aeson.FromJSON FileOperationRegistrationOptions where + parseJSON = Aeson.withObject "FileOperationRegistrationOptions" $ \arg -> FileOperationRegistrationOptions <$> arg Aeson..: "filters" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileRename.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileRename.hs new file mode 100644 index 000000000..4d15665fa --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileRename.hs @@ -0,0 +1,39 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileRename where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents information on a file/folder rename. + +@since 3.16.0 + +-} +data FileRename = FileRename + { {-| + A file:// URI for the original location of the file/folder being renamed. + + -} + _oldUri :: Data.Text.Text + , {-| + A file:// URI for the new location of the file/folder being renamed. + + -} + _newUri :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FileRename where + toJSON (FileRename arg0 arg1) = Aeson.object $ concat $ [["oldUri" Aeson..= arg0] + ,["newUri" Aeson..= arg1]] + +instance Aeson.FromJSON FileRename where + parseJSON = Aeson.withObject "FileRename" $ \arg -> FileRename <$> arg Aeson..: "oldUri" <*> arg Aeson..: "newUri" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileSystemWatcher.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileSystemWatcher.hs new file mode 100644 index 000000000..6ee8fa266 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileSystemWatcher.hs @@ -0,0 +1,41 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FileSystemWatcher where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.GlobPattern +import qualified Language.LSP.Protocol.Internal.Types.WatchKind +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data FileSystemWatcher = FileSystemWatcher + { {-| + The glob pattern to watch. See `GlobPattern` for more detail. + + @since 3.17.0 support for relative patterns. + + -} + _globPattern :: Language.LSP.Protocol.Internal.Types.GlobPattern.GlobPattern + , {-| + The kind of events of interest. If omitted it defaults + to WatchKind.Create | WatchKind.Change | WatchKind.Delete + which is 7. + + -} + _kind :: (Maybe Language.LSP.Protocol.Internal.Types.WatchKind.WatchKind) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FileSystemWatcher where + toJSON (FileSystemWatcher arg0 arg1) = Aeson.object $ concat $ [["globPattern" Aeson..= arg0] + ,"kind" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON FileSystemWatcher where + parseJSON = Aeson.withObject "FileSystemWatcher" $ \arg -> FileSystemWatcher <$> arg Aeson..: "globPattern" <*> arg Aeson..:! "kind" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRange.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRange.hs new file mode 100644 index 000000000..19f84b4be --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRange.hs @@ -0,0 +1,71 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FoldingRange where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.FoldingRangeKind +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents a folding range. To be valid, start and end line must be bigger than zero and smaller +than the number of lines in the document. Clients are free to ignore invalid ranges. + +-} +data FoldingRange = FoldingRange + { {-| + The zero-based start line of the range to fold. The folded area starts after the line's last character. + To be valid, the end must be zero or larger and smaller than the number of lines in the document. + + -} + _startLine :: Language.LSP.Protocol.Types.Common.UInt + , {-| + The zero-based character offset from where the folded range starts. If not defined, defaults to the length of the start line. + + -} + _startCharacter :: (Maybe Language.LSP.Protocol.Types.Common.UInt) + , {-| + The zero-based end line of the range to fold. The folded area ends with the line's last character. + To be valid, the end must be zero or larger and smaller than the number of lines in the document. + + -} + _endLine :: Language.LSP.Protocol.Types.Common.UInt + , {-| + The zero-based character offset before the folded range ends. If not defined, defaults to the length of the end line. + + -} + _endCharacter :: (Maybe Language.LSP.Protocol.Types.Common.UInt) + , {-| + Describes the kind of the folding range such as `comment' or 'region'. The kind + is used to categorize folding ranges and used by commands like 'Fold all comments'. + See `FoldingRangeKind` for an enumeration of standardized kinds. + + -} + _kind :: (Maybe Language.LSP.Protocol.Internal.Types.FoldingRangeKind.FoldingRangeKind) + , {-| + The text that the client should show when the specified range is + collapsed. If not defined or not supported by the client, a default + will be chosen by the client. + + @since 3.17.0 + + -} + _collapsedText :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FoldingRange where + toJSON (FoldingRange arg0 arg1 arg2 arg3 arg4 arg5) = Aeson.object $ concat $ [["startLine" Aeson..= arg0] + ,"startCharacter" Language.LSP.Protocol.Types.Common..=? arg1 + ,["endLine" Aeson..= arg2] + ,"endCharacter" Language.LSP.Protocol.Types.Common..=? arg3 + ,"kind" Language.LSP.Protocol.Types.Common..=? arg4 + ,"collapsedText" Language.LSP.Protocol.Types.Common..=? arg5] + +instance Aeson.FromJSON FoldingRange where + parseJSON = Aeson.withObject "FoldingRange" $ \arg -> FoldingRange <$> arg Aeson..: "startLine" <*> arg Aeson..:! "startCharacter" <*> arg Aeson..: "endLine" <*> arg Aeson..:! "endCharacter" <*> arg Aeson..:! "kind" <*> arg Aeson..:! "collapsedText" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeClientCapabilities.hs new file mode 100644 index 000000000..b23de9ac4 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeClientCapabilities.hs @@ -0,0 +1,66 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FoldingRangeClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FoldingRangeKind +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data FoldingRangeClientCapabilities = FoldingRangeClientCapabilities + { {-| + Whether implementation supports dynamic registration for folding range + providers. If this is set to `true` the client supports the new + `FoldingRangeRegistrationOptions` return value for the corresponding + server capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + The maximum number of folding ranges that the client prefers to receive + per document. The value serves as a hint, servers are free to follow the + limit. + + -} + _rangeLimit :: (Maybe Language.LSP.Protocol.Types.Common.UInt) + , {-| + If set, the client signals that it only supports folding complete lines. + If set, client will ignore specified `startCharacter` and `endCharacter` + properties in a FoldingRange. + + -} + _lineFoldingOnly :: (Maybe Bool) + , {-| + Specific options for the folding range kind. + + @since 3.17.0 + + -} + _foldingRangeKind :: (Maybe (Row.Rec ("valueSet" Row..== (Maybe [Language.LSP.Protocol.Internal.Types.FoldingRangeKind.FoldingRangeKind]) Row..+ Row.Empty))) + , {-| + Specific options for the folding range. + + @since 3.17.0 + + -} + _foldingRange :: (Maybe (Row.Rec ("collapsedText" Row..== (Maybe Bool) Row..+ Row.Empty))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FoldingRangeClientCapabilities where + toJSON (FoldingRangeClientCapabilities arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"rangeLimit" Language.LSP.Protocol.Types.Common..=? arg1 + ,"lineFoldingOnly" Language.LSP.Protocol.Types.Common..=? arg2 + ,"foldingRangeKind" Language.LSP.Protocol.Types.Common..=? arg3 + ,"foldingRange" Language.LSP.Protocol.Types.Common..=? arg4] + +instance Aeson.FromJSON FoldingRangeClientCapabilities where + parseJSON = Aeson.withObject "FoldingRangeClientCapabilities" $ \arg -> FoldingRangeClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "rangeLimit" <*> arg Aeson..:! "lineFoldingOnly" <*> arg Aeson..:! "foldingRangeKind" <*> arg Aeson..:! "foldingRange" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeKind.hs new file mode 100644 index 000000000..d3a89fb6a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeKind.hs @@ -0,0 +1,57 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FoldingRangeKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +A set of predefined range kinds. + +-} +data FoldingRangeKind = + {-| + Folding range for a comment + + -} + FoldingRangeKind_Comment + | {-| + Folding range for an import or include + + -} + FoldingRangeKind_Imports + | {-| + Folding range for a region (e.g. `#region`) + + -} + FoldingRangeKind_Region + | FoldingRangeKind_Custom Data.Text.Text + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON + , Data.String.IsString ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum FoldingRangeKind Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum FoldingRangeKind where + knownValues = Data.Set.fromList [FoldingRangeKind_Comment + ,FoldingRangeKind_Imports + ,FoldingRangeKind_Region] + type EnumBaseType FoldingRangeKind = Data.Text.Text + toEnumBaseType FoldingRangeKind_Comment = "comment" + toEnumBaseType FoldingRangeKind_Imports = "imports" + toEnumBaseType FoldingRangeKind_Region = "region" + toEnumBaseType (FoldingRangeKind_Custom arg) = arg + +instance Language.LSP.Protocol.Types.LspEnum.LspOpenEnum FoldingRangeKind where + fromOpenEnumBaseType "comment" = FoldingRangeKind_Comment + fromOpenEnumBaseType "imports" = FoldingRangeKind_Imports + fromOpenEnumBaseType "region" = FoldingRangeKind_Region + fromOpenEnumBaseType arg = FoldingRangeKind_Custom arg + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeOptions.hs new file mode 100644 index 000000000..86ad9e67f --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeOptions.hs @@ -0,0 +1,28 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FoldingRangeOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data FoldingRangeOptions = FoldingRangeOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FoldingRangeOptions where + toJSON (FoldingRangeOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON FoldingRangeOptions where + parseJSON = Aeson.withObject "FoldingRangeOptions" $ \arg -> FoldingRangeOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeParams.hs new file mode 100644 index 000000000..46ffe3c76 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeParams.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FoldingRangeParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +Parameters for a `FoldingRangeRequest`. + +-} +data FoldingRangeParams = FoldingRangeParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FoldingRangeParams where + toJSON (FoldingRangeParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["textDocument" Aeson..= arg2]] + +instance Aeson.FromJSON FoldingRangeParams where + parseJSON = Aeson.withObject "FoldingRangeParams" $ \arg -> FoldingRangeParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "textDocument" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeRegistrationOptions.hs new file mode 100644 index 000000000..71694423f --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeRegistrationOptions.hs @@ -0,0 +1,44 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FoldingRangeRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data FoldingRangeRegistrationOptions = FoldingRangeRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FoldingRangeRegistrationOptions where + toJSON (FoldingRangeRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"id" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON FoldingRangeRegistrationOptions where + parseJSON = Aeson.withObject "FoldingRangeRegistrationOptions" $ \arg -> FoldingRangeRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FormattingOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FormattingOptions.hs new file mode 100644 index 000000000..c6ac7d6f7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FormattingOptions.hs @@ -0,0 +1,60 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FormattingOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Value-object describing what options formatting should use. + +-} +data FormattingOptions = FormattingOptions + { {-| + Size of a tab in spaces. + + -} + _tabSize :: Language.LSP.Protocol.Types.Common.UInt + , {-| + Prefer spaces over tabs. + + -} + _insertSpaces :: Bool + , {-| + Trim trailing whitespace on a line. + + @since 3.15.0 + + -} + _trimTrailingWhitespace :: (Maybe Bool) + , {-| + Insert a newline character at the end of the file if one does not exist. + + @since 3.15.0 + + -} + _insertFinalNewline :: (Maybe Bool) + , {-| + Trim all newlines after the final newline at the end of the file. + + @since 3.15.0 + + -} + _trimFinalNewlines :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FormattingOptions where + toJSON (FormattingOptions arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ [["tabSize" Aeson..= arg0] + ,["insertSpaces" Aeson..= arg1] + ,"trimTrailingWhitespace" Language.LSP.Protocol.Types.Common..=? arg2 + ,"insertFinalNewline" Language.LSP.Protocol.Types.Common..=? arg3 + ,"trimFinalNewlines" Language.LSP.Protocol.Types.Common..=? arg4] + +instance Aeson.FromJSON FormattingOptions where + parseJSON = Aeson.withObject "FormattingOptions" $ \arg -> FormattingOptions <$> arg Aeson..: "tabSize" <*> arg Aeson..: "insertSpaces" <*> arg Aeson..:! "trimTrailingWhitespace" <*> arg Aeson..:! "insertFinalNewline" <*> arg Aeson..:! "trimFinalNewlines" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FullDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FullDocumentDiagnosticReport.hs new file mode 100644 index 000000000..8da8c9b56 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FullDocumentDiagnosticReport.hs @@ -0,0 +1,49 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.FullDocumentDiagnosticReport where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Diagnostic +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Singletons + +{-| +A diagnostic report with a full set of problems. + +@since 3.17.0 + +-} +data FullDocumentDiagnosticReport = FullDocumentDiagnosticReport + { {-| + A full document diagnostic report. + + -} + _kind :: (Language.LSP.Protocol.Types.Singletons.AString "full") + , {-| + An optional result id. If provided it will + be sent on the next diagnostic request for the + same document. + + -} + _resultId :: (Maybe Data.Text.Text) + , {-| + The actual items. + + -} + _items :: [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON FullDocumentDiagnosticReport where + toJSON (FullDocumentDiagnosticReport arg0 arg1 arg2) = Aeson.object $ concat $ [["kind" Aeson..= arg0] + ,"resultId" Language.LSP.Protocol.Types.Common..=? arg1 + ,["items" Aeson..= arg2]] + +instance Aeson.FromJSON FullDocumentDiagnosticReport where + parseJSON = Aeson.withObject "FullDocumentDiagnosticReport" $ \arg -> FullDocumentDiagnosticReport <$> arg Aeson..: "kind" <*> arg Aeson..:! "resultId" <*> arg Aeson..: "items" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/GeneralClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/GeneralClientCapabilities.hs new file mode 100644 index 000000000..e39f7aea6 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/GeneralClientCapabilities.hs @@ -0,0 +1,81 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.GeneralClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.MarkdownClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.PositionEncodingKind +import qualified Language.LSP.Protocol.Internal.Types.RegularExpressionsClientCapabilities +import qualified Language.LSP.Protocol.Types.Common + +{-| +General client capabilities. + +@since 3.16.0 + +-} +data GeneralClientCapabilities = GeneralClientCapabilities + { {-| + Client capability that signals how the client + handles stale requests (e.g. a request + for which the client will not process the response + anymore since the information is outdated). + + @since 3.17.0 + + -} + _staleRequestSupport :: (Maybe (Row.Rec ("cancel" Row..== Bool Row..+ ("retryOnContentModified" Row..== [Data.Text.Text] Row..+ Row.Empty)))) + , {-| + Client capabilities specific to regular expressions. + + @since 3.16.0 + + -} + _regularExpressions :: (Maybe Language.LSP.Protocol.Internal.Types.RegularExpressionsClientCapabilities.RegularExpressionsClientCapabilities) + , {-| + Client capabilities specific to the client's markdown parser. + + @since 3.16.0 + + -} + _markdown :: (Maybe Language.LSP.Protocol.Internal.Types.MarkdownClientCapabilities.MarkdownClientCapabilities) + , {-| + The position encodings supported by the client. Client and server + have to agree on the same position encoding to ensure that offsets + (e.g. character position in a line) are interpreted the same on both + sides. + + To keep the protocol backwards compatible the following applies: if + the value 'utf-16' is missing from the array of position encodings + servers can assume that the client supports UTF-16. UTF-16 is + therefore a mandatory encoding. + + If omitted it defaults to ['utf-16']. + + Implementation considerations: since the conversion from one encoding + into another requires the content of the file / line the conversion + is best done where the file is read which is usually on the server + side. + + @since 3.17.0 + + -} + _positionEncodings :: (Maybe [Language.LSP.Protocol.Internal.Types.PositionEncodingKind.PositionEncodingKind]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON GeneralClientCapabilities where + toJSON (GeneralClientCapabilities arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["staleRequestSupport" Language.LSP.Protocol.Types.Common..=? arg0 + ,"regularExpressions" Language.LSP.Protocol.Types.Common..=? arg1 + ,"markdown" Language.LSP.Protocol.Types.Common..=? arg2 + ,"positionEncodings" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON GeneralClientCapabilities where + parseJSON = Aeson.withObject "GeneralClientCapabilities" $ \arg -> GeneralClientCapabilities <$> arg Aeson..:! "staleRequestSupport" <*> arg Aeson..:! "regularExpressions" <*> arg Aeson..:! "markdown" <*> arg Aeson..:! "positionEncodings" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/GlobPattern.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/GlobPattern.hs new file mode 100644 index 000000000..70cecdcd9 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/GlobPattern.hs @@ -0,0 +1,23 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.GlobPattern where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Pattern +import qualified Language.LSP.Protocol.Internal.Types.RelativePattern +import qualified Language.LSP.Protocol.Types.Common + +{-| +The glob pattern. Either a string pattern or a relative pattern. + +@since 3.17.0 + +-} +newtype GlobPattern = GlobPattern (Language.LSP.Protocol.Internal.Types.Pattern.Pattern Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.RelativePattern.RelativePattern) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Hover.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Hover.hs new file mode 100644 index 000000000..389b8a2d1 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Hover.hs @@ -0,0 +1,40 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Hover where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.MarkedString +import qualified Language.LSP.Protocol.Internal.Types.MarkupContent +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +The result of a hover request. + +-} +data Hover = Hover + { {-| + The hover's content + + -} + _contents :: (Language.LSP.Protocol.Internal.Types.MarkupContent.MarkupContent Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.MarkedString.MarkedString Language.LSP.Protocol.Types.Common.|? [Language.LSP.Protocol.Internal.Types.MarkedString.MarkedString])) + , {-| + An optional range inside the text document that is used to + visualize the hover, e.g. by changing the background color. + + -} + _range :: (Maybe Language.LSP.Protocol.Internal.Types.Range.Range) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON Hover where + toJSON (Hover arg0 arg1) = Aeson.object $ concat $ [["contents" Aeson..= arg0] + ,"range" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON Hover where + parseJSON = Aeson.withObject "Hover" $ \arg -> Hover <$> arg Aeson..: "contents" <*> arg Aeson..:! "range" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverClientCapabilities.hs new file mode 100644 index 000000000..717c7aa10 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverClientCapabilities.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.HoverClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.MarkupKind +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data HoverClientCapabilities = HoverClientCapabilities + { {-| + Whether hover supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + Client supports the following content formats for the content + property. The order describes the preferred format of the client. + + -} + _contentFormat :: (Maybe [Language.LSP.Protocol.Internal.Types.MarkupKind.MarkupKind]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON HoverClientCapabilities where + toJSON (HoverClientCapabilities arg0 arg1) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"contentFormat" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON HoverClientCapabilities where + parseJSON = Aeson.withObject "HoverClientCapabilities" $ \arg -> HoverClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "contentFormat" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverOptions.hs new file mode 100644 index 000000000..b857edd15 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverOptions.hs @@ -0,0 +1,29 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.HoverOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Hover options. + +-} +data HoverOptions = HoverOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON HoverOptions where + toJSON (HoverOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON HoverOptions where + parseJSON = Aeson.withObject "HoverOptions" $ \arg -> HoverOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverParams.hs new file mode 100644 index 000000000..a447cf4e2 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverParams.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.HoverParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +Parameters for a `HoverRequest`. + +-} +data HoverParams = HoverParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON HoverParams where + toJSON (HoverParams arg0 arg1 arg2) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON HoverParams where + parseJSON = Aeson.withObject "HoverParams" $ \arg -> HoverParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverRegistrationOptions.hs new file mode 100644 index 000000000..18296a868 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverRegistrationOptions.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.HoverRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `HoverRequest`. + +-} +data HoverRegistrationOptions = HoverRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON HoverRegistrationOptions where + toJSON (HoverRegistrationOptions arg0 arg1) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON HoverRegistrationOptions where + parseJSON = Aeson.withObject "HoverRegistrationOptions" $ \arg -> HoverRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationClientCapabilities.hs new file mode 100644 index 000000000..d81e86424 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationClientCapabilities.hs @@ -0,0 +1,40 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ImplementationClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.6.0 + +-} +data ImplementationClientCapabilities = ImplementationClientCapabilities + { {-| + Whether implementation supports dynamic registration. If this is set to `true` + the client supports the new `ImplementationRegistrationOptions` return value + for the corresponding server capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + The client supports additional metadata in the form of definition links. + + @since 3.14.0 + + -} + _linkSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ImplementationClientCapabilities where + toJSON (ImplementationClientCapabilities arg0 arg1) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"linkSupport" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON ImplementationClientCapabilities where + parseJSON = Aeson.withObject "ImplementationClientCapabilities" $ \arg -> ImplementationClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "linkSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationOptions.hs new file mode 100644 index 000000000..6f12f3048 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationOptions.hs @@ -0,0 +1,28 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ImplementationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data ImplementationOptions = ImplementationOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ImplementationOptions where + toJSON (ImplementationOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON ImplementationOptions where + parseJSON = Aeson.withObject "ImplementationOptions" $ \arg -> ImplementationOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationParams.hs new file mode 100644 index 000000000..86e52b785 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationParams.hs @@ -0,0 +1,51 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ImplementationParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data ImplementationParams = ImplementationParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ImplementationParams where + toJSON (ImplementationParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON ImplementationParams where + parseJSON = Aeson.withObject "ImplementationParams" $ \arg -> ImplementationParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationRegistrationOptions.hs new file mode 100644 index 000000000..3d46c0e0a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationRegistrationOptions.hs @@ -0,0 +1,44 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ImplementationRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data ImplementationRegistrationOptions = ImplementationRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ImplementationRegistrationOptions where + toJSON (ImplementationRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"id" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON ImplementationRegistrationOptions where + parseJSON = Aeson.withObject "ImplementationRegistrationOptions" $ \arg -> ImplementationRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeError.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeError.hs new file mode 100644 index 000000000..b37ac678d --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeError.hs @@ -0,0 +1,34 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InitializeError where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +The data type of the ResponseError if the +initialize request fails. + +-} +data InitializeError = 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 :: Bool + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InitializeError where + toJSON (InitializeError arg0) = Aeson.object $ concat $ [["retry" Aeson..= arg0]] + +instance Aeson.FromJSON InitializeError where + parseJSON = Aeson.withObject "InitializeError" $ \arg -> InitializeError <$> arg Aeson..: "retry" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeParams.hs new file mode 100644 index 000000000..5832d76f8 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeParams.hs @@ -0,0 +1,119 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InitializeParams where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.ClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TraceValues +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFolder +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-# DEPRECATED _rootPath "in favour of rootUri." #-} +{-# DEPRECATED _rootUri "in favour of workspaceFolders." #-} +{-| + +-} +data InitializeParams = InitializeParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + 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. + + -} + _processId :: (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + Information about the client + + @since 3.15.0 + + -} + _clientInfo :: (Maybe (Row.Rec ("name" Row..== Data.Text.Text Row..+ ("version" Row..== (Maybe Data.Text.Text) Row..+ Row.Empty)))) + , {-| + The locale the client is currently showing the user interface + in. This must not necessarily be the locale of the operating + system. + + Uses IETF language tags as the value's syntax + (See https://en.wikipedia.org/wiki/IETF_language_tag) + + @since 3.16.0 + + -} + _locale :: (Maybe Data.Text.Text) + , {-| + The rootPath of the workspace. Is null + if no folder is open. + + @deprecated in favour of rootUri. + + -} + _rootPath :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + , {-| + The rootUri of the workspace. Is null if no + folder is open. If both `rootPath` and `rootUri` are set + `rootUri` wins. + + @deprecated in favour of workspaceFolders. + + -} + _rootUri :: (Language.LSP.Protocol.Types.Uri.Uri Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + The capabilities provided by the client (editor or tool) + + -} + _capabilities :: Language.LSP.Protocol.Internal.Types.ClientCapabilities.ClientCapabilities + , {-| + User provided initialization options. + + -} + _initializationOptions :: (Maybe Data.Aeson.Value) + , {-| + The initial trace setting. If omitted trace is disabled ('off'). + + -} + _trace :: (Maybe Language.LSP.Protocol.Internal.Types.TraceValues.TraceValues) + , {-| + The workspace folders configured in the client when the server starts. + + This property is only available if the client supports workspace folders. + It can be `null` if the client supports workspace folders but none are + configured. + + @since 3.6.0 + + -} + _workspaceFolders :: (Maybe ([Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InitializeParams where + toJSON (InitializeParams arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,["processId" Aeson..= arg1] + ,"clientInfo" Language.LSP.Protocol.Types.Common..=? arg2 + ,"locale" Language.LSP.Protocol.Types.Common..=? arg3 + ,"rootPath" Language.LSP.Protocol.Types.Common..=? arg4 + ,["rootUri" Aeson..= arg5] + ,["capabilities" Aeson..= arg6] + ,"initializationOptions" Language.LSP.Protocol.Types.Common..=? arg7 + ,"trace" Language.LSP.Protocol.Types.Common..=? arg8 + ,"workspaceFolders" Language.LSP.Protocol.Types.Common..=? arg9] + +instance Aeson.FromJSON InitializeParams where + parseJSON = Aeson.withObject "InitializeParams" $ \arg -> InitializeParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..: "processId" <*> arg Aeson..:! "clientInfo" <*> arg Aeson..:! "locale" <*> arg Aeson..:! "rootPath" <*> arg Aeson..: "rootUri" <*> arg Aeson..: "capabilities" <*> arg Aeson..:! "initializationOptions" <*> arg Aeson..:! "trace" <*> arg Aeson..:! "workspaceFolders" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeResult.hs new file mode 100644 index 000000000..29f90eafd --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeResult.hs @@ -0,0 +1,41 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InitializeResult where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.ServerCapabilities +import qualified Language.LSP.Protocol.Types.Common + +{-| +The result returned from an initialize request. + +-} +data InitializeResult = InitializeResult + { {-| + The capabilities the language server provides. + + -} + _capabilities :: Language.LSP.Protocol.Internal.Types.ServerCapabilities.ServerCapabilities + , {-| + Information about the server. + + @since 3.15.0 + + -} + _serverInfo :: (Maybe (Row.Rec ("name" Row..== Data.Text.Text Row..+ ("version" Row..== (Maybe Data.Text.Text) Row..+ Row.Empty)))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InitializeResult where + toJSON (InitializeResult arg0 arg1) = Aeson.object $ concat $ [["capabilities" Aeson..= arg0] + ,"serverInfo" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON InitializeResult where + parseJSON = Aeson.withObject "InitializeResult" $ \arg -> InitializeResult <$> arg Aeson..: "capabilities" <*> arg Aeson..:! "serverInfo" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializedParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializedParams.hs new file mode 100644 index 000000000..7d3f89cae --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializedParams.hs @@ -0,0 +1,25 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InitializedParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data InitializedParams = InitializedParams + { + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InitializedParams where + toJSON (InitializedParams ) = Aeson.object $ concat $ [] + +instance Aeson.FromJSON InitializedParams where + parseJSON = Aeson.withObject "InitializedParams" $ \arg -> pure InitializedParams \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHint.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHint.hs new file mode 100644 index 000000000..f52a8ae05 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHint.hs @@ -0,0 +1,98 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlayHint where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.InlayHintKind +import qualified Language.LSP.Protocol.Internal.Types.InlayHintLabelPart +import qualified Language.LSP.Protocol.Internal.Types.MarkupContent +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.TextEdit +import qualified Language.LSP.Protocol.Types.Common + +{-| +Inlay hint information. + +@since 3.17.0 + +-} +data InlayHint = InlayHint + { {-| + The position of this hint. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + The label of this hint. A human readable string or an array of + InlayHintLabelPart label parts. + + *Note* that neither the string nor the label part can be empty. + + -} + _label :: (Data.Text.Text Language.LSP.Protocol.Types.Common.|? [Language.LSP.Protocol.Internal.Types.InlayHintLabelPart.InlayHintLabelPart]) + , {-| + The kind of this hint. Can be omitted in which case the client + should fall back to a reasonable default. + + -} + _kind :: (Maybe Language.LSP.Protocol.Internal.Types.InlayHintKind.InlayHintKind) + , {-| + Optional text edits that are performed when accepting this inlay hint. + + *Note* that edits are expected to change the document so that the inlay + hint (or its nearest variant) is now part of the document and the inlay + hint itself is now obsolete. + + -} + _textEdits :: (Maybe [Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit]) + , {-| + The tooltip text when you hover over this item. + + -} + _tooltip :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.MarkupContent.MarkupContent)) + , {-| + Render padding before the hint. + + Note: Padding should use the editor's background color, not the + background color of the hint itself. That means padding can be used + to visually align/separate an inlay hint. + + -} + _paddingLeft :: (Maybe Bool) + , {-| + Render padding after the hint. + + Note: Padding should use the editor's background color, not the + background color of the hint itself. That means padding can be used + to visually align/separate an inlay hint. + + -} + _paddingRight :: (Maybe Bool) + , {-| + A data entry field that is preserved on an inlay hint between + a `textDocument/inlayHint` and a `inlayHint/resolve` request. + + -} + _data_ :: (Maybe Data.Aeson.Value) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlayHint where + toJSON (InlayHint arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7) = Aeson.object $ concat $ [["position" Aeson..= arg0] + ,["label" Aeson..= arg1] + ,"kind" Language.LSP.Protocol.Types.Common..=? arg2 + ,"textEdits" Language.LSP.Protocol.Types.Common..=? arg3 + ,"tooltip" Language.LSP.Protocol.Types.Common..=? arg4 + ,"paddingLeft" Language.LSP.Protocol.Types.Common..=? arg5 + ,"paddingRight" Language.LSP.Protocol.Types.Common..=? arg6 + ,"data" Language.LSP.Protocol.Types.Common..=? arg7] + +instance Aeson.FromJSON InlayHint where + parseJSON = Aeson.withObject "InlayHint" $ \arg -> InlayHint <$> arg Aeson..: "position" <*> arg Aeson..: "label" <*> arg Aeson..:! "kind" <*> arg Aeson..:! "textEdits" <*> arg Aeson..:! "tooltip" <*> arg Aeson..:! "paddingLeft" <*> arg Aeson..:! "paddingRight" <*> arg Aeson..:! "data" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintClientCapabilities.hs new file mode 100644 index 000000000..b6997e801 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintClientCapabilities.hs @@ -0,0 +1,41 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlayHintClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Inlay hint client capabilities. + +@since 3.17.0 + +-} +data InlayHintClientCapabilities = InlayHintClientCapabilities + { {-| + Whether inlay hints support dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + Indicates which properties a client can resolve lazily on an inlay + hint. + + -} + _resolveSupport :: (Maybe (Row.Rec ("properties" Row..== [Data.Text.Text] Row..+ Row.Empty))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlayHintClientCapabilities where + toJSON (InlayHintClientCapabilities arg0 arg1) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"resolveSupport" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON InlayHintClientCapabilities where + parseJSON = Aeson.withObject "InlayHintClientCapabilities" $ \arg -> InlayHintClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "resolveSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintKind.hs new file mode 100644 index 000000000..d99714b8c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintKind.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlayHintKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +Inlay hint kinds. + +@since 3.17.0 + +-} +data InlayHintKind = + {-| + An inlay hint that for a type annotation. + + -} + InlayHintKind_Type + | {-| + An inlay hint that is for a parameter. + + -} + InlayHintKind_Parameter + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum InlayHintKind Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum InlayHintKind where + knownValues = Data.Set.fromList [InlayHintKind_Type,InlayHintKind_Parameter] + type EnumBaseType InlayHintKind = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType InlayHintKind_Type = 1 + toEnumBaseType InlayHintKind_Parameter = 2 + fromEnumBaseType 1 = pure InlayHintKind_Type + fromEnumBaseType 2 = pure InlayHintKind_Parameter + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintLabelPart.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintLabelPart.hs new file mode 100644 index 000000000..1cd42c625 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintLabelPart.hs @@ -0,0 +1,70 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlayHintLabelPart where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Command +import qualified Language.LSP.Protocol.Internal.Types.Location +import qualified Language.LSP.Protocol.Internal.Types.MarkupContent +import qualified Language.LSP.Protocol.Types.Common + +{-| +An inlay hint label part allows for interactive and composite labels +of inlay hints. + +@since 3.17.0 + +-} +data InlayHintLabelPart = InlayHintLabelPart + { {-| + The value of this label part. + + -} + _value :: Data.Text.Text + , {-| + The tooltip text when you hover over this label part. Depending on + the client capability `inlayHint.resolveSupport` clients might resolve + this property late using the resolve request. + + -} + _tooltip :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.MarkupContent.MarkupContent)) + , {-| + An optional source code location that represents this + label part. + + The editor will use this location for the hover and for code navigation + features: This part will become a clickable link that resolves to the + definition of the symbol at the given location (not necessarily the + location itself), it shows the hover that shows at the given location, + and it shows a context menu with further code navigation commands. + + Depending on the client capability `inlayHint.resolveSupport` clients + might resolve this property late using the resolve request. + + -} + _location :: (Maybe Language.LSP.Protocol.Internal.Types.Location.Location) + , {-| + An optional command for this label part. + + Depending on the client capability `inlayHint.resolveSupport` clients + might resolve this property late using the resolve request. + + -} + _command :: (Maybe Language.LSP.Protocol.Internal.Types.Command.Command) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlayHintLabelPart where + toJSON (InlayHintLabelPart arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["value" Aeson..= arg0] + ,"tooltip" Language.LSP.Protocol.Types.Common..=? arg1 + ,"location" Language.LSP.Protocol.Types.Common..=? arg2 + ,"command" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON InlayHintLabelPart where + parseJSON = Aeson.withObject "InlayHintLabelPart" $ \arg -> InlayHintLabelPart <$> arg Aeson..: "value" <*> arg Aeson..:! "tooltip" <*> arg Aeson..:! "location" <*> arg Aeson..:! "command" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintOptions.hs new file mode 100644 index 000000000..3cb45c538 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintOptions.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlayHintOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Inlay hint options used during static registration. + +@since 3.17.0 + +-} +data InlayHintOptions = InlayHintOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The server provides support to resolve additional + information for an inlay hint item. + + -} + _resolveProvider :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlayHintOptions where + toJSON (InlayHintOptions arg0 arg1) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"resolveProvider" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON InlayHintOptions where + parseJSON = Aeson.withObject "InlayHintOptions" $ \arg -> InlayHintOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "resolveProvider" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintParams.hs new file mode 100644 index 000000000..9583a15e9 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintParams.hs @@ -0,0 +1,47 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlayHintParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +A parameter literal used in inlay hint requests. + +@since 3.17.0 + +-} +data InlayHintParams = InlayHintParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The document range for which inlay hints should be computed. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlayHintParams where + toJSON (InlayHintParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,["textDocument" Aeson..= arg1] + ,["range" Aeson..= arg2]] + +instance Aeson.FromJSON InlayHintParams where + parseJSON = Aeson.withObject "InlayHintParams" $ \arg -> InlayHintParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..: "textDocument" <*> arg Aeson..: "range" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintRegistrationOptions.hs new file mode 100644 index 000000000..bc89b9f0a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintRegistrationOptions.hs @@ -0,0 +1,54 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlayHintRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Inlay hint options used during static or dynamic registration. + +@since 3.17.0 + +-} +data InlayHintRegistrationOptions = InlayHintRegistrationOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The server provides support to resolve additional + information for an inlay hint item. + + -} + _resolveProvider :: (Maybe Bool) + , {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlayHintRegistrationOptions where + toJSON (InlayHintRegistrationOptions arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"resolveProvider" Language.LSP.Protocol.Types.Common..=? arg1 + ,["documentSelector" Aeson..= arg2] + ,"id" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON InlayHintRegistrationOptions where + parseJSON = Aeson.withObject "InlayHintRegistrationOptions" $ \arg -> InlayHintRegistrationOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "resolveProvider" <*> arg Aeson..: "documentSelector" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintWorkspaceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintWorkspaceClientCapabilities.hs new file mode 100644 index 000000000..10499501a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintWorkspaceClientCapabilities.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlayHintWorkspaceClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client workspace capabilities specific to inlay hints. + +@since 3.17.0 + +-} +data InlayHintWorkspaceClientCapabilities = InlayHintWorkspaceClientCapabilities + { {-| + Whether the client implementation supports a refresh request sent from + the server to the client. + + Note that this event is global and will force the client to refresh all + inlay hints currently shown. It should be used with absolute care and + is useful for situation where a server for example detects a project wide + change that requires such a calculation. + + -} + _refreshSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlayHintWorkspaceClientCapabilities where + toJSON (InlayHintWorkspaceClientCapabilities arg0) = Aeson.object $ concat $ ["refreshSupport" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON InlayHintWorkspaceClientCapabilities where + parseJSON = Aeson.withObject "InlayHintWorkspaceClientCapabilities" $ \arg -> InlayHintWorkspaceClientCapabilities <$> arg Aeson..:! "refreshSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValue.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValue.hs new file mode 100644 index 000000000..53b283e95 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValue.hs @@ -0,0 +1,28 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlineValue where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.InlineValueEvaluatableExpression +import qualified Language.LSP.Protocol.Internal.Types.InlineValueText +import qualified Language.LSP.Protocol.Internal.Types.InlineValueVariableLookup +import qualified Language.LSP.Protocol.Types.Common + +{-| +Inline value information can be provided by different means: +- directly as a text value (class InlineValueText). +- as a name to use for a variable lookup (class InlineValueVariableLookup) +- as an evaluatable expression (class InlineValueEvaluatableExpression) +The InlineValue types combines all inline value types into one type. + +@since 3.17.0 + +-} +newtype InlineValue = InlineValue (Language.LSP.Protocol.Internal.Types.InlineValueText.InlineValueText Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.InlineValueVariableLookup.InlineValueVariableLookup Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.InlineValueEvaluatableExpression.InlineValueEvaluatableExpression)) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueClientCapabilities.hs new file mode 100644 index 000000000..08d39d3fc --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueClientCapabilities.hs @@ -0,0 +1,32 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlineValueClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client capabilities specific to inline values. + +@since 3.17.0 + +-} +data InlineValueClientCapabilities = InlineValueClientCapabilities + { {-| + Whether implementation supports dynamic registration for inline value providers. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlineValueClientCapabilities where + toJSON (InlineValueClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON InlineValueClientCapabilities where + parseJSON = Aeson.withObject "InlineValueClientCapabilities" $ \arg -> InlineValueClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueContext.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueContext.hs new file mode 100644 index 000000000..89351f935 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueContext.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlineValueContext where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.17.0 + +-} +data InlineValueContext = InlineValueContext + { {-| + The stack frame (as a DAP Id) where the execution has stopped. + + -} + _frameId :: Language.LSP.Protocol.Types.Common.Int32 + , {-| + The document range where execution has stopped. + Typically the end position of the range denotes the line where the inline values are shown. + + -} + _stoppedLocation :: Language.LSP.Protocol.Internal.Types.Range.Range + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlineValueContext where + toJSON (InlineValueContext arg0 arg1) = Aeson.object $ concat $ [["frameId" Aeson..= arg0] + ,["stoppedLocation" Aeson..= arg1]] + +instance Aeson.FromJSON InlineValueContext where + parseJSON = Aeson.withObject "InlineValueContext" $ \arg -> InlineValueContext <$> arg Aeson..: "frameId" <*> arg Aeson..: "stoppedLocation" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueEvaluatableExpression.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueEvaluatableExpression.hs new file mode 100644 index 000000000..2ec5f8b47 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueEvaluatableExpression.hs @@ -0,0 +1,43 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlineValueEvaluatableExpression where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +Provide an inline value through an expression evaluation. +If only a range is specified, the expression will be extracted from the underlying document. +An optional expression can be used to override the extracted expression. + +@since 3.17.0 + +-} +data InlineValueEvaluatableExpression = InlineValueEvaluatableExpression + { {-| + The document range for which the inline value applies. + The range is used to extract the evaluatable expression from the underlying document. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + If specified the expression overrides the extracted expression. + + -} + _expression :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlineValueEvaluatableExpression where + toJSON (InlineValueEvaluatableExpression arg0 arg1) = Aeson.object $ concat $ [["range" Aeson..= arg0] + ,"expression" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON InlineValueEvaluatableExpression where + parseJSON = Aeson.withObject "InlineValueEvaluatableExpression" $ \arg -> InlineValueEvaluatableExpression <$> arg Aeson..: "range" <*> arg Aeson..:! "expression" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueOptions.hs new file mode 100644 index 000000000..63dbb320a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueOptions.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlineValueOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Inline value options used during static registration. + +@since 3.17.0 + +-} +data InlineValueOptions = InlineValueOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlineValueOptions where + toJSON (InlineValueOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON InlineValueOptions where + parseJSON = Aeson.withObject "InlineValueOptions" $ \arg -> InlineValueOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueParams.hs new file mode 100644 index 000000000..6a19643f5 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueParams.hs @@ -0,0 +1,55 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlineValueParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.InlineValueContext +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +A parameter literal used in inline value requests. + +@since 3.17.0 + +-} +data InlineValueParams = InlineValueParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The document range for which inline values should be computed. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + Additional information about the context in which inline values were + requested. + + -} + _context :: Language.LSP.Protocol.Internal.Types.InlineValueContext.InlineValueContext + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlineValueParams where + toJSON (InlineValueParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,["textDocument" Aeson..= arg1] + ,["range" Aeson..= arg2] + ,["context" Aeson..= arg3]] + +instance Aeson.FromJSON InlineValueParams where + parseJSON = Aeson.withObject "InlineValueParams" $ \arg -> InlineValueParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..: "textDocument" <*> arg Aeson..: "range" <*> arg Aeson..: "context" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueRegistrationOptions.hs new file mode 100644 index 000000000..7f9556cca --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueRegistrationOptions.hs @@ -0,0 +1,47 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlineValueRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Inline value options used during static or dynamic registration. + +@since 3.17.0 + +-} +data InlineValueRegistrationOptions = InlineValueRegistrationOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlineValueRegistrationOptions where + toJSON (InlineValueRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,["documentSelector" Aeson..= arg1] + ,"id" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON InlineValueRegistrationOptions where + parseJSON = Aeson.withObject "InlineValueRegistrationOptions" $ \arg -> InlineValueRegistrationOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..: "documentSelector" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueText.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueText.hs new file mode 100644 index 000000000..818511a21 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueText.hs @@ -0,0 +1,40 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlineValueText where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +Provide inline value as text. + +@since 3.17.0 + +-} +data InlineValueText = InlineValueText + { {-| + The document range for which the inline value applies. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The text of the inline value. + + -} + _text :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlineValueText where + toJSON (InlineValueText arg0 arg1) = Aeson.object $ concat $ [["range" Aeson..= arg0] + ,["text" Aeson..= arg1]] + +instance Aeson.FromJSON InlineValueText where + parseJSON = Aeson.withObject "InlineValueText" $ \arg -> InlineValueText <$> arg Aeson..: "range" <*> arg Aeson..: "text" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueVariableLookup.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueVariableLookup.hs new file mode 100644 index 000000000..6f1da1945 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueVariableLookup.hs @@ -0,0 +1,49 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlineValueVariableLookup where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +Provide inline value through a variable lookup. +If only a range is specified, the variable name will be extracted from the underlying document. +An optional variable name can be used to override the extracted name. + +@since 3.17.0 + +-} +data InlineValueVariableLookup = InlineValueVariableLookup + { {-| + The document range for which the inline value applies. + The range is used to extract the variable name from the underlying document. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + If specified the name of the variable to look up. + + -} + _variableName :: (Maybe Data.Text.Text) + , {-| + How to perform the lookup. + + -} + _caseSensitiveLookup :: Bool + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlineValueVariableLookup where + toJSON (InlineValueVariableLookup arg0 arg1 arg2) = Aeson.object $ concat $ [["range" Aeson..= arg0] + ,"variableName" Language.LSP.Protocol.Types.Common..=? arg1 + ,["caseSensitiveLookup" Aeson..= arg2]] + +instance Aeson.FromJSON InlineValueVariableLookup where + parseJSON = Aeson.withObject "InlineValueVariableLookup" $ \arg -> InlineValueVariableLookup <$> arg Aeson..: "range" <*> arg Aeson..:! "variableName" <*> arg Aeson..: "caseSensitiveLookup" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueWorkspaceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueWorkspaceClientCapabilities.hs new file mode 100644 index 000000000..78b819aee --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueWorkspaceClientCapabilities.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InlineValueWorkspaceClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client workspace capabilities specific to inline values. + +@since 3.17.0 + +-} +data InlineValueWorkspaceClientCapabilities = InlineValueWorkspaceClientCapabilities + { {-| + Whether the client implementation supports a refresh request sent from the + server to the client. + + Note that this event is global and will force the client to refresh all + inline values currently shown. It should be used with absolute care and is + useful for situation where a server for example detects a project wide + change that requires such a calculation. + + -} + _refreshSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InlineValueWorkspaceClientCapabilities where + toJSON (InlineValueWorkspaceClientCapabilities arg0) = Aeson.object $ concat $ ["refreshSupport" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON InlineValueWorkspaceClientCapabilities where + parseJSON = Aeson.withObject "InlineValueWorkspaceClientCapabilities" $ \arg -> InlineValueWorkspaceClientCapabilities <$> arg Aeson..:! "refreshSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertReplaceEdit.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertReplaceEdit.hs new file mode 100644 index 000000000..df4e72302 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertReplaceEdit.hs @@ -0,0 +1,46 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InsertReplaceEdit where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +A special text edit to provide an insert and a replace operation. + +@since 3.16.0 + +-} +data InsertReplaceEdit = InsertReplaceEdit + { {-| + The string to be inserted. + + -} + _newText :: Data.Text.Text + , {-| + The range if the insert is requested + + -} + _insert :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The range if the replace is requested. + + -} + _replace :: Language.LSP.Protocol.Internal.Types.Range.Range + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON InsertReplaceEdit where + toJSON (InsertReplaceEdit arg0 arg1 arg2) = Aeson.object $ concat $ [["newText" Aeson..= arg0] + ,["insert" Aeson..= arg1] + ,["replace" Aeson..= arg2]] + +instance Aeson.FromJSON InsertReplaceEdit where + parseJSON = Aeson.withObject "InsertReplaceEdit" $ \arg -> InsertReplaceEdit <$> arg Aeson..: "newText" <*> arg Aeson..: "insert" <*> arg Aeson..: "replace" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertTextFormat.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertTextFormat.hs new file mode 100644 index 000000000..f7ed397fe --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertTextFormat.hs @@ -0,0 +1,52 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InsertTextFormat where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +Defines whether the insert text in a completion item should be interpreted as +plain text or a snippet. + +-} +data InsertTextFormat = + {-| + The primary text to be inserted is treated as a plain string. + + -} + InsertTextFormat_PlainText + | {-| + 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://microsoft.github.io/language-server-protocol/specifications/specification-current/#snippet_syntax + + -} + InsertTextFormat_Snippet + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum InsertTextFormat Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum InsertTextFormat where + knownValues = Data.Set.fromList [InsertTextFormat_PlainText + ,InsertTextFormat_Snippet] + type EnumBaseType InsertTextFormat = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType InsertTextFormat_PlainText = 1 + toEnumBaseType InsertTextFormat_Snippet = 2 + fromEnumBaseType 1 = pure InsertTextFormat_PlainText + fromEnumBaseType 2 = pure InsertTextFormat_Snippet + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertTextMode.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertTextMode.hs new file mode 100644 index 000000000..91f2ed098 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertTextMode.hs @@ -0,0 +1,57 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.InsertTextMode where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +How whitespace and indentation is handled during completion +item insertion. + +@since 3.16.0 + +-} +data InsertTextMode = + {-| + The insertion or replace strings is taken as it is. If the + value is multi line the lines below the cursor will be + inserted using the indentation defined in the string value. + The client will not apply any kind of adjustments to the + string. + + -} + InsertTextMode_AsIs + | {-| + The editor adjusts leading whitespace of new lines so that + they match the indentation up to the cursor of the line for + which the item is accepted. + + Consider a line like this: <2tabs><3tabs>foo. Accepting a + multi line completion item is indented using 2 tabs and all + following lines inserted will be indented using 2 tabs as well. + + -} + InsertTextMode_AdjustIndentation + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum InsertTextMode Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum InsertTextMode where + knownValues = Data.Set.fromList [InsertTextMode_AsIs + ,InsertTextMode_AdjustIndentation] + type EnumBaseType InsertTextMode = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType InsertTextMode_AsIs = 1 + toEnumBaseType InsertTextMode_AdjustIndentation = 2 + fromEnumBaseType 1 = pure InsertTextMode_AsIs + fromEnumBaseType 2 = pure InsertTextMode_AdjustIndentation + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LSPAny.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LSPAny.hs new file mode 100644 index 000000000..375b60eec --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LSPAny.hs @@ -0,0 +1,26 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.LSPAny where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +The LSP any type. +Please note that strictly speaking a property with the value `undefined` +can't be converted into JSON preserving the property name. However for +convenience it is allowed and assumed that all these properties are +optional as well. +@since 3.17.0 + +-} +newtype LSPAny = LSPAny (Data.Aeson.Object Language.LSP.Protocol.Types.Common.|? (Data.Aeson.Array Language.LSP.Protocol.Types.Common.|? (Data.Text.Text Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Types.Common.UInt Language.LSP.Protocol.Types.Common.|? (Float Language.LSP.Protocol.Types.Common.|? (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null))))))) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LSPArray.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LSPArray.hs new file mode 100644 index 000000000..493c5a7c7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LSPArray.hs @@ -0,0 +1,20 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.LSPArray where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson + +{-| +LSP arrays. +@since 3.17.0 + +-} +newtype LSPArray = LSPArray [Data.Aeson.Value] + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LSPErrorCodes.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LSPErrorCodes.hs new file mode 100644 index 000000000..48648c198 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LSPErrorCodes.hs @@ -0,0 +1,80 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.LSPErrorCodes where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| + +-} +data LSPErrorCodes = + {-| + A request failed but it was syntactically correct, e.g the + method name was known and the parameters were valid. The error + message should contain human readable information about why + the request failed. + + @since 3.17.0 + + -} + LSPErrorCodes_RequestFailed + | {-| + The server cancelled the request. This error code should + only be used for requests that explicitly support being + server cancellable. + + @since 3.17.0 + + -} + LSPErrorCodes_ServerCancelled + | {-| + The server detected that the content of a document got + modified outside normal conditions. A server should + NOT send this error code if it detects a content change + in it unprocessed messages. The result even computed + on an older state might still be useful for the client. + + If a client decides that a result is not of any use anymore + the client should cancel the request. + + -} + LSPErrorCodes_ContentModified + | {-| + The client has canceled a request and a server as detected + the cancel. + + -} + LSPErrorCodes_RequestCancelled + | LSPErrorCodes_Custom Language.LSP.Protocol.Types.Common.Int32 + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum LSPErrorCodes Language.LSP.Protocol.Types.Common.Int32) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum LSPErrorCodes where + knownValues = Data.Set.fromList [LSPErrorCodes_RequestFailed + ,LSPErrorCodes_ServerCancelled + ,LSPErrorCodes_ContentModified + ,LSPErrorCodes_RequestCancelled] + type EnumBaseType LSPErrorCodes = Language.LSP.Protocol.Types.Common.Int32 + toEnumBaseType LSPErrorCodes_RequestFailed = -32803 + toEnumBaseType LSPErrorCodes_ServerCancelled = -32802 + toEnumBaseType LSPErrorCodes_ContentModified = -32801 + toEnumBaseType LSPErrorCodes_RequestCancelled = -32800 + toEnumBaseType (LSPErrorCodes_Custom arg) = arg + +instance Language.LSP.Protocol.Types.LspEnum.LspOpenEnum LSPErrorCodes where + fromOpenEnumBaseType -32803 = LSPErrorCodes_RequestFailed + fromOpenEnumBaseType -32802 = LSPErrorCodes_ServerCancelled + fromOpenEnumBaseType -32801 = LSPErrorCodes_ContentModified + fromOpenEnumBaseType -32800 = LSPErrorCodes_RequestCancelled + fromOpenEnumBaseType arg = LSPErrorCodes_Custom arg + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LSPObject.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LSPObject.hs new file mode 100644 index 000000000..00703fd10 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LSPObject.hs @@ -0,0 +1,22 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.LSPObject where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Map +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text + +{-| +LSP object definition. +@since 3.17.0 + +-} +newtype LSPObject = LSPObject (Data.Map.Map Data.Text.Text Data.Aeson.Value) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeClientCapabilities.hs new file mode 100644 index 000000000..41588349d --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeClientCapabilities.hs @@ -0,0 +1,34 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.LinkedEditingRangeClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client capabilities for the linked editing range request. + +@since 3.16.0 + +-} +data LinkedEditingRangeClientCapabilities = LinkedEditingRangeClientCapabilities + { {-| + Whether implementation supports dynamic registration. If this is set to `true` + the client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)` + return value for the corresponding server capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON LinkedEditingRangeClientCapabilities where + toJSON (LinkedEditingRangeClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON LinkedEditingRangeClientCapabilities where + parseJSON = Aeson.withObject "LinkedEditingRangeClientCapabilities" $ \arg -> LinkedEditingRangeClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeOptions.hs new file mode 100644 index 000000000..551ffebb1 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeOptions.hs @@ -0,0 +1,28 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.LinkedEditingRangeOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data LinkedEditingRangeOptions = LinkedEditingRangeOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON LinkedEditingRangeOptions where + toJSON (LinkedEditingRangeOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON LinkedEditingRangeOptions where + parseJSON = Aeson.withObject "LinkedEditingRangeOptions" $ \arg -> LinkedEditingRangeOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeParams.hs new file mode 100644 index 000000000..d6b797695 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeParams.hs @@ -0,0 +1,44 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.LinkedEditingRangeParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data LinkedEditingRangeParams = LinkedEditingRangeParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON LinkedEditingRangeParams where + toJSON (LinkedEditingRangeParams arg0 arg1 arg2) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON LinkedEditingRangeParams where + parseJSON = Aeson.withObject "LinkedEditingRangeParams" $ \arg -> LinkedEditingRangeParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeRegistrationOptions.hs new file mode 100644 index 000000000..ea6ffd5d6 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeRegistrationOptions.hs @@ -0,0 +1,44 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.LinkedEditingRangeRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data LinkedEditingRangeRegistrationOptions = LinkedEditingRangeRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON LinkedEditingRangeRegistrationOptions where + toJSON (LinkedEditingRangeRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"id" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON LinkedEditingRangeRegistrationOptions where + parseJSON = Aeson.withObject "LinkedEditingRangeRegistrationOptions" $ \arg -> LinkedEditingRangeRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRanges.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRanges.hs new file mode 100644 index 000000000..f49a98b6d --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRanges.hs @@ -0,0 +1,43 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.LinkedEditingRanges where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +The result of a linked editing range request. + +@since 3.16.0 + +-} +data LinkedEditingRanges = LinkedEditingRanges + { {-| + A list of ranges that can be edited together. The ranges must have + identical length and contain identical text content. The ranges cannot overlap. + + -} + _ranges :: [Language.LSP.Protocol.Internal.Types.Range.Range] + , {-| + An optional word pattern (regular expression) that describes valid contents for + the given ranges. If no pattern is provided, the client configuration's word + pattern will be used. + + -} + _wordPattern :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON LinkedEditingRanges where + toJSON (LinkedEditingRanges arg0 arg1) = Aeson.object $ concat $ [["ranges" Aeson..= arg0] + ,"wordPattern" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON LinkedEditingRanges where + parseJSON = Aeson.withObject "LinkedEditingRanges" $ \arg -> LinkedEditingRanges <$> arg Aeson..: "ranges" <*> arg Aeson..:! "wordPattern" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Location.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Location.hs new file mode 100644 index 000000000..2f132e9e7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Location.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Location where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +Represents a location inside a resource, such as a line +inside a text file. + +-} +data Location = Location + { {-| + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON Location where + toJSON (Location arg0 arg1) = Aeson.object $ concat $ [["uri" Aeson..= arg0] + ,["range" Aeson..= arg1]] + +instance Aeson.FromJSON Location where + parseJSON = Aeson.withObject "Location" $ \arg -> Location <$> arg Aeson..: "uri" <*> arg Aeson..: "range" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LocationLink.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LocationLink.hs new file mode 100644 index 000000000..784aa9bd8 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LocationLink.hs @@ -0,0 +1,57 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.LocationLink where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +Represents the connection of two locations. Provides additional metadata over normal `Location`, +including an origin range. + +-} +data LocationLink = LocationLink + { {-| + Span of the origin of this link. + + Used as the underlined span for mouse interaction. Defaults to the word range at + the definition position. + + -} + _originSelectionRange :: (Maybe Language.LSP.Protocol.Internal.Types.Range.Range) + , {-| + The target resource identifier of this link. + + -} + _targetUri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The full target range of this link. If the target for example is a symbol then target range is the + range enclosing this symbol not including leading/trailing whitespace but everything else + like comments. This information is typically used to highlight the range in the editor. + + -} + _targetRange :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The range that should be selected and revealed when this link is being followed, e.g the name of a function. + Must be contained by the `targetRange`. See also `DocumentSymbol#range` + + -} + _targetSelectionRange :: Language.LSP.Protocol.Internal.Types.Range.Range + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON LocationLink where + toJSON (LocationLink arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["originSelectionRange" Language.LSP.Protocol.Types.Common..=? arg0 + ,["targetUri" Aeson..= arg1] + ,["targetRange" Aeson..= arg2] + ,["targetSelectionRange" Aeson..= arg3]] + +instance Aeson.FromJSON LocationLink where + parseJSON = Aeson.withObject "LocationLink" $ \arg -> LocationLink <$> arg Aeson..:! "originSelectionRange" <*> arg Aeson..: "targetUri" <*> arg Aeson..: "targetRange" <*> arg Aeson..: "targetSelectionRange" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogMessageParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogMessageParams.hs new file mode 100644 index 000000000..0095e0259 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogMessageParams.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.LogMessageParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.MessageType +import qualified Language.LSP.Protocol.Types.Common + +{-| +The log message parameters. + +-} +data LogMessageParams = LogMessageParams + { {-| + The message type. See `MessageType` + + -} + _type_ :: Language.LSP.Protocol.Internal.Types.MessageType.MessageType + , {-| + The actual message. + + -} + _message :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON LogMessageParams where + toJSON (LogMessageParams arg0 arg1) = Aeson.object $ concat $ [["type" Aeson..= arg0] + ,["message" Aeson..= arg1]] + +instance Aeson.FromJSON LogMessageParams where + parseJSON = Aeson.withObject "LogMessageParams" $ \arg -> LogMessageParams <$> arg Aeson..: "type" <*> arg Aeson..: "message" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogTraceParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogTraceParams.hs new file mode 100644 index 000000000..b2ea00ec4 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogTraceParams.hs @@ -0,0 +1,34 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.LogTraceParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data LogTraceParams = LogTraceParams + { {-| + + -} + _message :: Data.Text.Text + , {-| + + -} + _verbose :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON LogTraceParams where + toJSON (LogTraceParams arg0 arg1) = Aeson.object $ concat $ [["message" Aeson..= arg0] + ,"verbose" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON LogTraceParams where + parseJSON = Aeson.withObject "LogTraceParams" $ \arg -> LogTraceParams <$> arg Aeson..: "message" <*> arg Aeson..:! "verbose" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkdownClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkdownClientCapabilities.hs new file mode 100644 index 000000000..ccbf8685a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkdownClientCapabilities.hs @@ -0,0 +1,48 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.MarkdownClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client capabilities specific to the used markdown parser. + +@since 3.16.0 + +-} +data MarkdownClientCapabilities = MarkdownClientCapabilities + { {-| + The name of the parser. + + -} + _parser :: Data.Text.Text + , {-| + The version of the parser. + + -} + _version :: (Maybe Data.Text.Text) + , {-| + A list of HTML tags that the client allows / supports in + Markdown. + + @since 3.17.0 + + -} + _allowedTags :: (Maybe [Data.Text.Text]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON MarkdownClientCapabilities where + toJSON (MarkdownClientCapabilities arg0 arg1 arg2) = Aeson.object $ concat $ [["parser" Aeson..= arg0] + ,"version" Language.LSP.Protocol.Types.Common..=? arg1 + ,"allowedTags" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON MarkdownClientCapabilities where + parseJSON = Aeson.withObject "MarkdownClientCapabilities" $ \arg -> MarkdownClientCapabilities <$> arg Aeson..: "parser" <*> arg Aeson..:! "version" <*> arg Aeson..:! "allowedTags" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkedString.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkedString.hs new file mode 100644 index 000000000..1efe336be --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkedString.hs @@ -0,0 +1,33 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.MarkedString where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-# DEPRECATED MarkedString "use MarkupContent instead." #-} +{-| +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 semantically 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. +@deprecated use MarkupContent instead. + +-} +newtype MarkedString = MarkedString (Data.Text.Text Language.LSP.Protocol.Types.Common.|? (Row.Rec ("language" Row..== Data.Text.Text Row..+ ("value" Row..== Data.Text.Text Row..+ Row.Empty)))) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkupContent.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkupContent.hs new file mode 100644 index 000000000..7a6af64b5 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkupContent.hs @@ -0,0 +1,59 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.MarkupContent where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.MarkupKind +import qualified Language.LSP.Protocol.Types.Common + +{-| +A `MarkupContent` literal represents a string value which content is interpreted base on its +kind flag. Currently the protocol supports `plaintext` and `markdown` as markup kinds. + +If the kind is `markdown` then the value can contain fenced code blocks like in GitHub issues. +See https://help.github.com/articles/creating-and-highlighting-code-blocks/#syntax-highlighting + +Here is an example how such a string can be constructed using JavaScript / TypeScript: +```ts +let markdown: MarkdownContent = { + kind: MarkupKind.Markdown, + value: [ + '# Header', + 'Some text', + '```typescript', + 'someCode();', + '```' + ].join('\n') +}; +``` + +*Please Note* that clients might sanitize the return markdown. A client could decide to +remove HTML from the markdown to avoid script execution. + +-} +data MarkupContent = MarkupContent + { {-| + The type of the Markup + + -} + _kind :: Language.LSP.Protocol.Internal.Types.MarkupKind.MarkupKind + , {-| + The content itself + + -} + _value :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON MarkupContent where + toJSON (MarkupContent arg0 arg1) = Aeson.object $ concat $ [["kind" Aeson..= arg0] + ,["value" Aeson..= arg1]] + +instance Aeson.FromJSON MarkupContent where + parseJSON = Aeson.withObject "MarkupContent" $ \arg -> MarkupContent <$> arg Aeson..: "kind" <*> arg Aeson..: "value" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkupKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkupKind.hs new file mode 100644 index 000000000..c3accf029 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkupKind.hs @@ -0,0 +1,47 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.MarkupKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +Describes the content type that a client supports in various +result literals like `Hover`, `ParameterInfo` or `CompletionItem`. + +Please note that `MarkupKinds` must not start with a `$`. This kinds +are reserved for internal usage. + +-} +data MarkupKind = + {-| + Plain text is supported as a content format + + -} + MarkupKind_PlainText + | {-| + Markdown is supported as a content format + + -} + MarkupKind_Markdown + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum MarkupKind Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum MarkupKind where + knownValues = Data.Set.fromList [MarkupKind_PlainText,MarkupKind_Markdown] + type EnumBaseType MarkupKind = Data.Text.Text + toEnumBaseType MarkupKind_PlainText = "plaintext" + toEnumBaseType MarkupKind_Markdown = "markdown" + fromEnumBaseType "plaintext" = pure MarkupKind_PlainText + fromEnumBaseType "markdown" = pure MarkupKind_Markdown + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MessageActionItem.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MessageActionItem.hs new file mode 100644 index 000000000..225a16390 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MessageActionItem.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.MessageActionItem where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data MessageActionItem = MessageActionItem + { {-| + A short title like 'Retry', 'Open Log' etc. + + -} + _title :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON MessageActionItem where + toJSON (MessageActionItem arg0) = Aeson.object $ concat $ [["title" Aeson..= arg0]] + +instance Aeson.FromJSON MessageActionItem where + parseJSON = Aeson.withObject "MessageActionItem" $ \arg -> MessageActionItem <$> arg Aeson..: "title" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MessageType.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MessageType.hs new file mode 100644 index 000000000..cd566c9a7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MessageType.hs @@ -0,0 +1,60 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.MessageType where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +The message type + +-} +data MessageType = + {-| + An error message. + + -} + MessageType_Error + | {-| + A warning message. + + -} + MessageType_Warning + | {-| + An information message. + + -} + MessageType_Info + | {-| + A log message. + + -} + MessageType_Log + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum MessageType Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum MessageType where + knownValues = Data.Set.fromList [MessageType_Error + ,MessageType_Warning + ,MessageType_Info + ,MessageType_Log] + type EnumBaseType MessageType = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType MessageType_Error = 1 + toEnumBaseType MessageType_Warning = 2 + toEnumBaseType MessageType_Info = 3 + toEnumBaseType MessageType_Log = 4 + fromEnumBaseType 1 = pure MessageType_Error + fromEnumBaseType 2 = pure MessageType_Warning + fromEnumBaseType 3 = pure MessageType_Info + fromEnumBaseType 4 = pure MessageType_Log + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Moniker.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Moniker.hs new file mode 100644 index 000000000..a67336326 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Moniker.hs @@ -0,0 +1,54 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Moniker where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.MonikerKind +import qualified Language.LSP.Protocol.Internal.Types.UniquenessLevel +import qualified Language.LSP.Protocol.Types.Common + +{-| +Moniker definition to match LSIF 0.5 moniker definition. + +@since 3.16.0 + +-} +data Moniker = Moniker + { {-| + The scheme of the moniker. For example tsc or .Net + + -} + _scheme :: Data.Text.Text + , {-| + The identifier of the moniker. The value is opaque in LSIF however + schema owners are allowed to define the structure if they want. + + -} + _identifier :: Data.Text.Text + , {-| + The scope in which the moniker is unique + + -} + _unique :: Language.LSP.Protocol.Internal.Types.UniquenessLevel.UniquenessLevel + , {-| + The moniker kind if known. + + -} + _kind :: (Maybe Language.LSP.Protocol.Internal.Types.MonikerKind.MonikerKind) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON Moniker where + toJSON (Moniker arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["scheme" Aeson..= arg0] + ,["identifier" Aeson..= arg1] + ,["unique" Aeson..= arg2] + ,"kind" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON Moniker where + parseJSON = Aeson.withObject "Moniker" $ \arg -> Moniker <$> arg Aeson..: "scheme" <*> arg Aeson..: "identifier" <*> arg Aeson..: "unique" <*> arg Aeson..:! "kind" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerClientCapabilities.hs new file mode 100644 index 000000000..56c5074d0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerClientCapabilities.hs @@ -0,0 +1,34 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.MonikerClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client capabilities specific to the moniker request. + +@since 3.16.0 + +-} +data MonikerClientCapabilities = MonikerClientCapabilities + { {-| + Whether moniker supports dynamic registration. If this is set to `true` + the client supports the new `MonikerRegistrationOptions` return value + for the corresponding server capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON MonikerClientCapabilities where + toJSON (MonikerClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON MonikerClientCapabilities where + parseJSON = Aeson.withObject "MonikerClientCapabilities" $ \arg -> MonikerClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerKind.hs new file mode 100644 index 000000000..a16bc5e69 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerKind.hs @@ -0,0 +1,55 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.MonikerKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +The moniker kind. + +@since 3.16.0 + +-} +data MonikerKind = + {-| + The moniker represent a symbol that is imported into a project + + -} + MonikerKind_Import + | {-| + The moniker represents a symbol that is exported from a project + + -} + MonikerKind_Export + | {-| + The moniker represents a symbol that is local to a project (e.g. a local + variable of a function, a class not visible outside the project, ...) + + -} + MonikerKind_Local + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum MonikerKind Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum MonikerKind where + knownValues = Data.Set.fromList [MonikerKind_Import + ,MonikerKind_Export + ,MonikerKind_Local] + type EnumBaseType MonikerKind = Data.Text.Text + toEnumBaseType MonikerKind_Import = "import" + toEnumBaseType MonikerKind_Export = "export" + toEnumBaseType MonikerKind_Local = "local" + fromEnumBaseType "import" = pure MonikerKind_Import + fromEnumBaseType "export" = pure MonikerKind_Export + fromEnumBaseType "local" = pure MonikerKind_Local + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerOptions.hs new file mode 100644 index 000000000..e3e122566 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerOptions.hs @@ -0,0 +1,28 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.MonikerOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data MonikerOptions = MonikerOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON MonikerOptions where + toJSON (MonikerOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON MonikerOptions where + parseJSON = Aeson.withObject "MonikerOptions" $ \arg -> MonikerOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerParams.hs new file mode 100644 index 000000000..9eda4252e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerParams.hs @@ -0,0 +1,51 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.MonikerParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data MonikerParams = MonikerParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON MonikerParams where + toJSON (MonikerParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON MonikerParams where + parseJSON = Aeson.withObject "MonikerParams" $ \arg -> MonikerParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerRegistrationOptions.hs new file mode 100644 index 000000000..8a2dfe92e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerRegistrationOptions.hs @@ -0,0 +1,36 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.MonikerRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data MonikerRegistrationOptions = MonikerRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON MonikerRegistrationOptions where + toJSON (MonikerRegistrationOptions arg0 arg1) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON MonikerRegistrationOptions where + parseJSON = Aeson.withObject "MonikerRegistrationOptions" $ \arg -> MonikerRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCell.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCell.hs new file mode 100644 index 000000000..876c66799 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCell.hs @@ -0,0 +1,62 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.NotebookCell where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ExecutionSummary +import qualified Language.LSP.Protocol.Internal.Types.NotebookCellKind +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A notebook cell. + +A cell's document URI must be unique across ALL notebook +cells and can therefore be used to uniquely identify a +notebook cell or the cell's text document. + +@since 3.17.0 + +-} +data NotebookCell = NotebookCell + { {-| + The cell's kind + + -} + _kind :: Language.LSP.Protocol.Internal.Types.NotebookCellKind.NotebookCellKind + , {-| + The URI of the cell's text document + content. + + -} + _document :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + Additional metadata stored with the cell. + + Note: should always be an object literal (e.g. LSPObject) + + -} + _metadata :: (Maybe Data.Aeson.Object) + , {-| + Additional execution summary information + if supported by the client. + + -} + _executionSummary :: (Maybe Language.LSP.Protocol.Internal.Types.ExecutionSummary.ExecutionSummary) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON NotebookCell where + toJSON (NotebookCell arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["kind" Aeson..= arg0] + ,["document" Aeson..= arg1] + ,"metadata" Language.LSP.Protocol.Types.Common..=? arg2 + ,"executionSummary" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON NotebookCell where + parseJSON = Aeson.withObject "NotebookCell" $ \arg -> NotebookCell <$> arg Aeson..: "kind" <*> arg Aeson..: "document" <*> arg Aeson..:! "metadata" <*> arg Aeson..:! "executionSummary" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellArrayChange.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellArrayChange.hs new file mode 100644 index 000000000..b8c6feb62 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellArrayChange.hs @@ -0,0 +1,46 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.NotebookCellArrayChange where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.NotebookCell +import qualified Language.LSP.Protocol.Types.Common + +{-| +A change describing how to move a `NotebookCell` +array from state S to S'. + +@since 3.17.0 + +-} +data NotebookCellArrayChange = NotebookCellArrayChange + { {-| + The start oftest of the cell that changed. + + -} + _start :: Language.LSP.Protocol.Types.Common.UInt + , {-| + The deleted cells + + -} + _deleteCount :: Language.LSP.Protocol.Types.Common.UInt + , {-| + The new cells, if any + + -} + _cells :: (Maybe [Language.LSP.Protocol.Internal.Types.NotebookCell.NotebookCell]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON NotebookCellArrayChange where + toJSON (NotebookCellArrayChange arg0 arg1 arg2) = Aeson.object $ concat $ [["start" Aeson..= arg0] + ,["deleteCount" Aeson..= arg1] + ,"cells" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON NotebookCellArrayChange where + parseJSON = Aeson.withObject "NotebookCellArrayChange" $ \arg -> NotebookCellArrayChange <$> arg Aeson..: "start" <*> arg Aeson..: "deleteCount" <*> arg Aeson..:! "cells" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellKind.hs new file mode 100644 index 000000000..31980863f --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellKind.hs @@ -0,0 +1,46 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.NotebookCellKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +A notebook cell kind. + +@since 3.17.0 + +-} +data NotebookCellKind = + {-| + A markup-cell is formatted source that is used for display. + + -} + NotebookCellKind_Markup + | {-| + A code-cell is source code. + + -} + NotebookCellKind_Code + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum NotebookCellKind Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum NotebookCellKind where + knownValues = Data.Set.fromList [NotebookCellKind_Markup + ,NotebookCellKind_Code] + type EnumBaseType NotebookCellKind = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType NotebookCellKind_Markup = 1 + toEnumBaseType NotebookCellKind_Code = 2 + fromEnumBaseType 1 = pure NotebookCellKind_Markup + fromEnumBaseType 2 = pure NotebookCellKind_Code + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellTextDocumentFilter.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellTextDocumentFilter.hs new file mode 100644 index 000000000..a72af971f --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellTextDocumentFilter.hs @@ -0,0 +1,47 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.NotebookCellTextDocumentFilter where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter +import qualified Language.LSP.Protocol.Types.Common + +{-| +A notebook cell text document filter denotes a cell text +document by different properties. + +@since 3.17.0 + +-} +data NotebookCellTextDocumentFilter = NotebookCellTextDocumentFilter + { {-| + A filter that matches against the notebook + containing the notebook cell. If a string + value is provided it matches against the + notebook type. '*' matches every notebook. + + -} + _notebook :: (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter.NotebookDocumentFilter) + , {-| + A language id like `python`. + + Will be matched against the language id of the + notebook cell document. '*' matches every language. + + -} + _language :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON NotebookCellTextDocumentFilter where + toJSON (NotebookCellTextDocumentFilter arg0 arg1) = Aeson.object $ concat $ [["notebook" Aeson..= arg0] + ,"language" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON NotebookCellTextDocumentFilter where + parseJSON = Aeson.withObject "NotebookCellTextDocumentFilter" $ \arg -> NotebookCellTextDocumentFilter <$> arg Aeson..: "notebook" <*> arg Aeson..:! "language" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocument.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocument.hs new file mode 100644 index 000000000..14ce81de0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocument.hs @@ -0,0 +1,64 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.NotebookDocument where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.NotebookCell +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A notebook document. + +@since 3.17.0 + +-} +data NotebookDocument = NotebookDocument + { {-| + The notebook document's uri. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The type of the notebook. + + -} + _notebookType :: Data.Text.Text + , {-| + The version number of this document (it will increase after each + change, including undo/redo). + + -} + _version :: Language.LSP.Protocol.Types.Common.Int32 + , {-| + Additional metadata stored with the notebook + document. + + Note: should always be an object literal (e.g. LSPObject) + + -} + _metadata :: (Maybe Data.Aeson.Object) + , {-| + The cells of a notebook. + + -} + _cells :: [Language.LSP.Protocol.Internal.Types.NotebookCell.NotebookCell] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON NotebookDocument where + toJSON (NotebookDocument arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ [["uri" Aeson..= arg0] + ,["notebookType" Aeson..= arg1] + ,["version" Aeson..= arg2] + ,"metadata" Language.LSP.Protocol.Types.Common..=? arg3 + ,["cells" Aeson..= arg4]] + +instance Aeson.FromJSON NotebookDocument where + parseJSON = Aeson.withObject "NotebookDocument" $ \arg -> NotebookDocument <$> arg Aeson..: "uri" <*> arg Aeson..: "notebookType" <*> arg Aeson..: "version" <*> arg Aeson..:! "metadata" <*> arg Aeson..: "cells" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentChangeEvent.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentChangeEvent.hs new file mode 100644 index 000000000..166e6e857 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentChangeEvent.hs @@ -0,0 +1,48 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.NotebookDocumentChangeEvent where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.NotebookCell +import qualified Language.LSP.Protocol.Internal.Types.NotebookCellArrayChange +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentItem +import qualified Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +A change event for a notebook document. + +@since 3.17.0 + +-} +data NotebookDocumentChangeEvent = NotebookDocumentChangeEvent + { {-| + The changed meta data if any. + + Note: should always be an object literal (e.g. LSPObject) + + -} + _metadata :: (Maybe Data.Aeson.Object) + , {-| + Changes to cells + + -} + _cells :: (Maybe (Row.Rec ("structure" Row..== (Maybe (Row.Rec ("array" Row..== Language.LSP.Protocol.Internal.Types.NotebookCellArrayChange.NotebookCellArrayChange Row..+ ("didOpen" Row..== (Maybe [Language.LSP.Protocol.Internal.Types.TextDocumentItem.TextDocumentItem]) Row..+ ("didClose" Row..== (Maybe [Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier]) Row..+ Row.Empty))))) Row..+ ("data" Row..== (Maybe [Language.LSP.Protocol.Internal.Types.NotebookCell.NotebookCell]) Row..+ ("textContent" Row..== (Maybe [(Row.Rec ("document" Row..== Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier.VersionedTextDocumentIdentifier Row..+ ("changes" Row..== [Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent.TextDocumentContentChangeEvent] Row..+ Row.Empty)))]) Row..+ Row.Empty))))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON NotebookDocumentChangeEvent where + toJSON (NotebookDocumentChangeEvent arg0 arg1) = Aeson.object $ concat $ ["metadata" Language.LSP.Protocol.Types.Common..=? arg0 + ,"cells" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON NotebookDocumentChangeEvent where + parseJSON = Aeson.withObject "NotebookDocumentChangeEvent" $ \arg -> NotebookDocumentChangeEvent <$> arg Aeson..:! "metadata" <*> arg Aeson..:! "cells" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentClientCapabilities.hs new file mode 100644 index 000000000..e5504ff9c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentClientCapabilities.hs @@ -0,0 +1,35 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.NotebookDocumentClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncClientCapabilities +import qualified Language.LSP.Protocol.Types.Common + +{-| +Capabilities specific to the notebook document support. + +@since 3.17.0 + +-} +data NotebookDocumentClientCapabilities = NotebookDocumentClientCapabilities + { {-| + Capabilities specific to notebook document synchronization + + @since 3.17.0 + + -} + _synchronization :: Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncClientCapabilities.NotebookDocumentSyncClientCapabilities + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON NotebookDocumentClientCapabilities where + toJSON (NotebookDocumentClientCapabilities arg0) = Aeson.object $ concat $ [["synchronization" Aeson..= arg0]] + +instance Aeson.FromJSON NotebookDocumentClientCapabilities where + parseJSON = Aeson.withObject "NotebookDocumentClientCapabilities" $ \arg -> NotebookDocumentClientCapabilities <$> arg Aeson..: "synchronization" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilter.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilter.hs new file mode 100644 index 000000000..272f840cb --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilter.hs @@ -0,0 +1,25 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +A notebook document filter denotes a notebook document by +different properties. The properties will be match +against the notebook's URI (same as with documents) + +@since 3.17.0 + +-} +newtype NotebookDocumentFilter = NotebookDocumentFilter ((Row.Rec ("notebookType" Row..== Data.Text.Text Row..+ ("scheme" Row..== (Maybe Data.Text.Text) Row..+ ("pattern" Row..== (Maybe Data.Text.Text) Row..+ Row.Empty)))) Language.LSP.Protocol.Types.Common.|? ((Row.Rec ("notebookType" Row..== (Maybe Data.Text.Text) Row..+ ("scheme" Row..== Data.Text.Text Row..+ ("pattern" Row..== (Maybe Data.Text.Text) Row..+ Row.Empty)))) Language.LSP.Protocol.Types.Common.|? (Row.Rec ("notebookType" Row..== (Maybe Data.Text.Text) Row..+ ("scheme" Row..== (Maybe Data.Text.Text) Row..+ ("pattern" Row..== Data.Text.Text Row..+ Row.Empty)))))) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentIdentifier.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentIdentifier.hs new file mode 100644 index 000000000..ca47b7da6 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentIdentifier.hs @@ -0,0 +1,33 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.NotebookDocumentIdentifier where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A literal to identify a notebook document in the client. + +@since 3.17.0 + +-} +data NotebookDocumentIdentifier = NotebookDocumentIdentifier + { {-| + The notebook document's uri. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON NotebookDocumentIdentifier where + toJSON (NotebookDocumentIdentifier arg0) = Aeson.object $ concat $ [["uri" Aeson..= arg0]] + +instance Aeson.FromJSON NotebookDocumentIdentifier where + parseJSON = Aeson.withObject "NotebookDocumentIdentifier" $ \arg -> NotebookDocumentIdentifier <$> arg Aeson..: "uri" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncClientCapabilities.hs new file mode 100644 index 000000000..f8c6813ea --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncClientCapabilities.hs @@ -0,0 +1,41 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Notebook specific client capabilities. + +@since 3.17.0 + +-} +data NotebookDocumentSyncClientCapabilities = NotebookDocumentSyncClientCapabilities + { {-| + Whether implementation supports dynamic registration. If this is + set to `true` the client supports the new + `(TextDocumentRegistrationOptions & StaticRegistrationOptions)` + return value for the corresponding server capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + The client supports sending execution summary data per cell. + + -} + _executionSummarySupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON NotebookDocumentSyncClientCapabilities where + toJSON (NotebookDocumentSyncClientCapabilities arg0 arg1) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"executionSummarySupport" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON NotebookDocumentSyncClientCapabilities where + parseJSON = Aeson.withObject "NotebookDocumentSyncClientCapabilities" $ \arg -> NotebookDocumentSyncClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "executionSummarySupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncOptions.hs new file mode 100644 index 000000000..d732dcc7b --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncOptions.hs @@ -0,0 +1,52 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter +import qualified Language.LSP.Protocol.Types.Common + +{-| +Options specific to a notebook plus its cells +to be synced to the server. + +If a selector provides a notebook document +filter but no cell selector all cells of a +matching notebook document will be synced. + +If a selector provides no notebook document +filter but only a cell selector all notebook +document that contain at least one matching +cell will be synced. + +@since 3.17.0 + +-} +data NotebookDocumentSyncOptions = NotebookDocumentSyncOptions + { {-| + The notebooks to be synced + + -} + _notebookSelector :: [((Row.Rec ("notebook" Row..== (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter.NotebookDocumentFilter) Row..+ ("cells" Row..== (Maybe [(Row.Rec ("language" Row..== Data.Text.Text Row..+ Row.Empty))]) Row..+ Row.Empty))) Language.LSP.Protocol.Types.Common.|? (Row.Rec ("notebook" Row..== (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter.NotebookDocumentFilter)) Row..+ ("cells" Row..== [(Row.Rec ("language" Row..== Data.Text.Text Row..+ Row.Empty))] Row..+ Row.Empty))))] + , {-| + Whether save notification should be forwarded to + the server. Will only be honored if mode === `notebook`. + + -} + _save :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON NotebookDocumentSyncOptions where + toJSON (NotebookDocumentSyncOptions arg0 arg1) = Aeson.object $ concat $ [["notebookSelector" Aeson..= arg0] + ,"save" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON NotebookDocumentSyncOptions where + parseJSON = Aeson.withObject "NotebookDocumentSyncOptions" $ \arg -> NotebookDocumentSyncOptions <$> arg Aeson..: "notebookSelector" <*> arg Aeson..:! "save" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncRegistrationOptions.hs new file mode 100644 index 000000000..9550b4324 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncRegistrationOptions.hs @@ -0,0 +1,49 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options specific to a notebook. + +@since 3.17.0 + +-} +data NotebookDocumentSyncRegistrationOptions = NotebookDocumentSyncRegistrationOptions + { {-| + The notebooks to be synced + + -} + _notebookSelector :: [((Row.Rec ("notebook" Row..== (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter.NotebookDocumentFilter) Row..+ ("cells" Row..== (Maybe [(Row.Rec ("language" Row..== Data.Text.Text Row..+ Row.Empty))]) Row..+ Row.Empty))) Language.LSP.Protocol.Types.Common.|? (Row.Rec ("notebook" Row..== (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter.NotebookDocumentFilter)) Row..+ ("cells" Row..== [(Row.Rec ("language" Row..== Data.Text.Text Row..+ Row.Empty))] Row..+ Row.Empty))))] + , {-| + Whether save notification should be forwarded to + the server. Will only be honored if mode === `notebook`. + + -} + _save :: (Maybe Bool) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON NotebookDocumentSyncRegistrationOptions where + toJSON (NotebookDocumentSyncRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["notebookSelector" Aeson..= arg0] + ,"save" Language.LSP.Protocol.Types.Common..=? arg1 + ,"id" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON NotebookDocumentSyncRegistrationOptions where + parseJSON = Aeson.withObject "NotebookDocumentSyncRegistrationOptions" $ \arg -> NotebookDocumentSyncRegistrationOptions <$> arg Aeson..: "notebookSelector" <*> arg Aeson..:! "save" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/OptionalVersionedTextDocumentIdentifier.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/OptionalVersionedTextDocumentIdentifier.hs new file mode 100644 index 000000000..cddd52647 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/OptionalVersionedTextDocumentIdentifier.hs @@ -0,0 +1,41 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.OptionalVersionedTextDocumentIdentifier where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A text document identifier to optionally denote a specific version of a text document. + +-} +data OptionalVersionedTextDocumentIdentifier = OptionalVersionedTextDocumentIdentifier + { {-| + The text document's uri. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The version number of this document. If a versioned text document identifier + is sent from the server to the client and the file is not open in the editor + (the server has not received an open notification before) the server can send + `null` to indicate that the version is unknown and the content on disk is the + truth (as specified with document content ownership). + + -} + _version :: (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON OptionalVersionedTextDocumentIdentifier where + toJSON (OptionalVersionedTextDocumentIdentifier arg0 arg1) = Aeson.object $ concat $ [["uri" Aeson..= arg0] + ,["version" Aeson..= arg1]] + +instance Aeson.FromJSON OptionalVersionedTextDocumentIdentifier where + parseJSON = Aeson.withObject "OptionalVersionedTextDocumentIdentifier" $ \arg -> OptionalVersionedTextDocumentIdentifier <$> arg Aeson..: "uri" <*> arg Aeson..: "version" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ParameterInformation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ParameterInformation.hs new file mode 100644 index 000000000..41ce87375 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ParameterInformation.hs @@ -0,0 +1,48 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ParameterInformation where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.MarkupContent +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents a parameter of a callable-signature. A parameter can +have a label and a doc-comment. + +-} +data ParameterInformation = ParameterInformation + { {-| + The label of this parameter information. + + Either a string or an inclusive start and exclusive end offsets within its containing + signature label. (see SignatureInformation.label). The offsets are based on a UTF-16 + string representation as `Position` and `Range` does. + + *Note*: a label of type string should be a substring of its containing signature label. + Its intended use case is to highlight the parameter label part in the `SignatureInformation.label`. + + -} + _label :: (Data.Text.Text Language.LSP.Protocol.Types.Common.|? ( Language.LSP.Protocol.Types.Common.UInt + , Language.LSP.Protocol.Types.Common.UInt )) + , {-| + The human-readable doc-comment of this parameter. Will be shown + in the UI but can be omitted. + + -} + _documentation :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.MarkupContent.MarkupContent)) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ParameterInformation where + toJSON (ParameterInformation arg0 arg1) = Aeson.object $ concat $ [["label" Aeson..= arg0] + ,"documentation" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON ParameterInformation where + parseJSON = Aeson.withObject "ParameterInformation" $ \arg -> ParameterInformation <$> arg Aeson..: "label" <*> arg Aeson..:! "documentation" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PartialResultParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PartialResultParams.hs new file mode 100644 index 000000000..969ce2b8e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PartialResultParams.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.PartialResultParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data PartialResultParams = PartialResultParams + { {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON PartialResultParams where + toJSON (PartialResultParams arg0) = Aeson.object $ concat $ ["partialResultToken" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON PartialResultParams where + parseJSON = Aeson.withObject "PartialResultParams" $ \arg -> PartialResultParams <$> arg Aeson..:! "partialResultToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Pattern.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Pattern.hs new file mode 100644 index 000000000..50c821aaf --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Pattern.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Pattern where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text + +{-| +The glob pattern to watch relative to the base path. Glob patterns can have the following syntax: +- `*` to match one or more characters in a path segment +- `?` to match on one character in a path segment +- `**` to match any number of path segments, including none +- `{}` to group conditions (e.g. `**​/*.{ts,js}` matches all TypeScript and JavaScript files) +- `[]` to declare a range of characters to match in a path segment (e.g., `example.[0-9]` to match on `example.0`, `example.1`, …) +- `[!...]` to negate a range of characters to match in a path segment (e.g., `example.[!0-9]` to match on `example.a`, `example.b`, but not `example.0`) + +@since 3.17.0 + +-} +newtype Pattern = Pattern Data.Text.Text + deriving stock (Show, Eq, Ord, Generic) + deriving newtype ( Aeson.ToJSON + , Aeson.FromJSON + , Aeson.ToJSONKey + , Aeson.FromJSONKey ) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Position.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Position.hs new file mode 100644 index 000000000..2e8e17d32 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Position.hs @@ -0,0 +1,71 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Position where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Position in a text document expressed as zero-based line and character +offset. Prior to 3.17 the offsets were always based on a UTF-16 string +representation. So a string of the form `a𐐀b` the character offset of the +character `a` is 0, the character offset of `𐐀` is 1 and the character +offset of b is 3 since `𐐀` is represented using two code units in UTF-16. +Since 3.17 clients and servers can agree on a different string encoding +representation (e.g. UTF-8). The client announces it's supported encoding +via the client capability [`general.positionEncodings`](#clientCapabilities). +The value is an array of position encodings the client supports, with +decreasing preference (e.g. the encoding at index `0` is the most preferred +one). To stay backwards compatible the only mandatory encoding is UTF-16 +represented via the string `utf-16`. The server can pick one of the +encodings offered by the client and signals that encoding back to the +client via the initialize result's property +[`capabilities.positionEncoding`](#serverCapabilities). If the string value +`utf-16` is missing from the client's capability `general.positionEncodings` +servers can safely assume that the client supports UTF-16. If the server +omits the position encoding in its initialize result the encoding defaults +to the string value `utf-16`. Implementation considerations: since the +conversion from one encoding into another requires the content of the +file / line the conversion is best done where the file is read which is +usually on the server side. + +Positions are line end character agnostic. So you can not specify a position +that denotes `\r|\n` or `\n|` where `|` represents the character offset. + +@since 3.17.0 - support for negotiated position encoding. + +-} +data Position = Position + { {-| + Line position in a document (zero-based). + + If a line number is greater than the number of lines in a document, it defaults back to the number of lines in the document. + If a line number is negative, it defaults to 0. + + -} + _line :: Language.LSP.Protocol.Types.Common.UInt + , {-| + Character offset on a line in a document (zero-based). + + The meaning of this offset is determined by the negotiated + `PositionEncodingKind`. + + If the character value is greater than the line length it defaults back to the + line length. + + -} + _character :: Language.LSP.Protocol.Types.Common.UInt + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON Position where + toJSON (Position arg0 arg1) = Aeson.object $ concat $ [["line" Aeson..= arg0] + ,["character" Aeson..= arg1]] + +instance Aeson.FromJSON Position where + parseJSON = Aeson.withObject "Position" $ \arg -> Position <$> arg Aeson..: "line" <*> arg Aeson..: "character" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PositionEncodingKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PositionEncodingKind.hs new file mode 100644 index 000000000..4d8cee8f7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PositionEncodingKind.hs @@ -0,0 +1,66 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.PositionEncodingKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +A set of predefined position encoding kinds. + +@since 3.17.0 + +-} +data PositionEncodingKind = + {-| + Character offsets count UTF-8 code units. + + -} + PositionEncodingKind_UTF8 + | {-| + Character offsets count UTF-16 code units. + + This is the default and must always be supported + by servers + + -} + PositionEncodingKind_UTF16 + | {-| + Character offsets count UTF-32 code units. + + Implementation note: these are the same as Unicode code points, + so this `PositionEncodingKind` may also be used for an + encoding-agnostic representation of character offsets. + + -} + PositionEncodingKind_UTF32 + | PositionEncodingKind_Custom Data.Text.Text + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON + , Data.String.IsString ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum PositionEncodingKind Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum PositionEncodingKind where + knownValues = Data.Set.fromList [PositionEncodingKind_UTF8 + ,PositionEncodingKind_UTF16 + ,PositionEncodingKind_UTF32] + type EnumBaseType PositionEncodingKind = Data.Text.Text + toEnumBaseType PositionEncodingKind_UTF8 = "utf-8" + toEnumBaseType PositionEncodingKind_UTF16 = "utf-16" + toEnumBaseType PositionEncodingKind_UTF32 = "utf-32" + toEnumBaseType (PositionEncodingKind_Custom arg) = arg + +instance Language.LSP.Protocol.Types.LspEnum.LspOpenEnum PositionEncodingKind where + fromOpenEnumBaseType "utf-8" = PositionEncodingKind_UTF8 + fromOpenEnumBaseType "utf-16" = PositionEncodingKind_UTF16 + fromOpenEnumBaseType "utf-32" = PositionEncodingKind_UTF32 + fromOpenEnumBaseType arg = PositionEncodingKind_Custom arg + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameParams.hs new file mode 100644 index 000000000..5b9fc6ac7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameParams.hs @@ -0,0 +1,44 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.PrepareRenameParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data PrepareRenameParams = PrepareRenameParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON PrepareRenameParams where + toJSON (PrepareRenameParams arg0 arg1 arg2) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON PrepareRenameParams where + parseJSON = Aeson.withObject "PrepareRenameParams" $ \arg -> PrepareRenameParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameResult.hs new file mode 100644 index 000000000..a0ade72ab --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameResult.hs @@ -0,0 +1,21 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.PrepareRenameResult where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +newtype PrepareRenameResult = PrepareRenameResult (Language.LSP.Protocol.Internal.Types.Range.Range Language.LSP.Protocol.Types.Common.|? ((Row.Rec ("range" Row..== Language.LSP.Protocol.Internal.Types.Range.Range Row..+ ("placeholder" Row..== Data.Text.Text Row..+ Row.Empty))) Language.LSP.Protocol.Types.Common.|? (Row.Rec ("defaultBehavior" Row..== Bool Row..+ Row.Empty)))) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareSupportDefaultBehavior.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareSupportDefaultBehavior.hs new file mode 100644 index 000000000..89acddd0a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareSupportDefaultBehavior.hs @@ -0,0 +1,36 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.PrepareSupportDefaultBehavior where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| + +-} +data PrepareSupportDefaultBehavior = + {-| + The client's default behavior is to select the identifier + according the to language's syntax rule. + + -} + PrepareSupportDefaultBehavior_Identifier + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum PrepareSupportDefaultBehavior Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum PrepareSupportDefaultBehavior where + knownValues = Data.Set.fromList [PrepareSupportDefaultBehavior_Identifier] + type EnumBaseType PrepareSupportDefaultBehavior = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType PrepareSupportDefaultBehavior_Identifier = 1 + fromEnumBaseType 1 = pure PrepareSupportDefaultBehavior_Identifier + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PreviousResultId.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PreviousResultId.hs new file mode 100644 index 000000000..f5b8cb99c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PreviousResultId.hs @@ -0,0 +1,41 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.PreviousResultId where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A previous result id in a workspace pull request. + +@since 3.17.0 + +-} +data PreviousResultId = PreviousResultId + { {-| + The URI for which the client knowns a + result id. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The value of the previous result id. + + -} + _value :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON PreviousResultId where + toJSON (PreviousResultId arg0 arg1) = Aeson.object $ concat $ [["uri" Aeson..= arg0] + ,["value" Aeson..= arg1]] + +instance Aeson.FromJSON PreviousResultId where + parseJSON = Aeson.withObject "PreviousResultId" $ \arg -> PreviousResultId <$> arg Aeson..: "uri" <*> arg Aeson..: "value" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ProgressParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ProgressParams.hs new file mode 100644 index 000000000..3699e9f86 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ProgressParams.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ProgressParams where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data ProgressParams = ProgressParams + { {-| + The progress token provided by the client or server. + + -} + _token :: Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken + , {-| + The progress data. + + -} + _value :: Data.Aeson.Value + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ProgressParams where + toJSON (ProgressParams arg0 arg1) = Aeson.object $ concat $ [["token" Aeson..= arg0] + ,["value" Aeson..= arg1]] + +instance Aeson.FromJSON ProgressParams where + parseJSON = Aeson.withObject "ProgressParams" $ \arg -> ProgressParams <$> arg Aeson..: "token" <*> arg Aeson..: "value" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ProgressToken.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ProgressToken.hs new file mode 100644 index 000000000..ef707aadd --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ProgressToken.hs @@ -0,0 +1,19 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ProgressToken where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +newtype ProgressToken = ProgressToken (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Data.Text.Text) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsClientCapabilities.hs new file mode 100644 index 000000000..42ba87c11 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsClientCapabilities.hs @@ -0,0 +1,68 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.PublishDiagnosticsClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticTag +import qualified Language.LSP.Protocol.Types.Common + +{-| +The publish diagnostic client capabilities. + +-} +data PublishDiagnosticsClientCapabilities = PublishDiagnosticsClientCapabilities + { {-| + Whether the clients accepts diagnostics with related information. + + -} + _relatedInformation :: (Maybe Bool) + , {-| + Client supports the tag property to provide meta data about a diagnostic. + Clients supporting tags have to handle unknown tags gracefully. + + @since 3.15.0 + + -} + _tagSupport :: (Maybe (Row.Rec ("valueSet" Row..== [Language.LSP.Protocol.Internal.Types.DiagnosticTag.DiagnosticTag] Row..+ Row.Empty))) + , {-| + Whether the client interprets the version property of the + `textDocument/publishDiagnostics` notification's parameter. + + @since 3.15.0 + + -} + _versionSupport :: (Maybe Bool) + , {-| + Client supports a codeDescription property + + @since 3.16.0 + + -} + _codeDescriptionSupport :: (Maybe Bool) + , {-| + Whether code action supports the `data` property which is + preserved between a `textDocument/publishDiagnostics` and + `textDocument/codeAction` request. + + @since 3.16.0 + + -} + _dataSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON PublishDiagnosticsClientCapabilities where + toJSON (PublishDiagnosticsClientCapabilities arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ ["relatedInformation" Language.LSP.Protocol.Types.Common..=? arg0 + ,"tagSupport" Language.LSP.Protocol.Types.Common..=? arg1 + ,"versionSupport" Language.LSP.Protocol.Types.Common..=? arg2 + ,"codeDescriptionSupport" Language.LSP.Protocol.Types.Common..=? arg3 + ,"dataSupport" Language.LSP.Protocol.Types.Common..=? arg4] + +instance Aeson.FromJSON PublishDiagnosticsClientCapabilities where + parseJSON = Aeson.withObject "PublishDiagnosticsClientCapabilities" $ \arg -> PublishDiagnosticsClientCapabilities <$> arg Aeson..:! "relatedInformation" <*> arg Aeson..:! "tagSupport" <*> arg Aeson..:! "versionSupport" <*> arg Aeson..:! "codeDescriptionSupport" <*> arg Aeson..:! "dataSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsParams.hs new file mode 100644 index 000000000..42330fce5 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsParams.hs @@ -0,0 +1,46 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.PublishDiagnosticsParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Diagnostic +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +The publish diagnostic notification's parameters. + +-} +data PublishDiagnosticsParams = PublishDiagnosticsParams + { {-| + The URI for which diagnostic information is reported. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + Optional the version number of the document the diagnostics are published for. + + @since 3.15.0 + + -} + _version :: (Maybe Language.LSP.Protocol.Types.Common.Int32) + , {-| + An array of diagnostic information items. + + -} + _diagnostics :: [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON PublishDiagnosticsParams where + toJSON (PublishDiagnosticsParams arg0 arg1 arg2) = Aeson.object $ concat $ [["uri" Aeson..= arg0] + ,"version" Language.LSP.Protocol.Types.Common..=? arg1 + ,["diagnostics" Aeson..= arg2]] + +instance Aeson.FromJSON PublishDiagnosticsParams where + parseJSON = Aeson.withObject "PublishDiagnosticsParams" $ \arg -> PublishDiagnosticsParams <$> arg Aeson..: "uri" <*> arg Aeson..:! "version" <*> arg Aeson..: "diagnostics" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Range.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Range.hs new file mode 100644 index 000000000..aa98c421d --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Range.hs @@ -0,0 +1,47 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Range where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Types.Common + +{-| +A range in a text document expressed as (zero-based) start and end positions. + +If you want to specify a range that contains a line including the line ending +character(s) then use an end position denoting the start of the next line. +For example: +```ts +{ + start: { line: 5, character: 23 } + end : { line 6, character : 0 } +} +``` + +-} +data Range = Range + { {-| + The range's start position. + + -} + _start :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + The range's end position. + + -} + _end :: Language.LSP.Protocol.Internal.Types.Position.Position + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON Range where + toJSON (Range arg0 arg1) = Aeson.object $ concat $ [["start" Aeson..= arg0] + ,["end" Aeson..= arg1]] + +instance Aeson.FromJSON Range where + parseJSON = Aeson.withObject "Range" $ \arg -> Range <$> arg Aeson..: "start" <*> arg Aeson..: "end" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceClientCapabilities.hs new file mode 100644 index 000000000..b4576a9bf --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceClientCapabilities.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ReferenceClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client Capabilities for a `ReferencesRequest`. + +-} +data ReferenceClientCapabilities = ReferenceClientCapabilities + { {-| + Whether references supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ReferenceClientCapabilities where + toJSON (ReferenceClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON ReferenceClientCapabilities where + parseJSON = Aeson.withObject "ReferenceClientCapabilities" $ \arg -> ReferenceClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceContext.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceContext.hs new file mode 100644 index 000000000..c2b34a777 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceContext.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ReferenceContext where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Value-object that contains additional information when +requesting references. + +-} +data ReferenceContext = ReferenceContext + { {-| + Include the declaration of the current symbol. + + -} + _includeDeclaration :: Bool + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ReferenceContext where + toJSON (ReferenceContext arg0) = Aeson.object $ concat $ [["includeDeclaration" Aeson..= arg0]] + +instance Aeson.FromJSON ReferenceContext where + parseJSON = Aeson.withObject "ReferenceContext" $ \arg -> ReferenceContext <$> arg Aeson..: "includeDeclaration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceOptions.hs new file mode 100644 index 000000000..5d15f03d1 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceOptions.hs @@ -0,0 +1,29 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ReferenceOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Reference options. + +-} +data ReferenceOptions = ReferenceOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ReferenceOptions where + toJSON (ReferenceOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON ReferenceOptions where + parseJSON = Aeson.withObject "ReferenceOptions" $ \arg -> ReferenceOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceParams.hs new file mode 100644 index 000000000..0ee44a481 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceParams.hs @@ -0,0 +1,58 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ReferenceParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.ReferenceContext +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +Parameters for a `ReferencesRequest`. + +-} +data ReferenceParams = ReferenceParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + + -} + _context :: Language.LSP.Protocol.Internal.Types.ReferenceContext.ReferenceContext + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ReferenceParams where + toJSON (ReferenceParams arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg3 + ,["context" Aeson..= arg4]] + +instance Aeson.FromJSON ReferenceParams where + parseJSON = Aeson.withObject "ReferenceParams" $ \arg -> ReferenceParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "context" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceRegistrationOptions.hs new file mode 100644 index 000000000..f07d575c0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceRegistrationOptions.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ReferenceRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `ReferencesRequest`. + +-} +data ReferenceRegistrationOptions = ReferenceRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ReferenceRegistrationOptions where + toJSON (ReferenceRegistrationOptions arg0 arg1) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON ReferenceRegistrationOptions where + parseJSON = Aeson.withObject "ReferenceRegistrationOptions" $ \arg -> ReferenceRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Registration.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Registration.hs new file mode 100644 index 000000000..e7230cc7c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Registration.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Registration where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +General parameters to to register for an notification or to register a provider. + +-} +data Registration = Registration + { {-| + The id used to register the request. The id can be used to deregister + the request again. + + -} + _id :: Data.Text.Text + , {-| + The method / capability to register for. + + -} + _method :: Data.Text.Text + , {-| + Options necessary for the registration. + + -} + _registerOptions :: (Maybe Data.Aeson.Value) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON Registration where + toJSON (Registration arg0 arg1 arg2) = Aeson.object $ concat $ [["id" Aeson..= arg0] + ,["method" Aeson..= arg1] + ,"registerOptions" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON Registration where + parseJSON = Aeson.withObject "Registration" $ \arg -> Registration <$> arg Aeson..: "id" <*> arg Aeson..: "method" <*> arg Aeson..:! "registerOptions" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegistrationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegistrationParams.hs new file mode 100644 index 000000000..0070b4cd0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegistrationParams.hs @@ -0,0 +1,29 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.RegistrationParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Registration +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data RegistrationParams = RegistrationParams + { {-| + + -} + _registrations :: [Language.LSP.Protocol.Internal.Types.Registration.Registration] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON RegistrationParams where + toJSON (RegistrationParams arg0) = Aeson.object $ concat $ [["registrations" Aeson..= arg0]] + +instance Aeson.FromJSON RegistrationParams where + parseJSON = Aeson.withObject "RegistrationParams" $ \arg -> RegistrationParams <$> arg Aeson..: "registrations" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegularExpressionsClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegularExpressionsClientCapabilities.hs new file mode 100644 index 000000000..06344f3cb --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegularExpressionsClientCapabilities.hs @@ -0,0 +1,39 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.RegularExpressionsClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client capabilities specific to regular expressions. + +@since 3.16.0 + +-} +data RegularExpressionsClientCapabilities = RegularExpressionsClientCapabilities + { {-| + The engine's name. + + -} + _engine :: Data.Text.Text + , {-| + The engine's version. + + -} + _version :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON RegularExpressionsClientCapabilities where + toJSON (RegularExpressionsClientCapabilities arg0 arg1) = Aeson.object $ concat $ [["engine" Aeson..= arg0] + ,"version" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON RegularExpressionsClientCapabilities where + parseJSON = Aeson.withObject "RegularExpressionsClientCapabilities" $ \arg -> RegularExpressionsClientCapabilities <$> arg Aeson..: "engine" <*> arg Aeson..:! "version" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedFullDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedFullDocumentDiagnosticReport.hs new file mode 100644 index 000000000..94bf41cbe --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedFullDocumentDiagnosticReport.hs @@ -0,0 +1,65 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.RelatedFullDocumentDiagnosticReport where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Map +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Diagnostic +import qualified Language.LSP.Protocol.Internal.Types.FullDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.UnchangedDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Singletons +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A full diagnostic report with a set of related documents. + +@since 3.17.0 + +-} +data RelatedFullDocumentDiagnosticReport = RelatedFullDocumentDiagnosticReport + { {-| + A full document diagnostic report. + + -} + _kind :: (Language.LSP.Protocol.Types.Singletons.AString "full") + , {-| + An optional result id. If provided it will + be sent on the next diagnostic request for the + same document. + + -} + _resultId :: (Maybe Data.Text.Text) + , {-| + The actual items. + + -} + _items :: [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic] + , {-| + Diagnostics of related documents. This information is useful + in programming languages where code in a file A can generate + diagnostics in a file B which A depends on. An example of + such a language is C/C++ where marco definitions in a file + a.cpp and result in errors in a header file b.hpp. + + @since 3.17.0 + + -} + _relatedDocuments :: (Maybe (Data.Map.Map Language.LSP.Protocol.Types.Uri.Uri (Language.LSP.Protocol.Internal.Types.FullDocumentDiagnosticReport.FullDocumentDiagnosticReport Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.UnchangedDocumentDiagnosticReport.UnchangedDocumentDiagnosticReport))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON RelatedFullDocumentDiagnosticReport where + toJSON (RelatedFullDocumentDiagnosticReport arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["kind" Aeson..= arg0] + ,"resultId" Language.LSP.Protocol.Types.Common..=? arg1 + ,["items" Aeson..= arg2] + ,"relatedDocuments" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON RelatedFullDocumentDiagnosticReport where + parseJSON = Aeson.withObject "RelatedFullDocumentDiagnosticReport" $ \arg -> RelatedFullDocumentDiagnosticReport <$> arg Aeson..: "kind" <*> arg Aeson..:! "resultId" <*> arg Aeson..: "items" <*> arg Aeson..:! "relatedDocuments" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedUnchangedDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedUnchangedDocumentDiagnosticReport.hs new file mode 100644 index 000000000..a2d33dd3a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedUnchangedDocumentDiagnosticReport.hs @@ -0,0 +1,60 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.RelatedUnchangedDocumentDiagnosticReport where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Map +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.FullDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.UnchangedDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Singletons +import qualified Language.LSP.Protocol.Types.Uri + +{-| +An unchanged diagnostic report with a set of related documents. + +@since 3.17.0 + +-} +data RelatedUnchangedDocumentDiagnosticReport = RelatedUnchangedDocumentDiagnosticReport + { {-| + A document diagnostic report indicating + no changes to the last result. A server can + only return `unchanged` if result ids are + provided. + + -} + _kind :: (Language.LSP.Protocol.Types.Singletons.AString "unchanged") + , {-| + A result id which will be sent on the next + diagnostic request for the same document. + + -} + _resultId :: Data.Text.Text + , {-| + Diagnostics of related documents. This information is useful + in programming languages where code in a file A can generate + diagnostics in a file B which A depends on. An example of + such a language is C/C++ where marco definitions in a file + a.cpp and result in errors in a header file b.hpp. + + @since 3.17.0 + + -} + _relatedDocuments :: (Maybe (Data.Map.Map Language.LSP.Protocol.Types.Uri.Uri (Language.LSP.Protocol.Internal.Types.FullDocumentDiagnosticReport.FullDocumentDiagnosticReport Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.UnchangedDocumentDiagnosticReport.UnchangedDocumentDiagnosticReport))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON RelatedUnchangedDocumentDiagnosticReport where + toJSON (RelatedUnchangedDocumentDiagnosticReport arg0 arg1 arg2) = Aeson.object $ concat $ [["kind" Aeson..= arg0] + ,["resultId" Aeson..= arg1] + ,"relatedDocuments" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON RelatedUnchangedDocumentDiagnosticReport where + parseJSON = Aeson.withObject "RelatedUnchangedDocumentDiagnosticReport" $ \arg -> RelatedUnchangedDocumentDiagnosticReport <$> arg Aeson..: "kind" <*> arg Aeson..: "resultId" <*> arg Aeson..:! "relatedDocuments" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelativePattern.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelativePattern.hs new file mode 100644 index 000000000..22f659e08 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelativePattern.hs @@ -0,0 +1,44 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.RelativePattern where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Pattern +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFolder +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A relative pattern is a helper to construct glob patterns that are matched +relatively to a base URI. The common value for a `baseUri` is a workspace +folder root, but it can be another absolute URI as well. + +@since 3.17.0 + +-} +data RelativePattern = RelativePattern + { {-| + A workspace folder or a base URI to which this pattern will be matched + against relatively. + + -} + _baseUri :: (Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Uri.Uri) + , {-| + The actual glob pattern; + + -} + _pattern :: Language.LSP.Protocol.Internal.Types.Pattern.Pattern + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON RelativePattern where + toJSON (RelativePattern arg0 arg1) = Aeson.object $ concat $ [["baseUri" Aeson..= arg0] + ,["pattern" Aeson..= arg1]] + +instance Aeson.FromJSON RelativePattern where + parseJSON = Aeson.withObject "RelativePattern" $ \arg -> RelativePattern <$> arg Aeson..: "baseUri" <*> arg Aeson..: "pattern" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameClientCapabilities.hs new file mode 100644 index 000000000..f7369df66 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameClientCapabilities.hs @@ -0,0 +1,62 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.RenameClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.PrepareSupportDefaultBehavior +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data RenameClientCapabilities = RenameClientCapabilities + { {-| + Whether rename supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + Client supports testing for validity of rename operations + before execution. + + @since 3.12.0 + + -} + _prepareSupport :: (Maybe Bool) + , {-| + Client supports the default behavior result. + + The value indicates the default behavior used by the + client. + + @since 3.16.0 + + -} + _prepareSupportDefaultBehavior :: (Maybe Language.LSP.Protocol.Internal.Types.PrepareSupportDefaultBehavior.PrepareSupportDefaultBehavior) + , {-| + Whether the client honors the change annotations in + text edits and resource operations returned via the + rename request's workspace edit by for example presenting + the workspace edit in the user interface and asking + for confirmation. + + @since 3.16.0 + + -} + _honorsChangeAnnotations :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON RenameClientCapabilities where + toJSON (RenameClientCapabilities arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"prepareSupport" Language.LSP.Protocol.Types.Common..=? arg1 + ,"prepareSupportDefaultBehavior" Language.LSP.Protocol.Types.Common..=? arg2 + ,"honorsChangeAnnotations" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON RenameClientCapabilities where + parseJSON = Aeson.withObject "RenameClientCapabilities" $ \arg -> RenameClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "prepareSupport" <*> arg Aeson..:! "prepareSupportDefaultBehavior" <*> arg Aeson..:! "honorsChangeAnnotations" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFile.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFile.hs new file mode 100644 index 000000000..766b05b58 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFile.hs @@ -0,0 +1,60 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.RenameFile where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier +import qualified Language.LSP.Protocol.Internal.Types.RenameFileOptions +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Singletons +import qualified Language.LSP.Protocol.Types.Uri + +{-| +Rename file operation + +-} +data RenameFile = RenameFile + { {-| + An optional annotation identifier describing the operation. + + @since 3.16.0 + + -} + _annotationId :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier) + , {-| + A rename + + -} + _kind :: (Language.LSP.Protocol.Types.Singletons.AString "rename") + , {-| + The old (existing) location. + + -} + _oldUri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The new location. + + -} + _newUri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + Rename options. + + -} + _options :: (Maybe Language.LSP.Protocol.Internal.Types.RenameFileOptions.RenameFileOptions) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON RenameFile where + toJSON (RenameFile arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ ["annotationId" Language.LSP.Protocol.Types.Common..=? arg0 + ,["kind" Aeson..= arg1] + ,["oldUri" Aeson..= arg2] + ,["newUri" Aeson..= arg3] + ,"options" Language.LSP.Protocol.Types.Common..=? arg4] + +instance Aeson.FromJSON RenameFile where + parseJSON = Aeson.withObject "RenameFile" $ \arg -> RenameFile <$> arg Aeson..:! "annotationId" <*> arg Aeson..: "kind" <*> arg Aeson..: "oldUri" <*> arg Aeson..: "newUri" <*> arg Aeson..:! "options" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFileOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFileOptions.hs new file mode 100644 index 000000000..4500331a3 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFileOptions.hs @@ -0,0 +1,36 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.RenameFileOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Rename file options + +-} +data RenameFileOptions = RenameFileOptions + { {-| + Overwrite target if existing. Overwrite wins over `ignoreIfExists` + + -} + _overwrite :: (Maybe Bool) + , {-| + Ignores if target exists. + + -} + _ignoreIfExists :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON RenameFileOptions where + toJSON (RenameFileOptions arg0 arg1) = Aeson.object $ concat $ ["overwrite" Language.LSP.Protocol.Types.Common..=? arg0 + ,"ignoreIfExists" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON RenameFileOptions where + parseJSON = Aeson.withObject "RenameFileOptions" $ \arg -> RenameFileOptions <$> arg Aeson..:! "overwrite" <*> arg Aeson..:! "ignoreIfExists" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFilesParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFilesParams.hs new file mode 100644 index 000000000..df4ec07a6 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFilesParams.hs @@ -0,0 +1,35 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.RenameFilesParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FileRename +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters sent in notifications/requests for user-initiated renames of +files. + +@since 3.16.0 + +-} +data RenameFilesParams = RenameFilesParams + { {-| + An array of all files/folders renamed in this operation. When a folder is renamed, only + the folder will be included, and not its children. + + -} + _files :: [Language.LSP.Protocol.Internal.Types.FileRename.FileRename] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON RenameFilesParams where + toJSON (RenameFilesParams arg0) = Aeson.object $ concat $ [["files" Aeson..= arg0]] + +instance Aeson.FromJSON RenameFilesParams where + parseJSON = Aeson.withObject "RenameFilesParams" $ \arg -> RenameFilesParams <$> arg Aeson..: "files" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameOptions.hs new file mode 100644 index 000000000..df4af1b5e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameOptions.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.RenameOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Provider options for a `RenameRequest`. + +-} +data RenameOptions = RenameOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + Renames should be checked and tested before being executed. + + @since version 3.12.0 + + -} + _prepareProvider :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON RenameOptions where + toJSON (RenameOptions arg0 arg1) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"prepareProvider" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON RenameOptions where + parseJSON = Aeson.withObject "RenameOptions" $ \arg -> RenameOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "prepareProvider" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameParams.hs new file mode 100644 index 000000000..33783a9a7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameParams.hs @@ -0,0 +1,54 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.RenameParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a `RenameRequest`. + +-} +data RenameParams = RenameParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The document to rename. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position at which this request was sent. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + The new name of the symbol. If the given name is not valid the + request must return a `ResponseError` with an + appropriate message set. + + -} + _newName :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON RenameParams where + toJSON (RenameParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,["textDocument" Aeson..= arg1] + ,["position" Aeson..= arg2] + ,["newName" Aeson..= arg3]] + +instance Aeson.FromJSON RenameParams where + parseJSON = Aeson.withObject "RenameParams" $ \arg -> RenameParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..: "newName" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameRegistrationOptions.hs new file mode 100644 index 000000000..f43f6ead7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameRegistrationOptions.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.RenameRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `RenameRequest`. + +-} +data RenameRegistrationOptions = RenameRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + Renames should be checked and tested before being executed. + + @since version 3.12.0 + + -} + _prepareProvider :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON RenameRegistrationOptions where + toJSON (RenameRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"prepareProvider" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON RenameRegistrationOptions where + parseJSON = Aeson.withObject "RenameRegistrationOptions" $ \arg -> RenameRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "prepareProvider" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ResourceOperation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ResourceOperation.hs new file mode 100644 index 000000000..a4bc4f268 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ResourceOperation.hs @@ -0,0 +1,40 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ResourceOperation where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +A generic resource operation. + +-} +data ResourceOperation = ResourceOperation + { {-| + The resource operation kind. + + -} + _kind :: Data.Text.Text + , {-| + An optional annotation identifier describing the operation. + + @since 3.16.0 + + -} + _annotationId :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ResourceOperation where + toJSON (ResourceOperation arg0 arg1) = Aeson.object $ concat $ [["kind" Aeson..= arg0] + ,"annotationId" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON ResourceOperation where + parseJSON = Aeson.withObject "ResourceOperation" $ \arg -> ResourceOperation <$> arg Aeson..: "kind" <*> arg Aeson..:! "annotationId" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ResourceOperationKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ResourceOperationKind.hs new file mode 100644 index 000000000..9b7958a5c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ResourceOperationKind.hs @@ -0,0 +1,51 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ResourceOperationKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| + +-} +data ResourceOperationKind = + {-| + Supports creating new files and folders. + + -} + ResourceOperationKind_Create + | {-| + Supports renaming existing files and folders. + + -} + ResourceOperationKind_Rename + | {-| + Supports deleting existing files and folders. + + -} + ResourceOperationKind_Delete + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum ResourceOperationKind Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum ResourceOperationKind where + knownValues = Data.Set.fromList [ResourceOperationKind_Create + ,ResourceOperationKind_Rename + ,ResourceOperationKind_Delete] + type EnumBaseType ResourceOperationKind = Data.Text.Text + toEnumBaseType ResourceOperationKind_Create = "create" + toEnumBaseType ResourceOperationKind_Rename = "rename" + toEnumBaseType ResourceOperationKind_Delete = "delete" + fromEnumBaseType "create" = pure ResourceOperationKind_Create + fromEnumBaseType "rename" = pure ResourceOperationKind_Rename + fromEnumBaseType "delete" = pure ResourceOperationKind_Delete + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SaveOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SaveOptions.hs new file mode 100644 index 000000000..c4e4ea61e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SaveOptions.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SaveOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Save options. + +-} +data SaveOptions = SaveOptions + { {-| + The client is supposed to include the content on save. + + -} + _includeText :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SaveOptions where + toJSON (SaveOptions arg0) = Aeson.object $ concat $ ["includeText" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON SaveOptions where + parseJSON = Aeson.withObject "SaveOptions" $ \arg -> SaveOptions <$> arg Aeson..:! "includeText" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRange.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRange.hs new file mode 100644 index 000000000..86c1b219c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRange.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SelectionRange where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +A selection range represents a part of a selection hierarchy. A selection range +may have a parent selection range that contains it. + +-} +data SelectionRange = SelectionRange + { {-| + The `Range` of this selection range. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The parent selection range containing this range. Therefore `parent.range` must contain `this.range`. + + -} + _parent :: (Maybe Language.LSP.Protocol.Internal.Types.SelectionRange.SelectionRange) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SelectionRange where + toJSON (SelectionRange arg0 arg1) = Aeson.object $ concat $ [["range" Aeson..= arg0] + ,"parent" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON SelectionRange where + parseJSON = Aeson.withObject "SelectionRange" $ \arg -> SelectionRange <$> arg Aeson..: "range" <*> arg Aeson..:! "parent" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeClientCapabilities.hs new file mode 100644 index 000000000..852881cb2 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeClientCapabilities.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SelectionRangeClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data SelectionRangeClientCapabilities = SelectionRangeClientCapabilities + { {-| + Whether implementation supports dynamic registration for selection range providers. If this is set to `true` + the client supports the new `SelectionRangeRegistrationOptions` return value for the corresponding server + capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SelectionRangeClientCapabilities where + toJSON (SelectionRangeClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON SelectionRangeClientCapabilities where + parseJSON = Aeson.withObject "SelectionRangeClientCapabilities" $ \arg -> SelectionRangeClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeOptions.hs new file mode 100644 index 000000000..f02d4dd7f --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeOptions.hs @@ -0,0 +1,28 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SelectionRangeOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data SelectionRangeOptions = SelectionRangeOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SelectionRangeOptions where + toJSON (SelectionRangeOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON SelectionRangeOptions where + parseJSON = Aeson.withObject "SelectionRangeOptions" $ \arg -> SelectionRangeOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeParams.hs new file mode 100644 index 000000000..e4c08162c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeParams.hs @@ -0,0 +1,52 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SelectionRangeParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +A parameter literal used in selection range requests. + +-} +data SelectionRangeParams = SelectionRangeParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The positions inside the text document. + + -} + _positions :: [Language.LSP.Protocol.Internal.Types.Position.Position] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SelectionRangeParams where + toJSON (SelectionRangeParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["textDocument" Aeson..= arg2] + ,["positions" Aeson..= arg3]] + +instance Aeson.FromJSON SelectionRangeParams where + parseJSON = Aeson.withObject "SelectionRangeParams" $ \arg -> SelectionRangeParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "textDocument" <*> arg Aeson..: "positions" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeRegistrationOptions.hs new file mode 100644 index 000000000..df986a357 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeRegistrationOptions.hs @@ -0,0 +1,44 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SelectionRangeRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data SelectionRangeRegistrationOptions = SelectionRangeRegistrationOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SelectionRangeRegistrationOptions where + toJSON (SelectionRangeRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,["documentSelector" Aeson..= arg1] + ,"id" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON SelectionRangeRegistrationOptions where + parseJSON = Aeson.withObject "SelectionRangeRegistrationOptions" $ \arg -> SelectionRangeRegistrationOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..: "documentSelector" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokenModifiers.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokenModifiers.hs new file mode 100644 index 000000000..eed0218ab --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokenModifiers.hs @@ -0,0 +1,107 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokenModifiers where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +A set of predefined token modifiers. This set is not fixed +an clients can specify additional token types via the +corresponding client capabilities. + +@since 3.16.0 + +-} +data SemanticTokenModifiers = + {-| + + -} + SemanticTokenModifiers_Declaration + | {-| + + -} + SemanticTokenModifiers_Definition + | {-| + + -} + SemanticTokenModifiers_Readonly + | {-| + + -} + SemanticTokenModifiers_Static + | {-| + + -} + SemanticTokenModifiers_Deprecated + | {-| + + -} + SemanticTokenModifiers_Abstract + | {-| + + -} + SemanticTokenModifiers_Async + | {-| + + -} + SemanticTokenModifiers_Modification + | {-| + + -} + SemanticTokenModifiers_Documentation + | {-| + + -} + SemanticTokenModifiers_DefaultLibrary + | SemanticTokenModifiers_Custom Data.Text.Text + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON + , Data.String.IsString ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum SemanticTokenModifiers Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum SemanticTokenModifiers where + knownValues = Data.Set.fromList [SemanticTokenModifiers_Declaration + ,SemanticTokenModifiers_Definition + ,SemanticTokenModifiers_Readonly + ,SemanticTokenModifiers_Static + ,SemanticTokenModifiers_Deprecated + ,SemanticTokenModifiers_Abstract + ,SemanticTokenModifiers_Async + ,SemanticTokenModifiers_Modification + ,SemanticTokenModifiers_Documentation + ,SemanticTokenModifiers_DefaultLibrary] + type EnumBaseType SemanticTokenModifiers = Data.Text.Text + toEnumBaseType SemanticTokenModifiers_Declaration = "declaration" + toEnumBaseType SemanticTokenModifiers_Definition = "definition" + toEnumBaseType SemanticTokenModifiers_Readonly = "readonly" + toEnumBaseType SemanticTokenModifiers_Static = "static" + toEnumBaseType SemanticTokenModifiers_Deprecated = "deprecated" + toEnumBaseType SemanticTokenModifiers_Abstract = "abstract" + toEnumBaseType SemanticTokenModifiers_Async = "async" + toEnumBaseType SemanticTokenModifiers_Modification = "modification" + toEnumBaseType SemanticTokenModifiers_Documentation = "documentation" + toEnumBaseType SemanticTokenModifiers_DefaultLibrary = "defaultLibrary" + toEnumBaseType (SemanticTokenModifiers_Custom arg) = arg + +instance Language.LSP.Protocol.Types.LspEnum.LspOpenEnum SemanticTokenModifiers where + fromOpenEnumBaseType "declaration" = SemanticTokenModifiers_Declaration + fromOpenEnumBaseType "definition" = SemanticTokenModifiers_Definition + fromOpenEnumBaseType "readonly" = SemanticTokenModifiers_Readonly + fromOpenEnumBaseType "static" = SemanticTokenModifiers_Static + fromOpenEnumBaseType "deprecated" = SemanticTokenModifiers_Deprecated + fromOpenEnumBaseType "abstract" = SemanticTokenModifiers_Abstract + fromOpenEnumBaseType "async" = SemanticTokenModifiers_Async + fromOpenEnumBaseType "modification" = SemanticTokenModifiers_Modification + fromOpenEnumBaseType "documentation" = SemanticTokenModifiers_Documentation + fromOpenEnumBaseType "defaultLibrary" = SemanticTokenModifiers_DefaultLibrary + fromOpenEnumBaseType arg = SemanticTokenModifiers_Custom arg + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokenTypes.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokenTypes.hs new file mode 100644 index 000000000..f0985e235 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokenTypes.hs @@ -0,0 +1,201 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokenTypes where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +A set of predefined token types. This set is not fixed +an clients can specify additional token types via the +corresponding client capabilities. + +@since 3.16.0 + +-} +data SemanticTokenTypes = + {-| + + -} + SemanticTokenTypes_Namespace + | {-| + Represents a generic type. Acts as a fallback for types which can't be mapped to + a specific type like class or enum. + + -} + SemanticTokenTypes_Type + | {-| + + -} + SemanticTokenTypes_Class + | {-| + + -} + SemanticTokenTypes_Enum + | {-| + + -} + SemanticTokenTypes_Interface + | {-| + + -} + SemanticTokenTypes_Struct + | {-| + + -} + SemanticTokenTypes_TypeParameter + | {-| + + -} + SemanticTokenTypes_Parameter + | {-| + + -} + SemanticTokenTypes_Variable + | {-| + + -} + SemanticTokenTypes_Property + | {-| + + -} + SemanticTokenTypes_EnumMember + | {-| + + -} + SemanticTokenTypes_Event + | {-| + + -} + SemanticTokenTypes_Function + | {-| + + -} + SemanticTokenTypes_Method + | {-| + + -} + SemanticTokenTypes_Macro + | {-| + + -} + SemanticTokenTypes_Keyword + | {-| + + -} + SemanticTokenTypes_Modifier + | {-| + + -} + SemanticTokenTypes_Comment + | {-| + + -} + SemanticTokenTypes_String + | {-| + + -} + SemanticTokenTypes_Number + | {-| + + -} + SemanticTokenTypes_Regexp + | {-| + + -} + SemanticTokenTypes_Operator + | {-| + @since 3.17.0 + + -} + SemanticTokenTypes_Decorator + | SemanticTokenTypes_Custom Data.Text.Text + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON + , Data.String.IsString ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum SemanticTokenTypes Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum SemanticTokenTypes where + knownValues = Data.Set.fromList [SemanticTokenTypes_Namespace + ,SemanticTokenTypes_Type + ,SemanticTokenTypes_Class + ,SemanticTokenTypes_Enum + ,SemanticTokenTypes_Interface + ,SemanticTokenTypes_Struct + ,SemanticTokenTypes_TypeParameter + ,SemanticTokenTypes_Parameter + ,SemanticTokenTypes_Variable + ,SemanticTokenTypes_Property + ,SemanticTokenTypes_EnumMember + ,SemanticTokenTypes_Event + ,SemanticTokenTypes_Function + ,SemanticTokenTypes_Method + ,SemanticTokenTypes_Macro + ,SemanticTokenTypes_Keyword + ,SemanticTokenTypes_Modifier + ,SemanticTokenTypes_Comment + ,SemanticTokenTypes_String + ,SemanticTokenTypes_Number + ,SemanticTokenTypes_Regexp + ,SemanticTokenTypes_Operator + ,SemanticTokenTypes_Decorator] + type EnumBaseType SemanticTokenTypes = Data.Text.Text + toEnumBaseType SemanticTokenTypes_Namespace = "namespace" + toEnumBaseType SemanticTokenTypes_Type = "type" + toEnumBaseType SemanticTokenTypes_Class = "class" + toEnumBaseType SemanticTokenTypes_Enum = "enum" + toEnumBaseType SemanticTokenTypes_Interface = "interface" + toEnumBaseType SemanticTokenTypes_Struct = "struct" + toEnumBaseType SemanticTokenTypes_TypeParameter = "typeParameter" + toEnumBaseType SemanticTokenTypes_Parameter = "parameter" + toEnumBaseType SemanticTokenTypes_Variable = "variable" + toEnumBaseType SemanticTokenTypes_Property = "property" + toEnumBaseType SemanticTokenTypes_EnumMember = "enumMember" + toEnumBaseType SemanticTokenTypes_Event = "event" + toEnumBaseType SemanticTokenTypes_Function = "function" + toEnumBaseType SemanticTokenTypes_Method = "method" + toEnumBaseType SemanticTokenTypes_Macro = "macro" + toEnumBaseType SemanticTokenTypes_Keyword = "keyword" + toEnumBaseType SemanticTokenTypes_Modifier = "modifier" + toEnumBaseType SemanticTokenTypes_Comment = "comment" + toEnumBaseType SemanticTokenTypes_String = "string" + toEnumBaseType SemanticTokenTypes_Number = "number" + toEnumBaseType SemanticTokenTypes_Regexp = "regexp" + toEnumBaseType SemanticTokenTypes_Operator = "operator" + toEnumBaseType SemanticTokenTypes_Decorator = "decorator" + toEnumBaseType (SemanticTokenTypes_Custom arg) = arg + +instance Language.LSP.Protocol.Types.LspEnum.LspOpenEnum SemanticTokenTypes where + fromOpenEnumBaseType "namespace" = SemanticTokenTypes_Namespace + fromOpenEnumBaseType "type" = SemanticTokenTypes_Type + fromOpenEnumBaseType "class" = SemanticTokenTypes_Class + fromOpenEnumBaseType "enum" = SemanticTokenTypes_Enum + fromOpenEnumBaseType "interface" = SemanticTokenTypes_Interface + fromOpenEnumBaseType "struct" = SemanticTokenTypes_Struct + fromOpenEnumBaseType "typeParameter" = SemanticTokenTypes_TypeParameter + fromOpenEnumBaseType "parameter" = SemanticTokenTypes_Parameter + fromOpenEnumBaseType "variable" = SemanticTokenTypes_Variable + fromOpenEnumBaseType "property" = SemanticTokenTypes_Property + fromOpenEnumBaseType "enumMember" = SemanticTokenTypes_EnumMember + fromOpenEnumBaseType "event" = SemanticTokenTypes_Event + fromOpenEnumBaseType "function" = SemanticTokenTypes_Function + fromOpenEnumBaseType "method" = SemanticTokenTypes_Method + fromOpenEnumBaseType "macro" = SemanticTokenTypes_Macro + fromOpenEnumBaseType "keyword" = SemanticTokenTypes_Keyword + fromOpenEnumBaseType "modifier" = SemanticTokenTypes_Modifier + fromOpenEnumBaseType "comment" = SemanticTokenTypes_Comment + fromOpenEnumBaseType "string" = SemanticTokenTypes_String + fromOpenEnumBaseType "number" = SemanticTokenTypes_Number + fromOpenEnumBaseType "regexp" = SemanticTokenTypes_Regexp + fromOpenEnumBaseType "operator" = SemanticTokenTypes_Operator + fromOpenEnumBaseType "decorator" = SemanticTokenTypes_Decorator + fromOpenEnumBaseType arg = SemanticTokenTypes_Custom arg + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokens.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokens.hs new file mode 100644 index 000000000..3ec76c3ba --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokens.hs @@ -0,0 +1,40 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokens where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokens = SemanticTokens + { {-| + An optional result id. If provided and clients support delta updating + the client will include the result id in the next semantic token request. + A server can then instead of computing all semantic tokens again simply + send a delta. + + -} + _resultId :: (Maybe Data.Text.Text) + , {-| + The actual tokens. + + -} + _data_ :: [Language.LSP.Protocol.Types.Common.UInt] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokens where + toJSON (SemanticTokens arg0 arg1) = Aeson.object $ concat $ ["resultId" Language.LSP.Protocol.Types.Common..=? arg0 + ,["data" Aeson..= arg1]] + +instance Aeson.FromJSON SemanticTokens where + parseJSON = Aeson.withObject "SemanticTokens" $ \arg -> SemanticTokens <$> arg Aeson..:! "resultId" <*> arg Aeson..: "data" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensClientCapabilities.hs new file mode 100644 index 000000000..063d7cca8 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensClientCapabilities.hs @@ -0,0 +1,104 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokensClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.TokenFormat +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokensClientCapabilities = SemanticTokensClientCapabilities + { {-| + Whether implementation supports dynamic registration. If this is set to `true` + the client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)` + return value for the corresponding server capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + Which requests the client supports and might send to the server + depending on the server's capability. Please note that clients might not + show semantic tokens or degrade some of the user experience if a range + or full request is advertised by the client but not provided by the + server. If for example the client capability `requests.full` and + `request.range` are both set to true but the server only provides a + range provider the client might not render a minimap correctly or might + even decide to not show any semantic tokens at all. + + -} + _requests :: (Row.Rec ("range" Row..== (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Row.Rec Row.Empty))) Row..+ ("full" Row..== (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Row.Rec ("delta" Row..== (Maybe Bool) Row..+ Row.Empty)))) Row..+ Row.Empty))) + , {-| + The token types that the client supports. + + -} + _tokenTypes :: [Data.Text.Text] + , {-| + The token modifiers that the client supports. + + -} + _tokenModifiers :: [Data.Text.Text] + , {-| + The token formats the clients supports. + + -} + _formats :: [Language.LSP.Protocol.Internal.Types.TokenFormat.TokenFormat] + , {-| + Whether the client supports tokens that can overlap each other. + + -} + _overlappingTokenSupport :: (Maybe Bool) + , {-| + Whether the client supports tokens that can span multiple lines. + + -} + _multilineTokenSupport :: (Maybe Bool) + , {-| + Whether the client allows the server to actively cancel a + semantic token request, e.g. supports returning + LSPErrorCodes.ServerCancelled. If a server does the client + needs to retrigger the request. + + @since 3.17.0 + + -} + _serverCancelSupport :: (Maybe Bool) + , {-| + Whether the client uses semantic tokens to augment existing + syntax tokens. If set to `true` client side created syntax + tokens and semantic tokens are both used for colorization. If + set to `false` the client only uses the returned semantic tokens + for colorization. + + If the value is `undefined` then the client behavior is not + specified. + + @since 3.17.0 + + -} + _augmentsSyntaxTokens :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokensClientCapabilities where + toJSON (SemanticTokensClientCapabilities arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,["requests" Aeson..= arg1] + ,["tokenTypes" Aeson..= arg2] + ,["tokenModifiers" Aeson..= arg3] + ,["formats" Aeson..= arg4] + ,"overlappingTokenSupport" Language.LSP.Protocol.Types.Common..=? arg5 + ,"multilineTokenSupport" Language.LSP.Protocol.Types.Common..=? arg6 + ,"serverCancelSupport" Language.LSP.Protocol.Types.Common..=? arg7 + ,"augmentsSyntaxTokens" Language.LSP.Protocol.Types.Common..=? arg8] + +instance Aeson.FromJSON SemanticTokensClientCapabilities where + parseJSON = Aeson.withObject "SemanticTokensClientCapabilities" $ \arg -> SemanticTokensClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..: "requests" <*> arg Aeson..: "tokenTypes" <*> arg Aeson..: "tokenModifiers" <*> arg Aeson..: "formats" <*> arg Aeson..:! "overlappingTokenSupport" <*> arg Aeson..:! "multilineTokenSupport" <*> arg Aeson..:! "serverCancelSupport" <*> arg Aeson..:! "augmentsSyntaxTokens" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDelta.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDelta.hs new file mode 100644 index 000000000..99bb528b6 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDelta.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokensDelta where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensEdit +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokensDelta = SemanticTokensDelta + { {-| + + -} + _resultId :: (Maybe Data.Text.Text) + , {-| + The semantic token edits to transform a previous result into a new result. + + -} + _edits :: [Language.LSP.Protocol.Internal.Types.SemanticTokensEdit.SemanticTokensEdit] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokensDelta where + toJSON (SemanticTokensDelta arg0 arg1) = Aeson.object $ concat $ ["resultId" Language.LSP.Protocol.Types.Common..=? arg0 + ,["edits" Aeson..= arg1]] + +instance Aeson.FromJSON SemanticTokensDelta where + parseJSON = Aeson.withObject "SemanticTokensDelta" $ \arg -> SemanticTokensDelta <$> arg Aeson..:! "resultId" <*> arg Aeson..: "edits" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaParams.hs new file mode 100644 index 000000000..ae901c95a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaParams.hs @@ -0,0 +1,53 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokensDeltaParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokensDeltaParams = SemanticTokensDeltaParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The result id of a previous response. The result Id can either point to a full response + or a delta response depending on what was received last. + + -} + _previousResultId :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokensDeltaParams where + toJSON (SemanticTokensDeltaParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["textDocument" Aeson..= arg2] + ,["previousResultId" Aeson..= arg3]] + +instance Aeson.FromJSON SemanticTokensDeltaParams where + parseJSON = Aeson.withObject "SemanticTokensDeltaParams" $ \arg -> SemanticTokensDeltaParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "textDocument" <*> arg Aeson..: "previousResultId" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaPartialResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaPartialResult.hs new file mode 100644 index 000000000..226d7cace --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaPartialResult.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokensDeltaPartialResult where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensEdit +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokensDeltaPartialResult = SemanticTokensDeltaPartialResult + { {-| + + -} + _edits :: [Language.LSP.Protocol.Internal.Types.SemanticTokensEdit.SemanticTokensEdit] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokensDeltaPartialResult where + toJSON (SemanticTokensDeltaPartialResult arg0) = Aeson.object $ concat $ [["edits" Aeson..= arg0]] + +instance Aeson.FromJSON SemanticTokensDeltaPartialResult where + parseJSON = Aeson.withObject "SemanticTokensDeltaPartialResult" $ \arg -> SemanticTokensDeltaPartialResult <$> arg Aeson..: "edits" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensEdit.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensEdit.hs new file mode 100644 index 000000000..8c259a3fd --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensEdit.hs @@ -0,0 +1,42 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokensEdit where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokensEdit = SemanticTokensEdit + { {-| + The start offset of the edit. + + -} + _start :: Language.LSP.Protocol.Types.Common.UInt + , {-| + The count of elements to remove. + + -} + _deleteCount :: Language.LSP.Protocol.Types.Common.UInt + , {-| + The elements to insert. + + -} + _data_ :: (Maybe [Language.LSP.Protocol.Types.Common.UInt]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokensEdit where + toJSON (SemanticTokensEdit arg0 arg1 arg2) = Aeson.object $ concat $ [["start" Aeson..= arg0] + ,["deleteCount" Aeson..= arg1] + ,"data" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON SemanticTokensEdit where + parseJSON = Aeson.withObject "SemanticTokensEdit" $ \arg -> SemanticTokensEdit <$> arg Aeson..: "start" <*> arg Aeson..: "deleteCount" <*> arg Aeson..:! "data" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensLegend.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensLegend.hs new file mode 100644 index 000000000..20c571d9a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensLegend.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokensLegend where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokensLegend = SemanticTokensLegend + { {-| + The token types a server uses. + + -} + _tokenTypes :: [Data.Text.Text] + , {-| + The token modifiers a server uses. + + -} + _tokenModifiers :: [Data.Text.Text] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokensLegend where + toJSON (SemanticTokensLegend arg0 arg1) = Aeson.object $ concat $ [["tokenTypes" Aeson..= arg0] + ,["tokenModifiers" Aeson..= arg1]] + +instance Aeson.FromJSON SemanticTokensLegend where + parseJSON = Aeson.withObject "SemanticTokensLegend" $ \arg -> SemanticTokensLegend <$> arg Aeson..: "tokenTypes" <*> arg Aeson..: "tokenModifiers" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensOptions.hs new file mode 100644 index 000000000..d8b067824 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensOptions.hs @@ -0,0 +1,50 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokensOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensLegend +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokensOptions = SemanticTokensOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The legend used by the server + + -} + _legend :: Language.LSP.Protocol.Internal.Types.SemanticTokensLegend.SemanticTokensLegend + , {-| + Server supports providing semantic tokens for a specific range + of a document. + + -} + _range :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Row.Rec Row.Empty))) + , {-| + Server supports providing semantic tokens for a full document. + + -} + _full :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Row.Rec ("delta" Row..== (Maybe Bool) Row..+ Row.Empty)))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokensOptions where + toJSON (SemanticTokensOptions arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,["legend" Aeson..= arg1] + ,"range" Language.LSP.Protocol.Types.Common..=? arg2 + ,"full" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON SemanticTokensOptions where + parseJSON = Aeson.withObject "SemanticTokensOptions" $ \arg -> SemanticTokensOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..: "legend" <*> arg Aeson..:! "range" <*> arg Aeson..:! "full" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensParams.hs new file mode 100644 index 000000000..aa74fd236 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensParams.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokensParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokensParams = SemanticTokensParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokensParams where + toJSON (SemanticTokensParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["textDocument" Aeson..= arg2]] + +instance Aeson.FromJSON SemanticTokensParams where + parseJSON = Aeson.withObject "SemanticTokensParams" $ \arg -> SemanticTokensParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "textDocument" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensPartialResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensPartialResult.hs new file mode 100644 index 000000000..d2e903465 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensPartialResult.hs @@ -0,0 +1,29 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokensPartialResult where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokensPartialResult = SemanticTokensPartialResult + { {-| + + -} + _data_ :: [Language.LSP.Protocol.Types.Common.UInt] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokensPartialResult where + toJSON (SemanticTokensPartialResult arg0) = Aeson.object $ concat $ [["data" Aeson..= arg0]] + +instance Aeson.FromJSON SemanticTokensPartialResult where + parseJSON = Aeson.withObject "SemanticTokensPartialResult" $ \arg -> SemanticTokensPartialResult <$> arg Aeson..: "data" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRangeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRangeParams.hs new file mode 100644 index 000000000..92263e118 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRangeParams.hs @@ -0,0 +1,52 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokensRangeParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokensRangeParams = SemanticTokensRangeParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The range the semantic tokens are requested for. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokensRangeParams where + toJSON (SemanticTokensRangeParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["textDocument" Aeson..= arg2] + ,["range" Aeson..= arg3]] + +instance Aeson.FromJSON SemanticTokensRangeParams where + parseJSON = Aeson.withObject "SemanticTokensRangeParams" $ \arg -> SemanticTokensRangeParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "textDocument" <*> arg Aeson..: "range" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRegistrationOptions.hs new file mode 100644 index 000000000..98bff60ae --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRegistrationOptions.hs @@ -0,0 +1,66 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokensRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensLegend +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokensRegistrationOptions = SemanticTokensRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The legend used by the server + + -} + _legend :: Language.LSP.Protocol.Internal.Types.SemanticTokensLegend.SemanticTokensLegend + , {-| + Server supports providing semantic tokens for a specific range + of a document. + + -} + _range :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Row.Rec Row.Empty))) + , {-| + Server supports providing semantic tokens for a full document. + + -} + _full :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Row.Rec ("delta" Row..== (Maybe Bool) Row..+ Row.Empty)))) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokensRegistrationOptions where + toJSON (SemanticTokensRegistrationOptions arg0 arg1 arg2 arg3 arg4 arg5) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,["legend" Aeson..= arg2] + ,"range" Language.LSP.Protocol.Types.Common..=? arg3 + ,"full" Language.LSP.Protocol.Types.Common..=? arg4 + ,"id" Language.LSP.Protocol.Types.Common..=? arg5] + +instance Aeson.FromJSON SemanticTokensRegistrationOptions where + parseJSON = Aeson.withObject "SemanticTokensRegistrationOptions" $ \arg -> SemanticTokensRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..: "legend" <*> arg Aeson..:! "range" <*> arg Aeson..:! "full" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensWorkspaceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensWorkspaceClientCapabilities.hs new file mode 100644 index 000000000..ccf64d3ee --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensWorkspaceClientCapabilities.hs @@ -0,0 +1,36 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SemanticTokensWorkspaceClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.16.0 + +-} +data SemanticTokensWorkspaceClientCapabilities = SemanticTokensWorkspaceClientCapabilities + { {-| + Whether the client implementation supports a refresh request sent from + the server to the client. + + Note that this event is global and will force the client to refresh all + semantic tokens currently shown. It should be used with absolute care + and is useful for situation where a server for example detects a project + wide change that requires such a calculation. + + -} + _refreshSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SemanticTokensWorkspaceClientCapabilities where + toJSON (SemanticTokensWorkspaceClientCapabilities arg0) = Aeson.object $ concat $ ["refreshSupport" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON SemanticTokensWorkspaceClientCapabilities where + parseJSON = Aeson.withObject "SemanticTokensWorkspaceClientCapabilities" $ \arg -> SemanticTokensWorkspaceClientCapabilities <$> arg Aeson..:! "refreshSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerCapabilities.hs new file mode 100644 index 000000000..e9dc292e4 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerCapabilities.hs @@ -0,0 +1,320 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ServerCapabilities where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyOptions +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.CodeActionOptions +import qualified Language.LSP.Protocol.Internal.Types.CodeLensOptions +import qualified Language.LSP.Protocol.Internal.Types.CompletionOptions +import qualified Language.LSP.Protocol.Internal.Types.DeclarationOptions +import qualified Language.LSP.Protocol.Internal.Types.DeclarationRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DefinitionOptions +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticOptions +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentColorOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentColorRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentFormattingOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentHighlightOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentLinkOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingOptions +import qualified Language.LSP.Protocol.Internal.Types.DocumentSymbolOptions +import qualified Language.LSP.Protocol.Internal.Types.ExecuteCommandOptions +import qualified Language.LSP.Protocol.Internal.Types.FileOperationOptions +import qualified Language.LSP.Protocol.Internal.Types.FoldingRangeOptions +import qualified Language.LSP.Protocol.Internal.Types.FoldingRangeRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.HoverOptions +import qualified Language.LSP.Protocol.Internal.Types.ImplementationOptions +import qualified Language.LSP.Protocol.Internal.Types.ImplementationRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.InlayHintOptions +import qualified Language.LSP.Protocol.Internal.Types.InlayHintRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.InlineValueOptions +import qualified Language.LSP.Protocol.Internal.Types.InlineValueRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.LinkedEditingRangeOptions +import qualified Language.LSP.Protocol.Internal.Types.LinkedEditingRangeRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.MonikerOptions +import qualified Language.LSP.Protocol.Internal.Types.MonikerRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncOptions +import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.PositionEncodingKind +import qualified Language.LSP.Protocol.Internal.Types.ReferenceOptions +import qualified Language.LSP.Protocol.Internal.Types.RenameOptions +import qualified Language.LSP.Protocol.Internal.Types.SelectionRangeOptions +import qualified Language.LSP.Protocol.Internal.Types.SelectionRangeRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensOptions +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelpOptions +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentSyncKind +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentSyncOptions +import qualified Language.LSP.Protocol.Internal.Types.TypeDefinitionOptions +import qualified Language.LSP.Protocol.Internal.Types.TypeDefinitionRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyOptions +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyRegistrationOptions +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFoldersServerCapabilities +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceSymbolOptions +import qualified Language.LSP.Protocol.Types.Common + +{-| +Defines the capabilities provided by a language +server. + +-} +data ServerCapabilities = ServerCapabilities + { {-| + The position encoding the server picked from the encodings offered + by the client via the client capability `general.positionEncodings`. + + If the client didn't provide any position encodings the only valid + value that a server can return is 'utf-16'. + + If omitted it defaults to 'utf-16'. + + @since 3.17.0 + + -} + _positionEncoding :: (Maybe Language.LSP.Protocol.Internal.Types.PositionEncodingKind.PositionEncodingKind) + , {-| + Defines how text documents are synced. Is either a detailed structure + defining each notification or for backwards compatibility the + TextDocumentSyncKind number. + + -} + _textDocumentSync :: (Maybe (Language.LSP.Protocol.Internal.Types.TextDocumentSyncOptions.TextDocumentSyncOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.TextDocumentSyncKind.TextDocumentSyncKind)) + , {-| + Defines how notebook documents are synced. + + @since 3.17.0 + + -} + _notebookDocumentSync :: (Maybe (Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncOptions.NotebookDocumentSyncOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncRegistrationOptions.NotebookDocumentSyncRegistrationOptions)) + , {-| + The server provides completion support. + + -} + _completionProvider :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionOptions.CompletionOptions) + , {-| + The server provides hover support. + + -} + _hoverProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.HoverOptions.HoverOptions)) + , {-| + The server provides signature help support. + + -} + _signatureHelpProvider :: (Maybe Language.LSP.Protocol.Internal.Types.SignatureHelpOptions.SignatureHelpOptions) + , {-| + The server provides Goto Declaration support. + + -} + _declarationProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.DeclarationOptions.DeclarationOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.DeclarationRegistrationOptions.DeclarationRegistrationOptions))) + , {-| + The server provides goto definition support. + + -} + _definitionProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.DefinitionOptions.DefinitionOptions)) + , {-| + The server provides Goto Type Definition support. + + -} + _typeDefinitionProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.TypeDefinitionOptions.TypeDefinitionOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.TypeDefinitionRegistrationOptions.TypeDefinitionRegistrationOptions))) + , {-| + The server provides Goto Implementation support. + + -} + _implementationProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.ImplementationOptions.ImplementationOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.ImplementationRegistrationOptions.ImplementationRegistrationOptions))) + , {-| + The server provides find references support. + + -} + _referencesProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.ReferenceOptions.ReferenceOptions)) + , {-| + The server provides document highlight support. + + -} + _documentHighlightProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.DocumentHighlightOptions.DocumentHighlightOptions)) + , {-| + The server provides document symbol support. + + -} + _documentSymbolProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.DocumentSymbolOptions.DocumentSymbolOptions)) + , {-| + The server provides code actions. CodeActionOptions may only be + specified if the client states that it supports + `codeActionLiteralSupport` in its initial `initialize` request. + + -} + _codeActionProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.CodeActionOptions.CodeActionOptions)) + , {-| + The server provides code lens. + + -} + _codeLensProvider :: (Maybe Language.LSP.Protocol.Internal.Types.CodeLensOptions.CodeLensOptions) + , {-| + The server provides document link support. + + -} + _documentLinkProvider :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentLinkOptions.DocumentLinkOptions) + , {-| + The server provides color provider support. + + -} + _colorProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.DocumentColorOptions.DocumentColorOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.DocumentColorRegistrationOptions.DocumentColorRegistrationOptions))) + , {-| + The server provides workspace symbol support. + + -} + _workspaceSymbolProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.WorkspaceSymbolOptions.WorkspaceSymbolOptions)) + , {-| + The server provides document formatting. + + -} + _documentFormattingProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.DocumentFormattingOptions.DocumentFormattingOptions)) + , {-| + The server provides document range formatting. + + -} + _documentRangeFormattingProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingOptions.DocumentRangeFormattingOptions)) + , {-| + The server provides document formatting on typing. + + -} + _documentOnTypeFormattingProvider :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingOptions.DocumentOnTypeFormattingOptions) + , {-| + The server provides rename support. RenameOptions may only be + specified if the client states that it supports + `prepareSupport` in its initial `initialize` request. + + -} + _renameProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.RenameOptions.RenameOptions)) + , {-| + The server provides folding provider support. + + -} + _foldingRangeProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.FoldingRangeOptions.FoldingRangeOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.FoldingRangeRegistrationOptions.FoldingRangeRegistrationOptions))) + , {-| + The server provides selection range support. + + -} + _selectionRangeProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.SelectionRangeOptions.SelectionRangeOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.SelectionRangeRegistrationOptions.SelectionRangeRegistrationOptions))) + , {-| + The server provides execute command support. + + -} + _executeCommandProvider :: (Maybe Language.LSP.Protocol.Internal.Types.ExecuteCommandOptions.ExecuteCommandOptions) + , {-| + The server provides call hierarchy support. + + @since 3.16.0 + + -} + _callHierarchyProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.CallHierarchyOptions.CallHierarchyOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.CallHierarchyRegistrationOptions.CallHierarchyRegistrationOptions))) + , {-| + The server provides linked editing range support. + + @since 3.16.0 + + -} + _linkedEditingRangeProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.LinkedEditingRangeOptions.LinkedEditingRangeOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.LinkedEditingRangeRegistrationOptions.LinkedEditingRangeRegistrationOptions))) + , {-| + The server provides semantic tokens support. + + @since 3.16.0 + + -} + _semanticTokensProvider :: (Maybe (Language.LSP.Protocol.Internal.Types.SemanticTokensOptions.SemanticTokensOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.SemanticTokensRegistrationOptions.SemanticTokensRegistrationOptions)) + , {-| + The server provides moniker support. + + @since 3.16.0 + + -} + _monikerProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.MonikerOptions.MonikerOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.MonikerRegistrationOptions.MonikerRegistrationOptions))) + , {-| + The server provides type hierarchy support. + + @since 3.17.0 + + -} + _typeHierarchyProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.TypeHierarchyOptions.TypeHierarchyOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.TypeHierarchyRegistrationOptions.TypeHierarchyRegistrationOptions))) + , {-| + The server provides inline values. + + @since 3.17.0 + + -} + _inlineValueProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.InlineValueOptions.InlineValueOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.InlineValueRegistrationOptions.InlineValueRegistrationOptions))) + , {-| + The server provides inlay hints. + + @since 3.17.0 + + -} + _inlayHintProvider :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.InlayHintOptions.InlayHintOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.InlayHintRegistrationOptions.InlayHintRegistrationOptions))) + , {-| + The server has support for pull model diagnostics. + + @since 3.17.0 + + -} + _diagnosticProvider :: (Maybe (Language.LSP.Protocol.Internal.Types.DiagnosticOptions.DiagnosticOptions Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.DiagnosticRegistrationOptions.DiagnosticRegistrationOptions)) + , {-| + Workspace specific server capabilities. + + -} + _workspace :: (Maybe (Row.Rec ("workspaceFolders" Row..== (Maybe Language.LSP.Protocol.Internal.Types.WorkspaceFoldersServerCapabilities.WorkspaceFoldersServerCapabilities) Row..+ ("fileOperations" Row..== (Maybe Language.LSP.Protocol.Internal.Types.FileOperationOptions.FileOperationOptions) Row..+ Row.Empty)))) + , {-| + Experimental server capabilities. + + -} + _experimental :: (Maybe Data.Aeson.Value) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ServerCapabilities where + toJSON (ServerCapabilities arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34) = Aeson.object $ concat $ ["positionEncoding" Language.LSP.Protocol.Types.Common..=? arg0 + ,"textDocumentSync" Language.LSP.Protocol.Types.Common..=? arg1 + ,"notebookDocumentSync" Language.LSP.Protocol.Types.Common..=? arg2 + ,"completionProvider" Language.LSP.Protocol.Types.Common..=? arg3 + ,"hoverProvider" Language.LSP.Protocol.Types.Common..=? arg4 + ,"signatureHelpProvider" Language.LSP.Protocol.Types.Common..=? arg5 + ,"declarationProvider" Language.LSP.Protocol.Types.Common..=? arg6 + ,"definitionProvider" Language.LSP.Protocol.Types.Common..=? arg7 + ,"typeDefinitionProvider" Language.LSP.Protocol.Types.Common..=? arg8 + ,"implementationProvider" Language.LSP.Protocol.Types.Common..=? arg9 + ,"referencesProvider" Language.LSP.Protocol.Types.Common..=? arg10 + ,"documentHighlightProvider" Language.LSP.Protocol.Types.Common..=? arg11 + ,"documentSymbolProvider" Language.LSP.Protocol.Types.Common..=? arg12 + ,"codeActionProvider" Language.LSP.Protocol.Types.Common..=? arg13 + ,"codeLensProvider" Language.LSP.Protocol.Types.Common..=? arg14 + ,"documentLinkProvider" Language.LSP.Protocol.Types.Common..=? arg15 + ,"colorProvider" Language.LSP.Protocol.Types.Common..=? arg16 + ,"workspaceSymbolProvider" Language.LSP.Protocol.Types.Common..=? arg17 + ,"documentFormattingProvider" Language.LSP.Protocol.Types.Common..=? arg18 + ,"documentRangeFormattingProvider" Language.LSP.Protocol.Types.Common..=? arg19 + ,"documentOnTypeFormattingProvider" Language.LSP.Protocol.Types.Common..=? arg20 + ,"renameProvider" Language.LSP.Protocol.Types.Common..=? arg21 + ,"foldingRangeProvider" Language.LSP.Protocol.Types.Common..=? arg22 + ,"selectionRangeProvider" Language.LSP.Protocol.Types.Common..=? arg23 + ,"executeCommandProvider" Language.LSP.Protocol.Types.Common..=? arg24 + ,"callHierarchyProvider" Language.LSP.Protocol.Types.Common..=? arg25 + ,"linkedEditingRangeProvider" Language.LSP.Protocol.Types.Common..=? arg26 + ,"semanticTokensProvider" Language.LSP.Protocol.Types.Common..=? arg27 + ,"monikerProvider" Language.LSP.Protocol.Types.Common..=? arg28 + ,"typeHierarchyProvider" Language.LSP.Protocol.Types.Common..=? arg29 + ,"inlineValueProvider" Language.LSP.Protocol.Types.Common..=? arg30 + ,"inlayHintProvider" Language.LSP.Protocol.Types.Common..=? arg31 + ,"diagnosticProvider" Language.LSP.Protocol.Types.Common..=? arg32 + ,"workspace" Language.LSP.Protocol.Types.Common..=? arg33 + ,"experimental" Language.LSP.Protocol.Types.Common..=? arg34] + +instance Aeson.FromJSON ServerCapabilities where + parseJSON = Aeson.withObject "ServerCapabilities" $ \arg -> ServerCapabilities <$> arg Aeson..:! "positionEncoding" <*> arg Aeson..:! "textDocumentSync" <*> arg Aeson..:! "notebookDocumentSync" <*> arg Aeson..:! "completionProvider" <*> arg Aeson..:! "hoverProvider" <*> arg Aeson..:! "signatureHelpProvider" <*> arg Aeson..:! "declarationProvider" <*> arg Aeson..:! "definitionProvider" <*> arg Aeson..:! "typeDefinitionProvider" <*> arg Aeson..:! "implementationProvider" <*> arg Aeson..:! "referencesProvider" <*> arg Aeson..:! "documentHighlightProvider" <*> arg Aeson..:! "documentSymbolProvider" <*> arg Aeson..:! "codeActionProvider" <*> arg Aeson..:! "codeLensProvider" <*> arg Aeson..:! "documentLinkProvider" <*> arg Aeson..:! "colorProvider" <*> arg Aeson..:! "workspaceSymbolProvider" <*> arg Aeson..:! "documentFormattingProvider" <*> arg Aeson..:! "documentRangeFormattingProvider" <*> arg Aeson..:! "documentOnTypeFormattingProvider" <*> arg Aeson..:! "renameProvider" <*> arg Aeson..:! "foldingRangeProvider" <*> arg Aeson..:! "selectionRangeProvider" <*> arg Aeson..:! "executeCommandProvider" <*> arg Aeson..:! "callHierarchyProvider" <*> arg Aeson..:! "linkedEditingRangeProvider" <*> arg Aeson..:! "semanticTokensProvider" <*> arg Aeson..:! "monikerProvider" <*> arg Aeson..:! "typeHierarchyProvider" <*> arg Aeson..:! "inlineValueProvider" <*> arg Aeson..:! "inlayHintProvider" <*> arg Aeson..:! "diagnosticProvider" <*> arg Aeson..:! "workspace" <*> arg Aeson..:! "experimental" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SetTraceParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SetTraceParams.hs new file mode 100644 index 000000000..37dea5091 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SetTraceParams.hs @@ -0,0 +1,29 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SetTraceParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.TraceValues +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data SetTraceParams = SetTraceParams + { {-| + + -} + _value :: Language.LSP.Protocol.Internal.Types.TraceValues.TraceValues + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SetTraceParams where + toJSON (SetTraceParams arg0) = Aeson.object $ concat $ [["value" Aeson..= arg0]] + +instance Aeson.FromJSON SetTraceParams where + parseJSON = Aeson.withObject "SetTraceParams" $ \arg -> SetTraceParams <$> arg Aeson..: "value" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentClientCapabilities.hs new file mode 100644 index 000000000..25623caf0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentClientCapabilities.hs @@ -0,0 +1,33 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ShowDocumentClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client capabilities for the showDocument request. + +@since 3.16.0 + +-} +data ShowDocumentClientCapabilities = ShowDocumentClientCapabilities + { {-| + The client has support for the showDocument + request. + + -} + _support :: Bool + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ShowDocumentClientCapabilities where + toJSON (ShowDocumentClientCapabilities arg0) = Aeson.object $ concat $ [["support" Aeson..= arg0]] + +instance Aeson.FromJSON ShowDocumentClientCapabilities where + parseJSON = Aeson.withObject "ShowDocumentClientCapabilities" $ \arg -> ShowDocumentClientCapabilities <$> arg Aeson..: "support" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentParams.hs new file mode 100644 index 000000000..b7e2fab8e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentParams.hs @@ -0,0 +1,60 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ShowDocumentParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +Params to show a document. + +@since 3.16.0 + +-} +data ShowDocumentParams = ShowDocumentParams + { {-| + The document uri to show. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + Indicates to show the resource in an external program. + To show for example `https://code.visualstudio.com/` + in the default WEB browser set `external` to `true`. + + -} + _external :: (Maybe Bool) + , {-| + An optional property to indicate whether the editor + showing the document should take focus or not. + Clients might ignore this property if an external + program is started. + + -} + _takeFocus :: (Maybe Bool) + , {-| + An optional selection range if the document is a text + document. Clients might ignore the property if an + external program is started or the file is not a text + file. + + -} + _selection :: (Maybe Language.LSP.Protocol.Internal.Types.Range.Range) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ShowDocumentParams where + toJSON (ShowDocumentParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["uri" Aeson..= arg0] + ,"external" Language.LSP.Protocol.Types.Common..=? arg1 + ,"takeFocus" Language.LSP.Protocol.Types.Common..=? arg2 + ,"selection" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON ShowDocumentParams where + parseJSON = Aeson.withObject "ShowDocumentParams" $ \arg -> ShowDocumentParams <$> arg Aeson..: "uri" <*> arg Aeson..:! "external" <*> arg Aeson..:! "takeFocus" <*> arg Aeson..:! "selection" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentResult.hs new file mode 100644 index 000000000..255573401 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentResult.hs @@ -0,0 +1,32 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ShowDocumentResult where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +The result of a showDocument request. + +@since 3.16.0 + +-} +data ShowDocumentResult = ShowDocumentResult + { {-| + A boolean indicating if the show was successful. + + -} + _success :: Bool + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ShowDocumentResult where + toJSON (ShowDocumentResult arg0) = Aeson.object $ concat $ [["success" Aeson..= arg0]] + +instance Aeson.FromJSON ShowDocumentResult where + parseJSON = Aeson.withObject "ShowDocumentResult" $ \arg -> ShowDocumentResult <$> arg Aeson..: "success" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageParams.hs new file mode 100644 index 000000000..ed2f59901 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageParams.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ShowMessageParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.MessageType +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a notification message. + +-} +data ShowMessageParams = ShowMessageParams + { {-| + The message type. See `MessageType` + + -} + _type_ :: Language.LSP.Protocol.Internal.Types.MessageType.MessageType + , {-| + The actual message. + + -} + _message :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ShowMessageParams where + toJSON (ShowMessageParams arg0 arg1) = Aeson.object $ concat $ [["type" Aeson..= arg0] + ,["message" Aeson..= arg1]] + +instance Aeson.FromJSON ShowMessageParams where + parseJSON = Aeson.withObject "ShowMessageParams" $ \arg -> ShowMessageParams <$> arg Aeson..: "type" <*> arg Aeson..: "message" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestClientCapabilities.hs new file mode 100644 index 000000000..f1935fcf2 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestClientCapabilities.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ShowMessageRequestClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Show message request client capabilities + +-} +data ShowMessageRequestClientCapabilities = ShowMessageRequestClientCapabilities + { {-| + Capabilities specific to the `MessageActionItem` type. + + -} + _messageActionItem :: (Maybe (Row.Rec ("additionalPropertiesSupport" Row..== (Maybe Bool) Row..+ Row.Empty))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ShowMessageRequestClientCapabilities where + toJSON (ShowMessageRequestClientCapabilities arg0) = Aeson.object $ concat $ ["messageActionItem" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON ShowMessageRequestClientCapabilities where + parseJSON = Aeson.withObject "ShowMessageRequestClientCapabilities" $ \arg -> ShowMessageRequestClientCapabilities <$> arg Aeson..:! "messageActionItem" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestParams.hs new file mode 100644 index 000000000..2817fc624 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestParams.hs @@ -0,0 +1,44 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.ShowMessageRequestParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.MessageActionItem +import qualified Language.LSP.Protocol.Internal.Types.MessageType +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data ShowMessageRequestParams = ShowMessageRequestParams + { {-| + The message type. See `MessageType` + + -} + _type_ :: Language.LSP.Protocol.Internal.Types.MessageType.MessageType + , {-| + The actual message. + + -} + _message :: Data.Text.Text + , {-| + The message action items to present. + + -} + _actions :: (Maybe [Language.LSP.Protocol.Internal.Types.MessageActionItem.MessageActionItem]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON ShowMessageRequestParams where + toJSON (ShowMessageRequestParams arg0 arg1 arg2) = Aeson.object $ concat $ [["type" Aeson..= arg0] + ,["message" Aeson..= arg1] + ,"actions" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON ShowMessageRequestParams where + parseJSON = Aeson.withObject "ShowMessageRequestParams" $ \arg -> ShowMessageRequestParams <$> arg Aeson..: "type" <*> arg Aeson..: "message" <*> arg Aeson..:! "actions" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelp.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelp.hs new file mode 100644 index 000000000..52aa71153 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelp.hs @@ -0,0 +1,59 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SignatureHelp where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.SignatureInformation +import qualified Language.LSP.Protocol.Types.Common + +{-| +Signature help represents the signature of something +callable. There can be multiple signature but only one +active and only one active parameter. + +-} +data SignatureHelp = SignatureHelp + { {-| + One or more signatures. + + -} + _signatures :: [Language.LSP.Protocol.Internal.Types.SignatureInformation.SignatureInformation] + , {-| + The active signature. If omitted or the value lies outside the + range of `signatures` the value defaults to zero or is ignored if + the `SignatureHelp` has no signatures. + + Whenever possible implementors should make an active decision about + the active signature and shouldn't rely on a default value. + + In future version of the protocol this property might become + mandatory to better express this. + + -} + _activeSignature :: (Maybe Language.LSP.Protocol.Types.Common.UInt) + , {-| + The active parameter of the active signature. If omitted or the value + lies outside the range of `signatures[activeSignature].parameters` + defaults to 0 if the active signature has parameters. If + the active signature has no parameters it is ignored. + In future version of the protocol this property might become + mandatory to better express the active parameter if the + active signature does have any. + + -} + _activeParameter :: (Maybe Language.LSP.Protocol.Types.Common.UInt) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SignatureHelp where + toJSON (SignatureHelp arg0 arg1 arg2) = Aeson.object $ concat $ [["signatures" Aeson..= arg0] + ,"activeSignature" Language.LSP.Protocol.Types.Common..=? arg1 + ,"activeParameter" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON SignatureHelp where + parseJSON = Aeson.withObject "SignatureHelp" $ \arg -> SignatureHelp <$> arg Aeson..: "signatures" <*> arg Aeson..:! "activeSignature" <*> arg Aeson..:! "activeParameter" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpClientCapabilities.hs new file mode 100644 index 000000000..605b4dae3 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpClientCapabilities.hs @@ -0,0 +1,50 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SignatureHelpClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.MarkupKind +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client Capabilities for a `SignatureHelpRequest`. + +-} +data SignatureHelpClientCapabilities = SignatureHelpClientCapabilities + { {-| + Whether signature help supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + The client supports the following `SignatureInformation` + specific properties. + + -} + _signatureInformation :: (Maybe (Row.Rec ("documentationFormat" Row..== (Maybe [Language.LSP.Protocol.Internal.Types.MarkupKind.MarkupKind]) Row..+ ("parameterInformation" Row..== (Maybe (Row.Rec ("labelOffsetSupport" Row..== (Maybe Bool) Row..+ Row.Empty))) Row..+ ("activeParameterSupport" Row..== (Maybe Bool) Row..+ Row.Empty))))) + , {-| + The client supports to send additional context information for a + `textDocument/signatureHelp` request. A client that opts into + contextSupport will also support the `retriggerCharacters` on + `SignatureHelpOptions`. + + @since 3.15.0 + + -} + _contextSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SignatureHelpClientCapabilities where + toJSON (SignatureHelpClientCapabilities arg0 arg1 arg2) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"signatureInformation" Language.LSP.Protocol.Types.Common..=? arg1 + ,"contextSupport" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON SignatureHelpClientCapabilities where + parseJSON = Aeson.withObject "SignatureHelpClientCapabilities" $ \arg -> SignatureHelpClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "signatureInformation" <*> arg Aeson..:! "contextSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpContext.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpContext.hs new file mode 100644 index 000000000..9439301b9 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpContext.hs @@ -0,0 +1,61 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SignatureHelpContext where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelp +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelpTriggerKind +import qualified Language.LSP.Protocol.Types.Common + +{-| +Additional information about the context in which a signature help request was triggered. + +@since 3.15.0 + +-} +data SignatureHelpContext = SignatureHelpContext + { {-| + Action that caused signature help to be triggered. + + -} + _triggerKind :: Language.LSP.Protocol.Internal.Types.SignatureHelpTriggerKind.SignatureHelpTriggerKind + , {-| + Character that caused signature help to be triggered. + + This is undefined when `triggerKind !== SignatureHelpTriggerKind.TriggerCharacter` + + -} + _triggerCharacter :: (Maybe Data.Text.Text) + , {-| + `true` if signature help was already showing when it was triggered. + + Retriggers occurs when the signature help is already active and can be caused by actions such as + typing a trigger character, a cursor move, or document content changes. + + -} + _isRetrigger :: Bool + , {-| + The currently active `SignatureHelp`. + + The `activeSignatureHelp` has its `SignatureHelp.activeSignature` field updated based on + the user navigating through available signatures. + + -} + _activeSignatureHelp :: (Maybe Language.LSP.Protocol.Internal.Types.SignatureHelp.SignatureHelp) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SignatureHelpContext where + toJSON (SignatureHelpContext arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["triggerKind" Aeson..= arg0] + ,"triggerCharacter" Language.LSP.Protocol.Types.Common..=? arg1 + ,["isRetrigger" Aeson..= arg2] + ,"activeSignatureHelp" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON SignatureHelpContext where + parseJSON = Aeson.withObject "SignatureHelpContext" $ \arg -> SignatureHelpContext <$> arg Aeson..: "triggerKind" <*> arg Aeson..:! "triggerCharacter" <*> arg Aeson..: "isRetrigger" <*> arg Aeson..:! "activeSignatureHelp" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpOptions.hs new file mode 100644 index 000000000..dd878e4a9 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpOptions.hs @@ -0,0 +1,47 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SignatureHelpOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Server Capabilities for a `SignatureHelpRequest`. + +-} +data SignatureHelpOptions = SignatureHelpOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + List of characters that trigger signature help automatically. + + -} + _triggerCharacters :: (Maybe [Data.Text.Text]) + , {-| + List of characters that re-trigger signature help. + + These trigger characters are only active when signature help is already showing. All trigger characters + are also counted as re-trigger characters. + + @since 3.15.0 + + -} + _retriggerCharacters :: (Maybe [Data.Text.Text]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SignatureHelpOptions where + toJSON (SignatureHelpOptions arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"triggerCharacters" Language.LSP.Protocol.Types.Common..=? arg1 + ,"retriggerCharacters" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON SignatureHelpOptions where + parseJSON = Aeson.withObject "SignatureHelpOptions" $ \arg -> SignatureHelpOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "triggerCharacters" <*> arg Aeson..:! "retriggerCharacters" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpParams.hs new file mode 100644 index 000000000..4e858ba8a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpParams.hs @@ -0,0 +1,55 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SignatureHelpParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelpContext +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +Parameters for a `SignatureHelpRequest`. + +-} +data SignatureHelpParams = SignatureHelpParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The signature help context. This is only available if the client specifies + to send this using the client capability `textDocument.signatureHelp.contextSupport === true` + + @since 3.15.0 + + -} + _context :: (Maybe Language.LSP.Protocol.Internal.Types.SignatureHelpContext.SignatureHelpContext) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SignatureHelpParams where + toJSON (SignatureHelpParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2 + ,"context" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON SignatureHelpParams where + parseJSON = Aeson.withObject "SignatureHelpParams" $ \arg -> SignatureHelpParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "context" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpRegistrationOptions.hs new file mode 100644 index 000000000..043527efa --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpRegistrationOptions.hs @@ -0,0 +1,55 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SignatureHelpRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `SignatureHelpRequest`. + +-} +data SignatureHelpRegistrationOptions = SignatureHelpRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + List of characters that trigger signature help automatically. + + -} + _triggerCharacters :: (Maybe [Data.Text.Text]) + , {-| + List of characters that re-trigger signature help. + + These trigger characters are only active when signature help is already showing. All trigger characters + are also counted as re-trigger characters. + + @since 3.15.0 + + -} + _retriggerCharacters :: (Maybe [Data.Text.Text]) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SignatureHelpRegistrationOptions where + toJSON (SignatureHelpRegistrationOptions arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"triggerCharacters" Language.LSP.Protocol.Types.Common..=? arg2 + ,"retriggerCharacters" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON SignatureHelpRegistrationOptions where + parseJSON = Aeson.withObject "SignatureHelpRegistrationOptions" $ \arg -> SignatureHelpRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "triggerCharacters" <*> arg Aeson..:! "retriggerCharacters" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpTriggerKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpTriggerKind.hs new file mode 100644 index 000000000..58c1fc7fb --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpTriggerKind.hs @@ -0,0 +1,54 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SignatureHelpTriggerKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +How a signature help was triggered. + +@since 3.15.0 + +-} +data SignatureHelpTriggerKind = + {-| + Signature help was invoked manually by the user or by a command. + + -} + SignatureHelpTriggerKind_Invoked + | {-| + Signature help was triggered by a trigger character. + + -} + SignatureHelpTriggerKind_TriggerCharacter + | {-| + Signature help was triggered by the cursor moving or by the document content changing. + + -} + SignatureHelpTriggerKind_ContentChange + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum SignatureHelpTriggerKind Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum SignatureHelpTriggerKind where + knownValues = Data.Set.fromList [SignatureHelpTriggerKind_Invoked + ,SignatureHelpTriggerKind_TriggerCharacter + ,SignatureHelpTriggerKind_ContentChange] + type EnumBaseType SignatureHelpTriggerKind = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType SignatureHelpTriggerKind_Invoked = 1 + toEnumBaseType SignatureHelpTriggerKind_TriggerCharacter = 2 + toEnumBaseType SignatureHelpTriggerKind_ContentChange = 3 + fromEnumBaseType 1 = pure SignatureHelpTriggerKind_Invoked + fromEnumBaseType 2 = pure SignatureHelpTriggerKind_TriggerCharacter + fromEnumBaseType 3 = pure SignatureHelpTriggerKind_ContentChange + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureInformation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureInformation.hs new file mode 100644 index 000000000..28f412795 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureInformation.hs @@ -0,0 +1,59 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SignatureInformation where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.MarkupContent +import qualified Language.LSP.Protocol.Internal.Types.ParameterInformation +import qualified Language.LSP.Protocol.Types.Common + +{-| +Represents the signature of something callable. A signature +can have a label, like a function-name, a doc-comment, and +a set of parameters. + +-} +data SignatureInformation = SignatureInformation + { {-| + The label of this signature. Will be shown in + the UI. + + -} + _label :: Data.Text.Text + , {-| + The human-readable doc-comment of this signature. Will be shown + in the UI but can be omitted. + + -} + _documentation :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.MarkupContent.MarkupContent)) + , {-| + The parameters of this signature. + + -} + _parameters :: (Maybe [Language.LSP.Protocol.Internal.Types.ParameterInformation.ParameterInformation]) + , {-| + The index of the active parameter. + + If provided, this is used in place of `SignatureHelp.activeParameter`. + + @since 3.16.0 + + -} + _activeParameter :: (Maybe Language.LSP.Protocol.Types.Common.UInt) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SignatureInformation where + toJSON (SignatureInformation arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["label" Aeson..= arg0] + ,"documentation" Language.LSP.Protocol.Types.Common..=? arg1 + ,"parameters" Language.LSP.Protocol.Types.Common..=? arg2 + ,"activeParameter" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON SignatureInformation where + parseJSON = Aeson.withObject "SignatureInformation" $ \arg -> SignatureInformation <$> arg Aeson..: "label" <*> arg Aeson..:! "documentation" <*> arg Aeson..:! "parameters" <*> arg Aeson..:! "activeParameter" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/StaticRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/StaticRegistrationOptions.hs new file mode 100644 index 000000000..f934baa16 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/StaticRegistrationOptions.hs @@ -0,0 +1,33 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.StaticRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +Static registration options to be returned in the initialize +request. + +-} +data StaticRegistrationOptions = StaticRegistrationOptions + { {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON StaticRegistrationOptions where + toJSON (StaticRegistrationOptions arg0) = Aeson.object $ concat $ ["id" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON StaticRegistrationOptions where + parseJSON = Aeson.withObject "StaticRegistrationOptions" $ \arg -> StaticRegistrationOptions <$> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolInformation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolInformation.hs new file mode 100644 index 000000000..bb168ca35 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolInformation.hs @@ -0,0 +1,81 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SymbolInformation where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Location +import qualified Language.LSP.Protocol.Internal.Types.SymbolKind +import qualified Language.LSP.Protocol.Internal.Types.SymbolTag +import qualified Language.LSP.Protocol.Types.Common + +{-# DEPRECATED _deprecated "Use tags instead" #-} +{-| +Represents information about programming constructs like variables, classes, +interfaces etc. + +-} +data SymbolInformation = SymbolInformation + { {-| + The name of this symbol. + + -} + _name :: Data.Text.Text + , {-| + The kind of this symbol. + + -} + _kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind + , {-| + Tags for this symbol. + + @since 3.16.0 + + -} + _tags :: (Maybe [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag]) + , {-| + The name of the symbol containing this symbol. This information is for + user interface purposes (e.g. to render a qualifier in the user interface + if necessary). It can't be used to re-infer a hierarchy for the document + symbols. + + -} + _containerName :: (Maybe Data.Text.Text) + , {-| + Indicates if this symbol is deprecated. + + @deprecated Use tags instead + + -} + _deprecated :: (Maybe Bool) + , {-| + The location of this symbol. The location's range is used by a tool + to reveal the location in the editor. If the symbol is selected in the + tool the range's start information is used to position the cursor. So + the range usually spans more than the actual symbol's name and does + normally include things like visibility modifiers. + + The range doesn't have to denote a node range in the sense of an abstract + syntax tree. It can therefore not be used to re-construct a hierarchy of + the symbols. + + -} + _location :: Language.LSP.Protocol.Internal.Types.Location.Location + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON SymbolInformation where + toJSON (SymbolInformation arg0 arg1 arg2 arg3 arg4 arg5) = Aeson.object $ concat $ [["name" Aeson..= arg0] + ,["kind" Aeson..= arg1] + ,"tags" Language.LSP.Protocol.Types.Common..=? arg2 + ,"containerName" Language.LSP.Protocol.Types.Common..=? arg3 + ,"deprecated" Language.LSP.Protocol.Types.Common..=? arg4 + ,["location" Aeson..= arg5]] + +instance Aeson.FromJSON SymbolInformation where + parseJSON = Aeson.withObject "SymbolInformation" $ \arg -> SymbolInformation <$> arg Aeson..: "name" <*> arg Aeson..: "kind" <*> arg Aeson..:! "tags" <*> arg Aeson..:! "containerName" <*> arg Aeson..:! "deprecated" <*> arg Aeson..: "location" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolKind.hs new file mode 100644 index 000000000..0d53352b4 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolKind.hs @@ -0,0 +1,210 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SymbolKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +A symbol kind. + +-} +data SymbolKind = + {-| + + -} + SymbolKind_File + | {-| + + -} + SymbolKind_Module + | {-| + + -} + SymbolKind_Namespace + | {-| + + -} + SymbolKind_Package + | {-| + + -} + SymbolKind_Class + | {-| + + -} + SymbolKind_Method + | {-| + + -} + SymbolKind_Property + | {-| + + -} + SymbolKind_Field + | {-| + + -} + SymbolKind_Constructor + | {-| + + -} + SymbolKind_Enum + | {-| + + -} + SymbolKind_Interface + | {-| + + -} + SymbolKind_Function + | {-| + + -} + SymbolKind_Variable + | {-| + + -} + SymbolKind_Constant + | {-| + + -} + SymbolKind_String + | {-| + + -} + SymbolKind_Number + | {-| + + -} + SymbolKind_Boolean + | {-| + + -} + SymbolKind_Array + | {-| + + -} + SymbolKind_Object + | {-| + + -} + SymbolKind_Key + | {-| + + -} + SymbolKind_Null + | {-| + + -} + SymbolKind_EnumMember + | {-| + + -} + SymbolKind_Struct + | {-| + + -} + SymbolKind_Event + | {-| + + -} + SymbolKind_Operator + | {-| + + -} + SymbolKind_TypeParameter + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum SymbolKind Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum SymbolKind where + knownValues = Data.Set.fromList [SymbolKind_File + ,SymbolKind_Module + ,SymbolKind_Namespace + ,SymbolKind_Package + ,SymbolKind_Class + ,SymbolKind_Method + ,SymbolKind_Property + ,SymbolKind_Field + ,SymbolKind_Constructor + ,SymbolKind_Enum + ,SymbolKind_Interface + ,SymbolKind_Function + ,SymbolKind_Variable + ,SymbolKind_Constant + ,SymbolKind_String + ,SymbolKind_Number + ,SymbolKind_Boolean + ,SymbolKind_Array + ,SymbolKind_Object + ,SymbolKind_Key + ,SymbolKind_Null + ,SymbolKind_EnumMember + ,SymbolKind_Struct + ,SymbolKind_Event + ,SymbolKind_Operator + ,SymbolKind_TypeParameter] + type EnumBaseType SymbolKind = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType SymbolKind_File = 1 + toEnumBaseType SymbolKind_Module = 2 + toEnumBaseType SymbolKind_Namespace = 3 + toEnumBaseType SymbolKind_Package = 4 + toEnumBaseType SymbolKind_Class = 5 + toEnumBaseType SymbolKind_Method = 6 + toEnumBaseType SymbolKind_Property = 7 + toEnumBaseType SymbolKind_Field = 8 + toEnumBaseType SymbolKind_Constructor = 9 + toEnumBaseType SymbolKind_Enum = 10 + toEnumBaseType SymbolKind_Interface = 11 + toEnumBaseType SymbolKind_Function = 12 + toEnumBaseType SymbolKind_Variable = 13 + toEnumBaseType SymbolKind_Constant = 14 + toEnumBaseType SymbolKind_String = 15 + toEnumBaseType SymbolKind_Number = 16 + toEnumBaseType SymbolKind_Boolean = 17 + toEnumBaseType SymbolKind_Array = 18 + toEnumBaseType SymbolKind_Object = 19 + toEnumBaseType SymbolKind_Key = 20 + toEnumBaseType SymbolKind_Null = 21 + toEnumBaseType SymbolKind_EnumMember = 22 + toEnumBaseType SymbolKind_Struct = 23 + toEnumBaseType SymbolKind_Event = 24 + toEnumBaseType SymbolKind_Operator = 25 + toEnumBaseType SymbolKind_TypeParameter = 26 + fromEnumBaseType 1 = pure SymbolKind_File + fromEnumBaseType 2 = pure SymbolKind_Module + fromEnumBaseType 3 = pure SymbolKind_Namespace + fromEnumBaseType 4 = pure SymbolKind_Package + fromEnumBaseType 5 = pure SymbolKind_Class + fromEnumBaseType 6 = pure SymbolKind_Method + fromEnumBaseType 7 = pure SymbolKind_Property + fromEnumBaseType 8 = pure SymbolKind_Field + fromEnumBaseType 9 = pure SymbolKind_Constructor + fromEnumBaseType 10 = pure SymbolKind_Enum + fromEnumBaseType 11 = pure SymbolKind_Interface + fromEnumBaseType 12 = pure SymbolKind_Function + fromEnumBaseType 13 = pure SymbolKind_Variable + fromEnumBaseType 14 = pure SymbolKind_Constant + fromEnumBaseType 15 = pure SymbolKind_String + fromEnumBaseType 16 = pure SymbolKind_Number + fromEnumBaseType 17 = pure SymbolKind_Boolean + fromEnumBaseType 18 = pure SymbolKind_Array + fromEnumBaseType 19 = pure SymbolKind_Object + fromEnumBaseType 20 = pure SymbolKind_Key + fromEnumBaseType 21 = pure SymbolKind_Null + fromEnumBaseType 22 = pure SymbolKind_EnumMember + fromEnumBaseType 23 = pure SymbolKind_Struct + fromEnumBaseType 24 = pure SymbolKind_Event + fromEnumBaseType 25 = pure SymbolKind_Operator + fromEnumBaseType 26 = pure SymbolKind_TypeParameter + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolTag.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolTag.hs new file mode 100644 index 000000000..65af429e0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolTag.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.SymbolTag where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +Symbol tags are extra annotations that tweak the rendering of a symbol. + +@since 3.16 + +-} +data SymbolTag = + {-| + Render a symbol as obsolete, usually using a strike-out. + + -} + SymbolTag_Deprecated + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum SymbolTag Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum SymbolTag where + knownValues = Data.Set.fromList [SymbolTag_Deprecated] + type EnumBaseType SymbolTag = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType SymbolTag_Deprecated = 1 + fromEnumBaseType 1 = pure SymbolTag_Deprecated + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentChangeRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentChangeRegistrationOptions.hs new file mode 100644 index 000000000..468e201d0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentChangeRegistrationOptions.hs @@ -0,0 +1,39 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentChangeRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentSyncKind +import qualified Language.LSP.Protocol.Types.Common + +{-| +Describe options to be used when registered for text document change events. + +-} +data TextDocumentChangeRegistrationOptions = TextDocumentChangeRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + How documents are synced to the server. + + -} + _syncKind :: Language.LSP.Protocol.Internal.Types.TextDocumentSyncKind.TextDocumentSyncKind + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TextDocumentChangeRegistrationOptions where + toJSON (TextDocumentChangeRegistrationOptions arg0 arg1) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,["syncKind" Aeson..= arg1]] + +instance Aeson.FromJSON TextDocumentChangeRegistrationOptions where + parseJSON = Aeson.withObject "TextDocumentChangeRegistrationOptions" $ \arg -> TextDocumentChangeRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..: "syncKind" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentClientCapabilities.hs new file mode 100644 index 000000000..6be7e3f72 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentClientCapabilities.hs @@ -0,0 +1,263 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.CallHierarchyClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.CodeActionClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.CodeLensClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.CompletionClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DeclarationClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DefinitionClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentColorClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentFormattingClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentHighlightClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentLinkClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DocumentSymbolClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.FoldingRangeClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.HoverClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.ImplementationClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.InlayHintClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.InlineValueClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.LinkedEditingRangeClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.MonikerClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.PublishDiagnosticsClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.ReferenceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.RenameClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.SelectionRangeClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.SignatureHelpClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentSyncClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.TypeDefinitionClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyClientCapabilities +import qualified Language.LSP.Protocol.Types.Common + +{-| +Text document specific client capabilities. + +-} +data TextDocumentClientCapabilities = TextDocumentClientCapabilities + { {-| + Defines which synchronization capabilities the client supports. + + -} + _synchronization :: (Maybe Language.LSP.Protocol.Internal.Types.TextDocumentSyncClientCapabilities.TextDocumentSyncClientCapabilities) + , {-| + Capabilities specific to the `textDocument/completion` request. + + -} + _completion :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionClientCapabilities.CompletionClientCapabilities) + , {-| + Capabilities specific to the `textDocument/hover` request. + + -} + _hover :: (Maybe Language.LSP.Protocol.Internal.Types.HoverClientCapabilities.HoverClientCapabilities) + , {-| + Capabilities specific to the `textDocument/signatureHelp` request. + + -} + _signatureHelp :: (Maybe Language.LSP.Protocol.Internal.Types.SignatureHelpClientCapabilities.SignatureHelpClientCapabilities) + , {-| + Capabilities specific to the `textDocument/declaration` request. + + @since 3.14.0 + + -} + _declaration :: (Maybe Language.LSP.Protocol.Internal.Types.DeclarationClientCapabilities.DeclarationClientCapabilities) + , {-| + Capabilities specific to the `textDocument/definition` request. + + -} + _definition :: (Maybe Language.LSP.Protocol.Internal.Types.DefinitionClientCapabilities.DefinitionClientCapabilities) + , {-| + Capabilities specific to the `textDocument/typeDefinition` request. + + @since 3.6.0 + + -} + _typeDefinition :: (Maybe Language.LSP.Protocol.Internal.Types.TypeDefinitionClientCapabilities.TypeDefinitionClientCapabilities) + , {-| + Capabilities specific to the `textDocument/implementation` request. + + @since 3.6.0 + + -} + _implementation :: (Maybe Language.LSP.Protocol.Internal.Types.ImplementationClientCapabilities.ImplementationClientCapabilities) + , {-| + Capabilities specific to the `textDocument/references` request. + + -} + _references :: (Maybe Language.LSP.Protocol.Internal.Types.ReferenceClientCapabilities.ReferenceClientCapabilities) + , {-| + Capabilities specific to the `textDocument/documentHighlight` request. + + -} + _documentHighlight :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentHighlightClientCapabilities.DocumentHighlightClientCapabilities) + , {-| + Capabilities specific to the `textDocument/documentSymbol` request. + + -} + _documentSymbol :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentSymbolClientCapabilities.DocumentSymbolClientCapabilities) + , {-| + Capabilities specific to the `textDocument/codeAction` request. + + -} + _codeAction :: (Maybe Language.LSP.Protocol.Internal.Types.CodeActionClientCapabilities.CodeActionClientCapabilities) + , {-| + Capabilities specific to the `textDocument/codeLens` request. + + -} + _codeLens :: (Maybe Language.LSP.Protocol.Internal.Types.CodeLensClientCapabilities.CodeLensClientCapabilities) + , {-| + Capabilities specific to the `textDocument/documentLink` request. + + -} + _documentLink :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentLinkClientCapabilities.DocumentLinkClientCapabilities) + , {-| + Capabilities specific to the `textDocument/documentColor` and the + `textDocument/colorPresentation` request. + + @since 3.6.0 + + -} + _colorProvider :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentColorClientCapabilities.DocumentColorClientCapabilities) + , {-| + Capabilities specific to the `textDocument/formatting` request. + + -} + _formatting :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentFormattingClientCapabilities.DocumentFormattingClientCapabilities) + , {-| + Capabilities specific to the `textDocument/rangeFormatting` request. + + -} + _rangeFormatting :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingClientCapabilities.DocumentRangeFormattingClientCapabilities) + , {-| + Capabilities specific to the `textDocument/onTypeFormatting` request. + + -} + _onTypeFormatting :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingClientCapabilities.DocumentOnTypeFormattingClientCapabilities) + , {-| + Capabilities specific to the `textDocument/rename` request. + + -} + _rename :: (Maybe Language.LSP.Protocol.Internal.Types.RenameClientCapabilities.RenameClientCapabilities) + , {-| + Capabilities specific to the `textDocument/foldingRange` request. + + @since 3.10.0 + + -} + _foldingRange :: (Maybe Language.LSP.Protocol.Internal.Types.FoldingRangeClientCapabilities.FoldingRangeClientCapabilities) + , {-| + Capabilities specific to the `textDocument/selectionRange` request. + + @since 3.15.0 + + -} + _selectionRange :: (Maybe Language.LSP.Protocol.Internal.Types.SelectionRangeClientCapabilities.SelectionRangeClientCapabilities) + , {-| + Capabilities specific to the `textDocument/publishDiagnostics` notification. + + -} + _publishDiagnostics :: (Maybe Language.LSP.Protocol.Internal.Types.PublishDiagnosticsClientCapabilities.PublishDiagnosticsClientCapabilities) + , {-| + Capabilities specific to the various call hierarchy requests. + + @since 3.16.0 + + -} + _callHierarchy :: (Maybe Language.LSP.Protocol.Internal.Types.CallHierarchyClientCapabilities.CallHierarchyClientCapabilities) + , {-| + Capabilities specific to the various semantic token request. + + @since 3.16.0 + + -} + _semanticTokens :: (Maybe Language.LSP.Protocol.Internal.Types.SemanticTokensClientCapabilities.SemanticTokensClientCapabilities) + , {-| + Capabilities specific to the `textDocument/linkedEditingRange` request. + + @since 3.16.0 + + -} + _linkedEditingRange :: (Maybe Language.LSP.Protocol.Internal.Types.LinkedEditingRangeClientCapabilities.LinkedEditingRangeClientCapabilities) + , {-| + Client capabilities specific to the `textDocument/moniker` request. + + @since 3.16.0 + + -} + _moniker :: (Maybe Language.LSP.Protocol.Internal.Types.MonikerClientCapabilities.MonikerClientCapabilities) + , {-| + Capabilities specific to the various type hierarchy requests. + + @since 3.17.0 + + -} + _typeHierarchy :: (Maybe Language.LSP.Protocol.Internal.Types.TypeHierarchyClientCapabilities.TypeHierarchyClientCapabilities) + , {-| + Capabilities specific to the `textDocument/inlineValue` request. + + @since 3.17.0 + + -} + _inlineValue :: (Maybe Language.LSP.Protocol.Internal.Types.InlineValueClientCapabilities.InlineValueClientCapabilities) + , {-| + Capabilities specific to the `textDocument/inlayHint` request. + + @since 3.17.0 + + -} + _inlayHint :: (Maybe Language.LSP.Protocol.Internal.Types.InlayHintClientCapabilities.InlayHintClientCapabilities) + , {-| + Capabilities specific to the diagnostic pull model. + + @since 3.17.0 + + -} + _diagnostic :: (Maybe Language.LSP.Protocol.Internal.Types.DiagnosticClientCapabilities.DiagnosticClientCapabilities) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TextDocumentClientCapabilities where + toJSON (TextDocumentClientCapabilities arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29) = Aeson.object $ concat $ ["synchronization" Language.LSP.Protocol.Types.Common..=? arg0 + ,"completion" Language.LSP.Protocol.Types.Common..=? arg1 + ,"hover" Language.LSP.Protocol.Types.Common..=? arg2 + ,"signatureHelp" Language.LSP.Protocol.Types.Common..=? arg3 + ,"declaration" Language.LSP.Protocol.Types.Common..=? arg4 + ,"definition" Language.LSP.Protocol.Types.Common..=? arg5 + ,"typeDefinition" Language.LSP.Protocol.Types.Common..=? arg6 + ,"implementation" Language.LSP.Protocol.Types.Common..=? arg7 + ,"references" Language.LSP.Protocol.Types.Common..=? arg8 + ,"documentHighlight" Language.LSP.Protocol.Types.Common..=? arg9 + ,"documentSymbol" Language.LSP.Protocol.Types.Common..=? arg10 + ,"codeAction" Language.LSP.Protocol.Types.Common..=? arg11 + ,"codeLens" Language.LSP.Protocol.Types.Common..=? arg12 + ,"documentLink" Language.LSP.Protocol.Types.Common..=? arg13 + ,"colorProvider" Language.LSP.Protocol.Types.Common..=? arg14 + ,"formatting" Language.LSP.Protocol.Types.Common..=? arg15 + ,"rangeFormatting" Language.LSP.Protocol.Types.Common..=? arg16 + ,"onTypeFormatting" Language.LSP.Protocol.Types.Common..=? arg17 + ,"rename" Language.LSP.Protocol.Types.Common..=? arg18 + ,"foldingRange" Language.LSP.Protocol.Types.Common..=? arg19 + ,"selectionRange" Language.LSP.Protocol.Types.Common..=? arg20 + ,"publishDiagnostics" Language.LSP.Protocol.Types.Common..=? arg21 + ,"callHierarchy" Language.LSP.Protocol.Types.Common..=? arg22 + ,"semanticTokens" Language.LSP.Protocol.Types.Common..=? arg23 + ,"linkedEditingRange" Language.LSP.Protocol.Types.Common..=? arg24 + ,"moniker" Language.LSP.Protocol.Types.Common..=? arg25 + ,"typeHierarchy" Language.LSP.Protocol.Types.Common..=? arg26 + ,"inlineValue" Language.LSP.Protocol.Types.Common..=? arg27 + ,"inlayHint" Language.LSP.Protocol.Types.Common..=? arg28 + ,"diagnostic" Language.LSP.Protocol.Types.Common..=? arg29] + +instance Aeson.FromJSON TextDocumentClientCapabilities where + parseJSON = Aeson.withObject "TextDocumentClientCapabilities" $ \arg -> TextDocumentClientCapabilities <$> arg Aeson..:! "synchronization" <*> arg Aeson..:! "completion" <*> arg Aeson..:! "hover" <*> arg Aeson..:! "signatureHelp" <*> arg Aeson..:! "declaration" <*> arg Aeson..:! "definition" <*> arg Aeson..:! "typeDefinition" <*> arg Aeson..:! "implementation" <*> arg Aeson..:! "references" <*> arg Aeson..:! "documentHighlight" <*> arg Aeson..:! "documentSymbol" <*> arg Aeson..:! "codeAction" <*> arg Aeson..:! "codeLens" <*> arg Aeson..:! "documentLink" <*> arg Aeson..:! "colorProvider" <*> arg Aeson..:! "formatting" <*> arg Aeson..:! "rangeFormatting" <*> arg Aeson..:! "onTypeFormatting" <*> arg Aeson..:! "rename" <*> arg Aeson..:! "foldingRange" <*> arg Aeson..:! "selectionRange" <*> arg Aeson..:! "publishDiagnostics" <*> arg Aeson..:! "callHierarchy" <*> arg Aeson..:! "semanticTokens" <*> arg Aeson..:! "linkedEditingRange" <*> arg Aeson..:! "moniker" <*> arg Aeson..:! "typeHierarchy" <*> arg Aeson..:! "inlineValue" <*> arg Aeson..:! "inlayHint" <*> arg Aeson..:! "diagnostic" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentContentChangeEvent.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentContentChangeEvent.hs new file mode 100644 index 000000000..e44a39d2a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentContentChangeEvent.hs @@ -0,0 +1,23 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +An event describing a change to a text document. If only a text is provided +it is considered to be the full content of the document. + +-} +newtype TextDocumentContentChangeEvent = TextDocumentContentChangeEvent ((Row.Rec ("range" Row..== Language.LSP.Protocol.Internal.Types.Range.Range Row..+ ("rangeLength" Row..== (Maybe Language.LSP.Protocol.Types.Common.UInt) Row..+ ("text" Row..== Data.Text.Text Row..+ Row.Empty)))) Language.LSP.Protocol.Types.Common.|? (Row.Rec ("text" Row..== Data.Text.Text Row..+ Row.Empty))) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentEdit.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentEdit.hs new file mode 100644 index 000000000..428fc2c70 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentEdit.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentEdit where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.AnnotatedTextEdit +import qualified Language.LSP.Protocol.Internal.Types.OptionalVersionedTextDocumentIdentifier +import qualified Language.LSP.Protocol.Internal.Types.TextEdit +import qualified Language.LSP.Protocol.Types.Common + +{-| +Describes textual changes on a text document. A TextDocumentEdit describes all changes +on a document version Si and after they are applied move the document to version Si+1. +So the creator of a TextDocumentEdit doesn't need to sort the array of edits or do any +kind of ordering. However the edits must be non overlapping. + +-} +data TextDocumentEdit = TextDocumentEdit + { {-| + The text document to change. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.OptionalVersionedTextDocumentIdentifier.OptionalVersionedTextDocumentIdentifier + , {-| + The edits to be applied. + + @since 3.16.0 - support for AnnotatedTextEdit. This is guarded using a + client capability. + + -} + _edits :: [(Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.AnnotatedTextEdit.AnnotatedTextEdit)] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TextDocumentEdit where + toJSON (TextDocumentEdit arg0 arg1) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["edits" Aeson..= arg1]] + +instance Aeson.FromJSON TextDocumentEdit where + parseJSON = Aeson.withObject "TextDocumentEdit" $ \arg -> TextDocumentEdit <$> arg Aeson..: "textDocument" <*> arg Aeson..: "edits" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilter.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilter.hs new file mode 100644 index 000000000..79013a87a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilter.hs @@ -0,0 +1,36 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentFilter where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +A document filter denotes a document by different properties like +the `TextDocument.languageId` of +its resource, or a glob-pattern that is applied to the `TextDocument.fileName`. + +Glob patterns can have the following syntax: +- `*` to match one or more characters in a path segment +- `?` to match on one character in a path segment +- `**` to match any number of path segments, including none +- `{}` to group sub patterns into an OR expression. (e.g. `**​/*.{ts,js}` matches all TypeScript and JavaScript files) +- `[]` to declare a range of characters to match in a path segment (e.g., `example.[0-9]` to match on `example.0`, `example.1`, …) +- `[!...]` to negate a range of characters to match in a path segment (e.g., `example.[!0-9]` to match on `example.a`, `example.b`, but not `example.0`) + +@sample A language filter that applies to typescript files on disk: `{ language: 'typescript', scheme: 'file' }` +@sample A language filter that applies to all package.json paths: `{ language: 'json', pattern: '**package.json' }` + +@since 3.17.0 + +-} +newtype TextDocumentFilter = TextDocumentFilter ((Row.Rec ("language" Row..== Data.Text.Text Row..+ ("scheme" Row..== (Maybe Data.Text.Text) Row..+ ("pattern" Row..== (Maybe Data.Text.Text) Row..+ Row.Empty)))) Language.LSP.Protocol.Types.Common.|? ((Row.Rec ("language" Row..== (Maybe Data.Text.Text) Row..+ ("scheme" Row..== Data.Text.Text Row..+ ("pattern" Row..== (Maybe Data.Text.Text) Row..+ Row.Empty)))) Language.LSP.Protocol.Types.Common.|? (Row.Rec ("language" Row..== (Maybe Data.Text.Text) Row..+ ("scheme" Row..== (Maybe Data.Text.Text) Row..+ ("pattern" Row..== Data.Text.Text Row..+ Row.Empty)))))) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentIdentifier.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentIdentifier.hs new file mode 100644 index 000000000..8492d1429 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentIdentifier.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A literal to identify a text document in the client. + +-} +data TextDocumentIdentifier = TextDocumentIdentifier + { {-| + The text document's uri. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TextDocumentIdentifier where + toJSON (TextDocumentIdentifier arg0) = Aeson.object $ concat $ [["uri" Aeson..= arg0]] + +instance Aeson.FromJSON TextDocumentIdentifier where + parseJSON = Aeson.withObject "TextDocumentIdentifier" $ \arg -> TextDocumentIdentifier <$> arg Aeson..: "uri" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentItem.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentItem.hs new file mode 100644 index 000000000..308026053 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentItem.hs @@ -0,0 +1,52 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentItem where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +An item to transfer a text document from the client to the +server. + +-} +data TextDocumentItem = TextDocumentItem + { {-| + The text document's uri. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The text document's language identifier. + + -} + _languageId :: Data.Text.Text + , {-| + The version number of this document (it will increase after each + change, including undo/redo). + + -} + _version :: Language.LSP.Protocol.Types.Common.Int32 + , {-| + The content of the opened text document. + + -} + _text :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TextDocumentItem where + toJSON (TextDocumentItem arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["uri" Aeson..= arg0] + ,["languageId" Aeson..= arg1] + ,["version" Aeson..= arg2] + ,["text" Aeson..= arg3]] + +instance Aeson.FromJSON TextDocumentItem where + parseJSON = Aeson.withObject "TextDocumentItem" $ \arg -> TextDocumentItem <$> arg Aeson..: "uri" <*> arg Aeson..: "languageId" <*> arg Aeson..: "version" <*> arg Aeson..: "text" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentPositionParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentPositionParams.hs new file mode 100644 index 000000000..acdd4c1c4 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentPositionParams.hs @@ -0,0 +1,39 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentPositionParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +A parameter literal used in requests to pass a text document and a position inside that +document. + +-} +data TextDocumentPositionParams = TextDocumentPositionParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TextDocumentPositionParams where + toJSON (TextDocumentPositionParams arg0 arg1) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1]] + +instance Aeson.FromJSON TextDocumentPositionParams where + parseJSON = Aeson.withObject "TextDocumentPositionParams" $ \arg -> TextDocumentPositionParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentRegistrationOptions.hs new file mode 100644 index 000000000..6e4295ab2 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentRegistrationOptions.hs @@ -0,0 +1,32 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +General text document registration options. + +-} +data TextDocumentRegistrationOptions = 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TextDocumentRegistrationOptions where + toJSON (TextDocumentRegistrationOptions arg0) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0]] + +instance Aeson.FromJSON TextDocumentRegistrationOptions where + parseJSON = Aeson.withObject "TextDocumentRegistrationOptions" $ \arg -> TextDocumentRegistrationOptions <$> arg Aeson..: "documentSelector" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSaveReason.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSaveReason.hs new file mode 100644 index 000000000..06b81596c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSaveReason.hs @@ -0,0 +1,53 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentSaveReason where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +Represents reasons why a text document is saved. + +-} +data TextDocumentSaveReason = + {-| + Manually triggered, e.g. by the user pressing save, by starting debugging, + or by an API call. + + -} + TextDocumentSaveReason_Manual + | {-| + Automatic after a delay. + + -} + TextDocumentSaveReason_AfterDelay + | {-| + When the editor lost focus. + + -} + TextDocumentSaveReason_FocusOut + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum TextDocumentSaveReason Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum TextDocumentSaveReason where + knownValues = Data.Set.fromList [TextDocumentSaveReason_Manual + ,TextDocumentSaveReason_AfterDelay + ,TextDocumentSaveReason_FocusOut] + type EnumBaseType TextDocumentSaveReason = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType TextDocumentSaveReason_Manual = 1 + toEnumBaseType TextDocumentSaveReason_AfterDelay = 2 + toEnumBaseType TextDocumentSaveReason_FocusOut = 3 + fromEnumBaseType 1 = pure TextDocumentSaveReason_Manual + fromEnumBaseType 2 = pure TextDocumentSaveReason_AfterDelay + fromEnumBaseType 3 = pure TextDocumentSaveReason_FocusOut + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSaveRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSaveRegistrationOptions.hs new file mode 100644 index 000000000..d4785b0c6 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSaveRegistrationOptions.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentSaveRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Save registration options. + +-} +data TextDocumentSaveRegistrationOptions = TextDocumentSaveRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + The client is supposed to include the content on save. + + -} + _includeText :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TextDocumentSaveRegistrationOptions where + toJSON (TextDocumentSaveRegistrationOptions arg0 arg1) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"includeText" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON TextDocumentSaveRegistrationOptions where + parseJSON = Aeson.withObject "TextDocumentSaveRegistrationOptions" $ \arg -> TextDocumentSaveRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "includeText" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncClientCapabilities.hs new file mode 100644 index 000000000..851e4d2a2 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncClientCapabilities.hs @@ -0,0 +1,49 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentSyncClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data TextDocumentSyncClientCapabilities = TextDocumentSyncClientCapabilities + { {-| + 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 stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TextDocumentSyncClientCapabilities where + toJSON (TextDocumentSyncClientCapabilities arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"willSave" Language.LSP.Protocol.Types.Common..=? arg1 + ,"willSaveWaitUntil" Language.LSP.Protocol.Types.Common..=? arg2 + ,"didSave" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON TextDocumentSyncClientCapabilities where + parseJSON = Aeson.withObject "TextDocumentSyncClientCapabilities" $ \arg -> TextDocumentSyncClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "willSave" <*> arg Aeson..:! "willSaveWaitUntil" <*> arg Aeson..:! "didSave" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncKind.hs new file mode 100644 index 000000000..be04cc934 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncKind.hs @@ -0,0 +1,56 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentSyncKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +Defines how the host (editor) should sync +document changes to the language server. + +-} +data TextDocumentSyncKind = + {-| + Documents should not be synced at all. + + -} + TextDocumentSyncKind_None + | {-| + Documents are synced by always sending the full content + of the document. + + -} + TextDocumentSyncKind_Full + | {-| + Documents are synced by sending the full content on open. + After that only incremental updates to the document are + send. + + -} + TextDocumentSyncKind_Incremental + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum TextDocumentSyncKind Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum TextDocumentSyncKind where + knownValues = Data.Set.fromList [TextDocumentSyncKind_None + ,TextDocumentSyncKind_Full + ,TextDocumentSyncKind_Incremental] + type EnumBaseType TextDocumentSyncKind = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType TextDocumentSyncKind_None = 0 + toEnumBaseType TextDocumentSyncKind_Full = 1 + toEnumBaseType TextDocumentSyncKind_Incremental = 2 + fromEnumBaseType 0 = pure TextDocumentSyncKind_None + fromEnumBaseType 1 = pure TextDocumentSyncKind_Full + fromEnumBaseType 2 = pure TextDocumentSyncKind_Incremental + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncOptions.hs new file mode 100644 index 000000000..8ccd5094a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncOptions.hs @@ -0,0 +1,60 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextDocumentSyncOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.SaveOptions +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentSyncKind +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data TextDocumentSyncOptions = TextDocumentSyncOptions + { {-| + Open and close notifications are sent to the server. If omitted open close notification should not + be sent. + + -} + _openClose :: (Maybe Bool) + , {-| + Change notifications are sent to the server. See TextDocumentSyncKind.None, TextDocumentSyncKind.Full + and TextDocumentSyncKind.Incremental. If omitted it defaults to TextDocumentSyncKind.None. + + -} + _change :: (Maybe Language.LSP.Protocol.Internal.Types.TextDocumentSyncKind.TextDocumentSyncKind) + , {-| + If present will save notifications are sent to the server. If omitted the notification should not be + sent. + + -} + _willSave :: (Maybe Bool) + , {-| + If present will save wait until requests are sent to the server. If omitted the request should not be + sent. + + -} + _willSaveWaitUntil :: (Maybe Bool) + , {-| + If present save notifications are sent to the server. If omitted the notification should not be + sent. + + -} + _save :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.SaveOptions.SaveOptions)) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TextDocumentSyncOptions where + toJSON (TextDocumentSyncOptions arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ ["openClose" Language.LSP.Protocol.Types.Common..=? arg0 + ,"change" Language.LSP.Protocol.Types.Common..=? arg1 + ,"willSave" Language.LSP.Protocol.Types.Common..=? arg2 + ,"willSaveWaitUntil" Language.LSP.Protocol.Types.Common..=? arg3 + ,"save" Language.LSP.Protocol.Types.Common..=? arg4] + +instance Aeson.FromJSON TextDocumentSyncOptions where + parseJSON = Aeson.withObject "TextDocumentSyncOptions" $ \arg -> TextDocumentSyncOptions <$> arg Aeson..:! "openClose" <*> arg Aeson..:! "change" <*> arg Aeson..:! "willSave" <*> arg Aeson..:! "willSaveWaitUntil" <*> arg Aeson..:! "save" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextEdit.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextEdit.hs new file mode 100644 index 000000000..d94a54702 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextEdit.hs @@ -0,0 +1,40 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TextEdit where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Types.Common + +{-| +A text edit applicable to a text document. + +-} +data TextEdit = TextEdit + { {-| + The range of the text document to be manipulated. To insert + text into a document create a range where start === end. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The string to be inserted. For delete operations use an + empty string. + + -} + _newText :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TextEdit where + toJSON (TextEdit arg0 arg1) = Aeson.object $ concat $ [["range" Aeson..= arg0] + ,["newText" Aeson..= arg1]] + +instance Aeson.FromJSON TextEdit where + parseJSON = Aeson.withObject "TextEdit" $ \arg -> TextEdit <$> arg Aeson..: "range" <*> arg Aeson..: "newText" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TokenFormat.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TokenFormat.hs new file mode 100644 index 000000000..f38763f77 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TokenFormat.hs @@ -0,0 +1,34 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TokenFormat where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| + +-} +data TokenFormat = + {-| + + -} + TokenFormat_Relative + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum TokenFormat Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum TokenFormat where + knownValues = Data.Set.fromList [TokenFormat_Relative] + type EnumBaseType TokenFormat = Data.Text.Text + toEnumBaseType TokenFormat_Relative = "relative" + fromEnumBaseType "relative" = pure TokenFormat_Relative + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TraceValues.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TraceValues.hs new file mode 100644 index 000000000..5578c79ce --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TraceValues.hs @@ -0,0 +1,51 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TraceValues where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| + +-} +data TraceValues = + {-| + Turn tracing off. + + -} + TraceValues_Off + | {-| + Trace messages only. + + -} + TraceValues_Messages + | {-| + Verbose message tracing. + + -} + TraceValues_Verbose + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum TraceValues Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum TraceValues where + knownValues = Data.Set.fromList [TraceValues_Off + ,TraceValues_Messages + ,TraceValues_Verbose] + type EnumBaseType TraceValues = Data.Text.Text + toEnumBaseType TraceValues_Off = "off" + toEnumBaseType TraceValues_Messages = "messages" + toEnumBaseType TraceValues_Verbose = "verbose" + fromEnumBaseType "off" = pure TraceValues_Off + fromEnumBaseType "messages" = pure TraceValues_Messages + fromEnumBaseType "verbose" = pure TraceValues_Verbose + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionClientCapabilities.hs new file mode 100644 index 000000000..d3e3e84b3 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionClientCapabilities.hs @@ -0,0 +1,40 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TypeDefinitionClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Since 3.6.0 + +-} +data TypeDefinitionClientCapabilities = TypeDefinitionClientCapabilities + { {-| + Whether implementation supports dynamic registration. If this is set to `true` + the client supports the new `TypeDefinitionRegistrationOptions` return value + for the corresponding server capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + The client supports additional metadata in the form of definition links. + + Since 3.14.0 + + -} + _linkSupport :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TypeDefinitionClientCapabilities where + toJSON (TypeDefinitionClientCapabilities arg0 arg1) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"linkSupport" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON TypeDefinitionClientCapabilities where + parseJSON = Aeson.withObject "TypeDefinitionClientCapabilities" $ \arg -> TypeDefinitionClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "linkSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionOptions.hs new file mode 100644 index 000000000..6e9e41cad --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionOptions.hs @@ -0,0 +1,28 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TypeDefinitionOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data TypeDefinitionOptions = TypeDefinitionOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TypeDefinitionOptions where + toJSON (TypeDefinitionOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON TypeDefinitionOptions where + parseJSON = Aeson.withObject "TypeDefinitionOptions" $ \arg -> TypeDefinitionOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionParams.hs new file mode 100644 index 000000000..e76992fc2 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionParams.hs @@ -0,0 +1,51 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TypeDefinitionParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data TypeDefinitionParams = TypeDefinitionParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TypeDefinitionParams where + toJSON (TypeDefinitionParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON TypeDefinitionParams where + parseJSON = Aeson.withObject "TypeDefinitionParams" $ \arg -> TypeDefinitionParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionRegistrationOptions.hs new file mode 100644 index 000000000..2fd844267 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionRegistrationOptions.hs @@ -0,0 +1,44 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TypeDefinitionRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data TypeDefinitionRegistrationOptions = TypeDefinitionRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TypeDefinitionRegistrationOptions where + toJSON (TypeDefinitionRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"id" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON TypeDefinitionRegistrationOptions where + parseJSON = Aeson.withObject "TypeDefinitionRegistrationOptions" $ \arg -> TypeDefinitionRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyClientCapabilities.hs new file mode 100644 index 000000000..9b1c4fc38 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyClientCapabilities.hs @@ -0,0 +1,32 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TypeHierarchyClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +@since 3.17.0 + +-} +data TypeHierarchyClientCapabilities = TypeHierarchyClientCapabilities + { {-| + Whether implementation supports dynamic registration. If this is set to `true` + the client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)` + return value for the corresponding server capability as well. + + -} + _dynamicRegistration :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TypeHierarchyClientCapabilities where + toJSON (TypeHierarchyClientCapabilities arg0) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON TypeHierarchyClientCapabilities where + parseJSON = Aeson.withObject "TypeHierarchyClientCapabilities" $ \arg -> TypeHierarchyClientCapabilities <$> arg Aeson..:! "dynamicRegistration" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyItem.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyItem.hs new file mode 100644 index 000000000..aad2fa877 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyItem.hs @@ -0,0 +1,84 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TypeHierarchyItem where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Range +import qualified Language.LSP.Protocol.Internal.Types.SymbolKind +import qualified Language.LSP.Protocol.Internal.Types.SymbolTag +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +@since 3.17.0 + +-} +data TypeHierarchyItem = TypeHierarchyItem + { {-| + The name of this item. + + -} + _name :: Data.Text.Text + , {-| + The kind of this item. + + -} + _kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind + , {-| + Tags for this item. + + -} + _tags :: (Maybe [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag]) + , {-| + More detail for this item, e.g. the signature of a function. + + -} + _detail :: (Maybe Data.Text.Text) + , {-| + The resource identifier of this item. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The range enclosing this symbol not including leading/trailing whitespace + but everything else, e.g. comments and code. + + -} + _range :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + The range that should be selected and revealed when this symbol is being + picked, e.g. the name of a function. Must be contained by the + `TypeHierarchyItem.range`. + + -} + _selectionRange :: Language.LSP.Protocol.Internal.Types.Range.Range + , {-| + A data entry field that is preserved between a type hierarchy prepare and + supertypes or subtypes requests. It could also be used to identify the + type hierarchy in the server, helping improve the performance on + resolving supertypes and subtypes. + + -} + _data_ :: (Maybe Data.Aeson.Value) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TypeHierarchyItem where + toJSON (TypeHierarchyItem arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7) = Aeson.object $ concat $ [["name" Aeson..= arg0] + ,["kind" Aeson..= arg1] + ,"tags" Language.LSP.Protocol.Types.Common..=? arg2 + ,"detail" Language.LSP.Protocol.Types.Common..=? arg3 + ,["uri" Aeson..= arg4] + ,["range" Aeson..= arg5] + ,["selectionRange" Aeson..= arg6] + ,"data" Language.LSP.Protocol.Types.Common..=? arg7] + +instance Aeson.FromJSON TypeHierarchyItem where + parseJSON = Aeson.withObject "TypeHierarchyItem" $ \arg -> TypeHierarchyItem <$> arg Aeson..: "name" <*> arg Aeson..: "kind" <*> arg Aeson..:! "tags" <*> arg Aeson..:! "detail" <*> arg Aeson..: "uri" <*> arg Aeson..: "range" <*> arg Aeson..: "selectionRange" <*> arg Aeson..:! "data" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyOptions.hs new file mode 100644 index 000000000..ea3d56f4a --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyOptions.hs @@ -0,0 +1,31 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TypeHierarchyOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Type hierarchy options used during static registration. + +@since 3.17.0 + +-} +data TypeHierarchyOptions = TypeHierarchyOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TypeHierarchyOptions where + toJSON (TypeHierarchyOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON TypeHierarchyOptions where + parseJSON = Aeson.withObject "TypeHierarchyOptions" $ \arg -> TypeHierarchyOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyPrepareParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyPrepareParams.hs new file mode 100644 index 000000000..7ae0d3db2 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyPrepareParams.hs @@ -0,0 +1,47 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TypeHierarchyPrepareParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Position +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameter of a `textDocument/prepareTypeHierarchy` request. + +@since 3.17.0 + +-} +data TypeHierarchyPrepareParams = TypeHierarchyPrepareParams + { {-| + The text document. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The position inside the text document. + + -} + _position :: Language.LSP.Protocol.Internal.Types.Position.Position + , {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TypeHierarchyPrepareParams where + toJSON (TypeHierarchyPrepareParams arg0 arg1 arg2) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["position" Aeson..= arg1] + ,"workDoneToken" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON TypeHierarchyPrepareParams where + parseJSON = Aeson.withObject "TypeHierarchyPrepareParams" $ \arg -> TypeHierarchyPrepareParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "position" <*> arg Aeson..:! "workDoneToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyRegistrationOptions.hs new file mode 100644 index 000000000..e6d15ff5e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyRegistrationOptions.hs @@ -0,0 +1,47 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TypeHierarchyRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.DocumentSelector +import qualified Language.LSP.Protocol.Types.Common + +{-| +Type hierarchy options used during static or dynamic registration. + +@since 3.17.0 + +-} +data TypeHierarchyRegistrationOptions = TypeHierarchyRegistrationOptions + { {-| + 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 :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The id used to register the request. The id can be used to deregister + the request again. See also Registration#id. + + -} + _id :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TypeHierarchyRegistrationOptions where + toJSON (TypeHierarchyRegistrationOptions arg0 arg1 arg2) = Aeson.object $ concat $ [["documentSelector" Aeson..= arg0] + ,"workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg1 + ,"id" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON TypeHierarchyRegistrationOptions where + parseJSON = Aeson.withObject "TypeHierarchyRegistrationOptions" $ \arg -> TypeHierarchyRegistrationOptions <$> arg Aeson..: "documentSelector" <*> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "id" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySubtypesParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySubtypesParams.hs new file mode 100644 index 000000000..434ebe84f --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySubtypesParams.hs @@ -0,0 +1,46 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TypeHierarchySubtypesParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyItem +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameter of a `typeHierarchy/subtypes` request. + +@since 3.17.0 + +-} +data TypeHierarchySubtypesParams = TypeHierarchySubtypesParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + + -} + _item :: Language.LSP.Protocol.Internal.Types.TypeHierarchyItem.TypeHierarchyItem + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TypeHierarchySubtypesParams where + toJSON (TypeHierarchySubtypesParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["item" Aeson..= arg2]] + +instance Aeson.FromJSON TypeHierarchySubtypesParams where + parseJSON = Aeson.withObject "TypeHierarchySubtypesParams" $ \arg -> TypeHierarchySubtypesParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "item" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySupertypesParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySupertypesParams.hs new file mode 100644 index 000000000..648da6c37 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySupertypesParams.hs @@ -0,0 +1,46 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.TypeHierarchySupertypesParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TypeHierarchyItem +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameter of a `typeHierarchy/supertypes` request. + +@since 3.17.0 + +-} +data TypeHierarchySupertypesParams = TypeHierarchySupertypesParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + + -} + _item :: Language.LSP.Protocol.Internal.Types.TypeHierarchyItem.TypeHierarchyItem + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON TypeHierarchySupertypesParams where + toJSON (TypeHierarchySupertypesParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["item" Aeson..= arg2]] + +instance Aeson.FromJSON TypeHierarchySupertypesParams where + parseJSON = Aeson.withObject "TypeHierarchySupertypesParams" $ \arg -> TypeHierarchySupertypesParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "item" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UInitializeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UInitializeParams.hs new file mode 100644 index 000000000..04346f62e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UInitializeParams.hs @@ -0,0 +1,107 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.UInitializeParams where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.ClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Internal.Types.TraceValues +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-# DEPRECATED _rootPath "in favour of rootUri." #-} +{-# DEPRECATED _rootUri "in favour of workspaceFolders." #-} +{-| +The initialize parameters + +-} +data UInitializeParams = UInitializeParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + 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. + + -} + _processId :: (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + Information about the client + + @since 3.15.0 + + -} + _clientInfo :: (Maybe (Row.Rec ("name" Row..== Data.Text.Text Row..+ ("version" Row..== (Maybe Data.Text.Text) Row..+ Row.Empty)))) + , {-| + The locale the client is currently showing the user interface + in. This must not necessarily be the locale of the operating + system. + + Uses IETF language tags as the value's syntax + (See https://en.wikipedia.org/wiki/IETF_language_tag) + + @since 3.16.0 + + -} + _locale :: (Maybe Data.Text.Text) + , {-| + The rootPath of the workspace. Is null + if no folder is open. + + @deprecated in favour of rootUri. + + -} + _rootPath :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + , {-| + The rootUri of the workspace. Is null if no + folder is open. If both `rootPath` and `rootUri` are set + `rootUri` wins. + + @deprecated in favour of workspaceFolders. + + -} + _rootUri :: (Language.LSP.Protocol.Types.Uri.Uri Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + , {-| + The capabilities provided by the client (editor or tool) + + -} + _capabilities :: Language.LSP.Protocol.Internal.Types.ClientCapabilities.ClientCapabilities + , {-| + User provided initialization options. + + -} + _initializationOptions :: (Maybe Data.Aeson.Value) + , {-| + The initial trace setting. If omitted trace is disabled ('off'). + + -} + _trace :: (Maybe Language.LSP.Protocol.Internal.Types.TraceValues.TraceValues) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON UInitializeParams where + toJSON (UInitializeParams arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,["processId" Aeson..= arg1] + ,"clientInfo" Language.LSP.Protocol.Types.Common..=? arg2 + ,"locale" Language.LSP.Protocol.Types.Common..=? arg3 + ,"rootPath" Language.LSP.Protocol.Types.Common..=? arg4 + ,["rootUri" Aeson..= arg5] + ,["capabilities" Aeson..= arg6] + ,"initializationOptions" Language.LSP.Protocol.Types.Common..=? arg7 + ,"trace" Language.LSP.Protocol.Types.Common..=? arg8] + +instance Aeson.FromJSON UInitializeParams where + parseJSON = Aeson.withObject "_InitializeParams" $ \arg -> UInitializeParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..: "processId" <*> arg Aeson..:! "clientInfo" <*> arg Aeson..:! "locale" <*> arg Aeson..:! "rootPath" <*> arg Aeson..: "rootUri" <*> arg Aeson..: "capabilities" <*> arg Aeson..:! "initializationOptions" <*> arg Aeson..:! "trace" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnchangedDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnchangedDocumentDiagnosticReport.hs new file mode 100644 index 000000000..430769d53 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnchangedDocumentDiagnosticReport.hs @@ -0,0 +1,45 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.UnchangedDocumentDiagnosticReport where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Singletons + +{-| +A diagnostic report indicating that the last returned +report is still accurate. + +@since 3.17.0 + +-} +data UnchangedDocumentDiagnosticReport = UnchangedDocumentDiagnosticReport + { {-| + A document diagnostic report indicating + no changes to the last result. A server can + only return `unchanged` if result ids are + provided. + + -} + _kind :: (Language.LSP.Protocol.Types.Singletons.AString "unchanged") + , {-| + A result id which will be sent on the next + diagnostic request for the same document. + + -} + _resultId :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON UnchangedDocumentDiagnosticReport where + toJSON (UnchangedDocumentDiagnosticReport arg0 arg1) = Aeson.object $ concat $ [["kind" Aeson..= arg0] + ,["resultId" Aeson..= arg1]] + +instance Aeson.FromJSON UnchangedDocumentDiagnosticReport where + parseJSON = Aeson.withObject "UnchangedDocumentDiagnosticReport" $ \arg -> UnchangedDocumentDiagnosticReport <$> arg Aeson..: "kind" <*> arg Aeson..: "resultId" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UniquenessLevel.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UniquenessLevel.hs new file mode 100644 index 000000000..db3506b34 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UniquenessLevel.hs @@ -0,0 +1,70 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.UniquenessLevel where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| +Moniker uniqueness level to define scope of the moniker. + +@since 3.16.0 + +-} +data UniquenessLevel = + {-| + The moniker is only unique inside a document + + -} + UniquenessLevel_Document + | {-| + The moniker is unique inside a project for which a dump got created + + -} + UniquenessLevel_Project + | {-| + The moniker is unique inside the group to which a project belongs + + -} + UniquenessLevel_Group + | {-| + The moniker is unique inside the moniker scheme. + + -} + UniquenessLevel_Scheme + | {-| + The moniker is globally unique + + -} + UniquenessLevel_Global + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum UniquenessLevel Data.Text.Text) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum UniquenessLevel where + knownValues = Data.Set.fromList [UniquenessLevel_Document + ,UniquenessLevel_Project + ,UniquenessLevel_Group + ,UniquenessLevel_Scheme + ,UniquenessLevel_Global] + type EnumBaseType UniquenessLevel = Data.Text.Text + toEnumBaseType UniquenessLevel_Document = "document" + toEnumBaseType UniquenessLevel_Project = "project" + toEnumBaseType UniquenessLevel_Group = "group" + toEnumBaseType UniquenessLevel_Scheme = "scheme" + toEnumBaseType UniquenessLevel_Global = "global" + fromEnumBaseType "document" = pure UniquenessLevel_Document + fromEnumBaseType "project" = pure UniquenessLevel_Project + fromEnumBaseType "group" = pure UniquenessLevel_Group + fromEnumBaseType "scheme" = pure UniquenessLevel_Scheme + fromEnumBaseType "global" = pure UniquenessLevel_Global + fromEnumBaseType _ = Nothing + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Unregistration.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Unregistration.hs new file mode 100644 index 000000000..ffb4712f0 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Unregistration.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.Unregistration where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| +General parameters to unregister a request or notification. + +-} +data Unregistration = Unregistration + { {-| + The id used to unregister the request or notification. Usually an id + provided during the register request. + + -} + _id :: Data.Text.Text + , {-| + The method to unregister for. + + -} + _method :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON Unregistration where + toJSON (Unregistration arg0 arg1) = Aeson.object $ concat $ [["id" Aeson..= arg0] + ,["method" Aeson..= arg1]] + +instance Aeson.FromJSON Unregistration where + parseJSON = Aeson.withObject "Unregistration" $ \arg -> Unregistration <$> arg Aeson..: "id" <*> arg Aeson..: "method" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnregistrationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnregistrationParams.hs new file mode 100644 index 000000000..3e81114db --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnregistrationParams.hs @@ -0,0 +1,29 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.UnregistrationParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.Unregistration +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data UnregistrationParams = UnregistrationParams + { {-| + + -} + _unregisterations :: [Language.LSP.Protocol.Internal.Types.Unregistration.Unregistration] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON UnregistrationParams where + toJSON (UnregistrationParams arg0) = Aeson.object $ concat $ [["unregisterations" Aeson..= arg0]] + +instance Aeson.FromJSON UnregistrationParams where + parseJSON = Aeson.withObject "UnregistrationParams" $ \arg -> UnregistrationParams <$> arg Aeson..: "unregisterations" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedNotebookDocumentIdentifier.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedNotebookDocumentIdentifier.hs new file mode 100644 index 000000000..faf4832c4 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedNotebookDocumentIdentifier.hs @@ -0,0 +1,39 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.VersionedNotebookDocumentIdentifier where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A versioned notebook document identifier. + +@since 3.17.0 + +-} +data VersionedNotebookDocumentIdentifier = VersionedNotebookDocumentIdentifier + { {-| + The version number of this notebook document. + + -} + _version :: Language.LSP.Protocol.Types.Common.Int32 + , {-| + The notebook document's uri. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON VersionedNotebookDocumentIdentifier where + toJSON (VersionedNotebookDocumentIdentifier arg0 arg1) = Aeson.object $ concat $ [["version" Aeson..= arg0] + ,["uri" Aeson..= arg1]] + +instance Aeson.FromJSON VersionedNotebookDocumentIdentifier where + parseJSON = Aeson.withObject "VersionedNotebookDocumentIdentifier" $ \arg -> VersionedNotebookDocumentIdentifier <$> arg Aeson..: "version" <*> arg Aeson..: "uri" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedTextDocumentIdentifier.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedTextDocumentIdentifier.hs new file mode 100644 index 000000000..285cb6c2f --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedTextDocumentIdentifier.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A text document identifier to denote a specific version of a text document. + +-} +data VersionedTextDocumentIdentifier = VersionedTextDocumentIdentifier + { {-| + The text document's uri. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The version number of this document. + + -} + _version :: Language.LSP.Protocol.Types.Common.Int32 + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON VersionedTextDocumentIdentifier where + toJSON (VersionedTextDocumentIdentifier arg0 arg1) = Aeson.object $ concat $ [["uri" Aeson..= arg0] + ,["version" Aeson..= arg1]] + +instance Aeson.FromJSON VersionedTextDocumentIdentifier where + parseJSON = Aeson.withObject "VersionedTextDocumentIdentifier" $ \arg -> VersionedTextDocumentIdentifier <$> arg Aeson..: "uri" <*> arg Aeson..: "version" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WatchKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WatchKind.hs new file mode 100644 index 000000000..2fbb56c30 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WatchKind.hs @@ -0,0 +1,55 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WatchKind where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Set +import qualified Data.String +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.LspEnum + +{-| + +-} +data WatchKind = + {-| + Interested in create events. + + -} + WatchKind_Create + | {-| + Interested in change events + + -} + WatchKind_Change + | {-| + Interested in delete events + + -} + WatchKind_Delete + | WatchKind_Custom Language.LSP.Protocol.Types.Common.UInt + deriving stock (Show, Eq, Ord, Generic) + deriving ( Aeson.ToJSON + , Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum WatchKind Language.LSP.Protocol.Types.Common.UInt) + +instance Language.LSP.Protocol.Types.LspEnum.LspEnum WatchKind where + knownValues = Data.Set.fromList [WatchKind_Create + ,WatchKind_Change + ,WatchKind_Delete] + type EnumBaseType WatchKind = Language.LSP.Protocol.Types.Common.UInt + toEnumBaseType WatchKind_Create = 1 + toEnumBaseType WatchKind_Change = 2 + toEnumBaseType WatchKind_Delete = 4 + toEnumBaseType (WatchKind_Custom arg) = arg + +instance Language.LSP.Protocol.Types.LspEnum.LspOpenEnum WatchKind where + fromOpenEnumBaseType 1 = WatchKind_Create + fromOpenEnumBaseType 2 = WatchKind_Change + fromOpenEnumBaseType 4 = WatchKind_Delete + fromOpenEnumBaseType arg = WatchKind_Custom arg + diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WillSaveTextDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WillSaveTextDocumentParams.hs new file mode 100644 index 000000000..d3bfbc9cf --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WillSaveTextDocumentParams.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WillSaveTextDocumentParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentSaveReason +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters sent in a will save text document notification. + +-} +data WillSaveTextDocumentParams = WillSaveTextDocumentParams + { {-| + The document that will be saved. + + -} + _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + , {-| + The 'TextDocumentSaveReason'. + + -} + _reason :: Language.LSP.Protocol.Internal.Types.TextDocumentSaveReason.TextDocumentSaveReason + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WillSaveTextDocumentParams where + toJSON (WillSaveTextDocumentParams arg0 arg1) = Aeson.object $ concat $ [["textDocument" Aeson..= arg0] + ,["reason" Aeson..= arg1]] + +instance Aeson.FromJSON WillSaveTextDocumentParams where + parseJSON = Aeson.withObject "WillSaveTextDocumentParams" $ \arg -> WillSaveTextDocumentParams <$> arg Aeson..: "textDocument" <*> arg Aeson..: "reason" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WindowClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WindowClientCapabilities.hs new file mode 100644 index 000000000..5fdfc9b97 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WindowClientCapabilities.hs @@ -0,0 +1,55 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WindowClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ShowDocumentClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.ShowMessageRequestClientCapabilities +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data WindowClientCapabilities = WindowClientCapabilities + { {-| + It indicates whether the client supports server initiated + progress using the `window/workDoneProgress/create` request. + + The capability also controls Whether client supports handling + of progress notifications. If set servers are allowed to report a + `workDoneProgress` property in the request specific server + capabilities. + + @since 3.15.0 + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + Capabilities specific to the showMessage request. + + @since 3.16.0 + + -} + _showMessage :: (Maybe Language.LSP.Protocol.Internal.Types.ShowMessageRequestClientCapabilities.ShowMessageRequestClientCapabilities) + , {-| + Capabilities specific to the showDocument request. + + @since 3.16.0 + + -} + _showDocument :: (Maybe Language.LSP.Protocol.Internal.Types.ShowDocumentClientCapabilities.ShowDocumentClientCapabilities) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WindowClientCapabilities where + toJSON (WindowClientCapabilities arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"showMessage" Language.LSP.Protocol.Types.Common..=? arg1 + ,"showDocument" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON WindowClientCapabilities where + parseJSON = Aeson.withObject "WindowClientCapabilities" $ \arg -> WindowClientCapabilities <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "showMessage" <*> arg Aeson..:! "showDocument" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressBegin.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressBegin.hs new file mode 100644 index 000000000..10bf7970d --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressBegin.hs @@ -0,0 +1,68 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkDoneProgressBegin where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Singletons + +{-| + +-} +data WorkDoneProgressBegin = WorkDoneProgressBegin + { {-| + + -} + _kind :: (Language.LSP.Protocol.Types.Singletons.AString "begin") + , {-| + Mandatory title of the progress operation. Used to briefly inform about + the kind of operation being performed. + + Examples: "Indexing" or "Linking dependencies". + + -} + _title :: Data.Text.Text + , {-| + Controls if a cancel button should show to allow the user to cancel the + long running operation. Clients that don't support cancellation are allowed + to ignore the setting. + + -} + _cancellable :: (Maybe Bool) + , {-| + Optional, more detailed associated progress message. Contains + complementary information to the `title`. + + Examples: "3/25 files", "project/src/module2", "node_modules/some_dep". + If unset, the previous progress message (if any) is still valid. + + -} + _message :: (Maybe Data.Text.Text) + , {-| + Optional progress percentage to display (value 100 is considered 100%). + If not provided infinite progress is assumed and clients are allowed + to ignore the `percentage` value in subsequent in report notifications. + + The value should be steadily rising. Clients are free to ignore values + that are not following this rule. The value range is [0, 100]. + + -} + _percentage :: (Maybe Language.LSP.Protocol.Types.Common.UInt) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkDoneProgressBegin where + toJSON (WorkDoneProgressBegin arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ [["kind" Aeson..= arg0] + ,["title" Aeson..= arg1] + ,"cancellable" Language.LSP.Protocol.Types.Common..=? arg2 + ,"message" Language.LSP.Protocol.Types.Common..=? arg3 + ,"percentage" Language.LSP.Protocol.Types.Common..=? arg4] + +instance Aeson.FromJSON WorkDoneProgressBegin where + parseJSON = Aeson.withObject "WorkDoneProgressBegin" $ \arg -> WorkDoneProgressBegin <$> arg Aeson..: "kind" <*> arg Aeson..: "title" <*> arg Aeson..:! "cancellable" <*> arg Aeson..:! "message" <*> arg Aeson..:! "percentage" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCancelParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCancelParams.hs new file mode 100644 index 000000000..9baba3c4b --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCancelParams.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkDoneProgressCancelParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data WorkDoneProgressCancelParams = WorkDoneProgressCancelParams + { {-| + The token to be used to report progress. + + -} + _token :: Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkDoneProgressCancelParams where + toJSON (WorkDoneProgressCancelParams arg0) = Aeson.object $ concat $ [["token" Aeson..= arg0]] + +instance Aeson.FromJSON WorkDoneProgressCancelParams where + parseJSON = Aeson.withObject "WorkDoneProgressCancelParams" $ \arg -> WorkDoneProgressCancelParams <$> arg Aeson..: "token" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCreateParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCreateParams.hs new file mode 100644 index 000000000..bd2a6e21e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCreateParams.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkDoneProgressCreateParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data WorkDoneProgressCreateParams = WorkDoneProgressCreateParams + { {-| + The token to be used to report progress. + + -} + _token :: Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkDoneProgressCreateParams where + toJSON (WorkDoneProgressCreateParams arg0) = Aeson.object $ concat $ [["token" Aeson..= arg0]] + +instance Aeson.FromJSON WorkDoneProgressCreateParams where + parseJSON = Aeson.withObject "WorkDoneProgressCreateParams" $ \arg -> WorkDoneProgressCreateParams <$> arg Aeson..: "token" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressEnd.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressEnd.hs new file mode 100644 index 000000000..ca6c2120d --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressEnd.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkDoneProgressEnd where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Singletons + +{-| + +-} +data WorkDoneProgressEnd = WorkDoneProgressEnd + { {-| + + -} + _kind :: (Language.LSP.Protocol.Types.Singletons.AString "end") + , {-| + Optional, a final message indicating to for example indicate the outcome + of the operation. + + -} + _message :: (Maybe Data.Text.Text) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkDoneProgressEnd where + toJSON (WorkDoneProgressEnd arg0 arg1) = Aeson.object $ concat $ [["kind" Aeson..= arg0] + ,"message" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON WorkDoneProgressEnd where + parseJSON = Aeson.withObject "WorkDoneProgressEnd" $ \arg -> WorkDoneProgressEnd <$> arg Aeson..: "kind" <*> arg Aeson..:! "message" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressOptions.hs new file mode 100644 index 000000000..87b20dbd7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressOptions.hs @@ -0,0 +1,28 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkDoneProgressOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data WorkDoneProgressOptions = WorkDoneProgressOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkDoneProgressOptions where + toJSON (WorkDoneProgressOptions arg0) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON WorkDoneProgressOptions where + parseJSON = Aeson.withObject "WorkDoneProgressOptions" $ \arg -> WorkDoneProgressOptions <$> arg Aeson..:! "workDoneProgress" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressParams.hs new file mode 100644 index 000000000..ddb3bce88 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressParams.hs @@ -0,0 +1,30 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkDoneProgressParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data WorkDoneProgressParams = WorkDoneProgressParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkDoneProgressParams where + toJSON (WorkDoneProgressParams arg0) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON WorkDoneProgressParams where + parseJSON = Aeson.withObject "WorkDoneProgressParams" $ \arg -> WorkDoneProgressParams <$> arg Aeson..:! "workDoneToken" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressReport.hs new file mode 100644 index 000000000..736341dee --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressReport.hs @@ -0,0 +1,60 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkDoneProgressReport where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Singletons + +{-| + +-} +data WorkDoneProgressReport = WorkDoneProgressReport + { {-| + + -} + _kind :: (Language.LSP.Protocol.Types.Singletons.AString "report") + , {-| + Controls enablement state of a cancel button. + + Clients that don't support cancellation or don't support controlling the button's + enablement state are allowed to ignore the property. + + -} + _cancellable :: (Maybe Bool) + , {-| + Optional, more detailed associated progress message. Contains + complementary information to the `title`. + + Examples: "3/25 files", "project/src/module2", "node_modules/some_dep". + If unset, the previous progress message (if any) is still valid. + + -} + _message :: (Maybe Data.Text.Text) + , {-| + Optional progress percentage to display (value 100 is considered 100%). + If not provided infinite progress is assumed and clients are allowed + to ignore the `percentage` value in subsequent in report notifications. + + The value should be steadily rising. Clients are free to ignore values + that are not following this rule. The value range is [0, 100] + + -} + _percentage :: (Maybe Language.LSP.Protocol.Types.Common.UInt) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkDoneProgressReport where + toJSON (WorkDoneProgressReport arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["kind" Aeson..= arg0] + ,"cancellable" Language.LSP.Protocol.Types.Common..=? arg1 + ,"message" Language.LSP.Protocol.Types.Common..=? arg2 + ,"percentage" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON WorkDoneProgressReport where + parseJSON = Aeson.withObject "WorkDoneProgressReport" $ \arg -> WorkDoneProgressReport <$> arg Aeson..: "kind" <*> arg Aeson..:! "cancellable" <*> arg Aeson..:! "message" <*> arg Aeson..:! "percentage" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceClientCapabilities.hs new file mode 100644 index 000000000..32add5c1e --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceClientCapabilities.hs @@ -0,0 +1,142 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.CodeLensWorkspaceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DiagnosticWorkspaceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DidChangeConfigurationClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.ExecuteCommandClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.FileOperationClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.InlayHintWorkspaceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.InlineValueWorkspaceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.SemanticTokensWorkspaceClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceEditClientCapabilities +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceSymbolClientCapabilities +import qualified Language.LSP.Protocol.Types.Common + +{-| +Workspace specific client capabilities. + +-} +data WorkspaceClientCapabilities = WorkspaceClientCapabilities + { {-| + 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 Language.LSP.Protocol.Internal.Types.WorkspaceEditClientCapabilities.WorkspaceEditClientCapabilities) + , {-| + Capabilities specific to the `workspace/didChangeConfiguration` notification. + + -} + _didChangeConfiguration :: (Maybe Language.LSP.Protocol.Internal.Types.DidChangeConfigurationClientCapabilities.DidChangeConfigurationClientCapabilities) + , {-| + Capabilities specific to the `workspace/didChangeWatchedFiles` notification. + + -} + _didChangeWatchedFiles :: (Maybe Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesClientCapabilities.DidChangeWatchedFilesClientCapabilities) + , {-| + Capabilities specific to the `workspace/symbol` request. + + -} + _symbol :: (Maybe Language.LSP.Protocol.Internal.Types.WorkspaceSymbolClientCapabilities.WorkspaceSymbolClientCapabilities) + , {-| + Capabilities specific to the `workspace/executeCommand` request. + + -} + _executeCommand :: (Maybe Language.LSP.Protocol.Internal.Types.ExecuteCommandClientCapabilities.ExecuteCommandClientCapabilities) + , {-| + The client has support for workspace folders. + + @since 3.6.0 + + -} + _workspaceFolders :: (Maybe Bool) + , {-| + The client supports `workspace/configuration` requests. + + @since 3.6.0 + + -} + _configuration :: (Maybe Bool) + , {-| + Capabilities specific to the semantic token requests scoped to the + workspace. + + @since 3.16.0. + + -} + _semanticTokens :: (Maybe Language.LSP.Protocol.Internal.Types.SemanticTokensWorkspaceClientCapabilities.SemanticTokensWorkspaceClientCapabilities) + , {-| + Capabilities specific to the code lens requests scoped to the + workspace. + + @since 3.16.0. + + -} + _codeLens :: (Maybe Language.LSP.Protocol.Internal.Types.CodeLensWorkspaceClientCapabilities.CodeLensWorkspaceClientCapabilities) + , {-| + The client has support for file notifications/requests for user operations on files. + + Since 3.16.0 + + -} + _fileOperations :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationClientCapabilities.FileOperationClientCapabilities) + , {-| + Capabilities specific to the inline values requests scoped to the + workspace. + + @since 3.17.0. + + -} + _inlineValue :: (Maybe Language.LSP.Protocol.Internal.Types.InlineValueWorkspaceClientCapabilities.InlineValueWorkspaceClientCapabilities) + , {-| + Capabilities specific to the inlay hint requests scoped to the + workspace. + + @since 3.17.0. + + -} + _inlayHint :: (Maybe Language.LSP.Protocol.Internal.Types.InlayHintWorkspaceClientCapabilities.InlayHintWorkspaceClientCapabilities) + , {-| + Capabilities specific to the diagnostic requests scoped to the + workspace. + + @since 3.17.0. + + -} + _diagnostics :: (Maybe Language.LSP.Protocol.Internal.Types.DiagnosticWorkspaceClientCapabilities.DiagnosticWorkspaceClientCapabilities) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceClientCapabilities where + toJSON (WorkspaceClientCapabilities arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13) = Aeson.object $ concat $ ["applyEdit" Language.LSP.Protocol.Types.Common..=? arg0 + ,"workspaceEdit" Language.LSP.Protocol.Types.Common..=? arg1 + ,"didChangeConfiguration" Language.LSP.Protocol.Types.Common..=? arg2 + ,"didChangeWatchedFiles" Language.LSP.Protocol.Types.Common..=? arg3 + ,"symbol" Language.LSP.Protocol.Types.Common..=? arg4 + ,"executeCommand" Language.LSP.Protocol.Types.Common..=? arg5 + ,"workspaceFolders" Language.LSP.Protocol.Types.Common..=? arg6 + ,"configuration" Language.LSP.Protocol.Types.Common..=? arg7 + ,"semanticTokens" Language.LSP.Protocol.Types.Common..=? arg8 + ,"codeLens" Language.LSP.Protocol.Types.Common..=? arg9 + ,"fileOperations" Language.LSP.Protocol.Types.Common..=? arg10 + ,"inlineValue" Language.LSP.Protocol.Types.Common..=? arg11 + ,"inlayHint" Language.LSP.Protocol.Types.Common..=? arg12 + ,"diagnostics" Language.LSP.Protocol.Types.Common..=? arg13] + +instance Aeson.FromJSON WorkspaceClientCapabilities where + parseJSON = Aeson.withObject "WorkspaceClientCapabilities" $ \arg -> WorkspaceClientCapabilities <$> arg Aeson..:! "applyEdit" <*> arg Aeson..:! "workspaceEdit" <*> arg Aeson..:! "didChangeConfiguration" <*> arg Aeson..:! "didChangeWatchedFiles" <*> arg Aeson..:! "symbol" <*> arg Aeson..:! "executeCommand" <*> arg Aeson..:! "workspaceFolders" <*> arg Aeson..:! "configuration" <*> arg Aeson..:! "semanticTokens" <*> arg Aeson..:! "codeLens" <*> arg Aeson..:! "fileOperations" <*> arg Aeson..:! "inlineValue" <*> arg Aeson..:! "inlayHint" <*> arg Aeson..:! "diagnostics" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticParams.hs new file mode 100644 index 000000000..c26a7376c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticParams.hs @@ -0,0 +1,55 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.PreviousResultId +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Types.Common + +{-| +Parameters of the workspace diagnostic request. + +@since 3.17.0 + +-} +data WorkspaceDiagnosticParams = WorkspaceDiagnosticParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + The additional identifier provided during registration. + + -} + _identifier :: (Maybe Data.Text.Text) + , {-| + The currently known diagnostic reports with their + previous result ids. + + -} + _previousResultIds :: [Language.LSP.Protocol.Internal.Types.PreviousResultId.PreviousResultId] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceDiagnosticParams where + toJSON (WorkspaceDiagnosticParams arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,"identifier" Language.LSP.Protocol.Types.Common..=? arg2 + ,["previousResultIds" Aeson..= arg3]] + +instance Aeson.FromJSON WorkspaceDiagnosticParams where + parseJSON = Aeson.withObject "WorkspaceDiagnosticParams" $ \arg -> WorkspaceDiagnosticParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..:! "identifier" <*> arg Aeson..: "previousResultIds" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReport.hs new file mode 100644 index 000000000..51a84bccd --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReport.hs @@ -0,0 +1,32 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticReport where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Types.Common + +{-| +A workspace diagnostic report. + +@since 3.17.0 + +-} +data WorkspaceDiagnosticReport = WorkspaceDiagnosticReport + { {-| + + -} + _items :: [Language.LSP.Protocol.Internal.Types.WorkspaceDocumentDiagnosticReport.WorkspaceDocumentDiagnosticReport] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceDiagnosticReport where + toJSON (WorkspaceDiagnosticReport arg0) = Aeson.object $ concat $ [["items" Aeson..= arg0]] + +instance Aeson.FromJSON WorkspaceDiagnosticReport where + parseJSON = Aeson.withObject "WorkspaceDiagnosticReport" $ \arg -> WorkspaceDiagnosticReport <$> arg Aeson..: "items" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReportPartialResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReportPartialResult.hs new file mode 100644 index 000000000..05896ace6 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReportPartialResult.hs @@ -0,0 +1,32 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticReportPartialResult where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Types.Common + +{-| +A partial result for a workspace diagnostic report. + +@since 3.17.0 + +-} +data WorkspaceDiagnosticReportPartialResult = WorkspaceDiagnosticReportPartialResult + { {-| + + -} + _items :: [Language.LSP.Protocol.Internal.Types.WorkspaceDocumentDiagnosticReport.WorkspaceDocumentDiagnosticReport] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceDiagnosticReportPartialResult where + toJSON (WorkspaceDiagnosticReportPartialResult arg0) = Aeson.object $ concat $ [["items" Aeson..= arg0]] + +instance Aeson.FromJSON WorkspaceDiagnosticReportPartialResult where + parseJSON = Aeson.withObject "WorkspaceDiagnosticReportPartialResult" $ \arg -> WorkspaceDiagnosticReportPartialResult <$> arg Aeson..: "items" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDocumentDiagnosticReport.hs new file mode 100644 index 000000000..82dcb3a3c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDocumentDiagnosticReport.hs @@ -0,0 +1,23 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceDocumentDiagnosticReport where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFullDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceUnchangedDocumentDiagnosticReport +import qualified Language.LSP.Protocol.Types.Common + +{-| +A workspace diagnostic document report. + +@since 3.17.0 + +-} +newtype WorkspaceDocumentDiagnosticReport = WorkspaceDocumentDiagnosticReport (Language.LSP.Protocol.Internal.Types.WorkspaceFullDocumentDiagnosticReport.WorkspaceFullDocumentDiagnosticReport Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.WorkspaceUnchangedDocumentDiagnosticReport.WorkspaceUnchangedDocumentDiagnosticReport) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Aeson.ToJSON, Aeson.FromJSON) \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEdit.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEdit.hs new file mode 100644 index 000000000..7d6fdb7c7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEdit.hs @@ -0,0 +1,76 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceEdit where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Map +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.ChangeAnnotation +import qualified Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier +import qualified Language.LSP.Protocol.Internal.Types.CreateFile +import qualified Language.LSP.Protocol.Internal.Types.DeleteFile +import qualified Language.LSP.Protocol.Internal.Types.RenameFile +import qualified Language.LSP.Protocol.Internal.Types.TextDocumentEdit +import qualified Language.LSP.Protocol.Internal.Types.TextEdit +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +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. + +Since version 3.13.0 a workspace edit can contain resource operations as well. If resource +operations are present clients need to execute the operations in the order in which they +are provided. So a workspace edit for example can consist of the following two changes: +(1) a create file a.txt and (2) a text document edit which insert text into file a.txt. + +An invalid sequence (e.g. (1) delete file a.txt and (2) insert text into file a.txt) will +cause failure of the operation. How the client recovers from the failure is described by +the client capability: `workspace.workspaceEdit.failureHandling` + +-} +data WorkspaceEdit = WorkspaceEdit + { {-| + Holds changes to existing resources. + + -} + _changes :: (Maybe (Data.Map.Map Language.LSP.Protocol.Types.Uri.Uri [Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit])) + , {-| + Depending on the client capability `workspace.workspaceEdit.resourceOperations` document changes + are either an array of `TextDocumentEdit`s to express changes to n different text documents + where each text document edit addresses a specific version of a text document. Or it can contain + above `TextDocumentEdit`s mixed with create, rename and delete file / folder operations. + + Whether a client supports versioned document edits is expressed via + `workspace.workspaceEdit.documentChanges` client capability. + + If a client neither supports `documentChanges` nor `workspace.workspaceEdit.resourceOperations` then + only plain `TextEdit`s using the `changes` property are supported. + + -} + _documentChanges :: (Maybe [(Language.LSP.Protocol.Internal.Types.TextDocumentEdit.TextDocumentEdit Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.CreateFile.CreateFile Language.LSP.Protocol.Types.Common.|? (Language.LSP.Protocol.Internal.Types.RenameFile.RenameFile Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.DeleteFile.DeleteFile)))]) + , {-| + A map of change annotations that can be referenced in `AnnotatedTextEdit`s or create, rename and + delete file / folder operations. + + Whether clients honor this property depends on the client capability `workspace.changeAnnotationSupport`. + + @since 3.16.0 + + -} + _changeAnnotations :: (Maybe (Data.Map.Map Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier Language.LSP.Protocol.Internal.Types.ChangeAnnotation.ChangeAnnotation)) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceEdit where + toJSON (WorkspaceEdit arg0 arg1 arg2) = Aeson.object $ concat $ ["changes" Language.LSP.Protocol.Types.Common..=? arg0 + ,"documentChanges" Language.LSP.Protocol.Types.Common..=? arg1 + ,"changeAnnotations" Language.LSP.Protocol.Types.Common..=? arg2] + +instance Aeson.FromJSON WorkspaceEdit where + parseJSON = Aeson.withObject "WorkspaceEdit" $ \arg -> WorkspaceEdit <$> arg Aeson..:! "changes" <*> arg Aeson..:! "documentChanges" <*> arg Aeson..:! "changeAnnotations" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEditClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEditClientCapabilities.hs new file mode 100644 index 000000000..a6a8abd30 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEditClientCapabilities.hs @@ -0,0 +1,71 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceEditClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.FailureHandlingKind +import qualified Language.LSP.Protocol.Internal.Types.ResourceOperationKind +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data WorkspaceEditClientCapabilities = WorkspaceEditClientCapabilities + { {-| + The client supports versioned document changes in `WorkspaceEdit`s + + -} + _documentChanges :: (Maybe Bool) + , {-| + The resource operations the client supports. Clients should at least + support 'create', 'rename' and 'delete' files and folders. + + @since 3.13.0 + + -} + _resourceOperations :: (Maybe [Language.LSP.Protocol.Internal.Types.ResourceOperationKind.ResourceOperationKind]) + , {-| + The failure handling strategy of a client if applying the workspace edit + fails. + + @since 3.13.0 + + -} + _failureHandling :: (Maybe Language.LSP.Protocol.Internal.Types.FailureHandlingKind.FailureHandlingKind) + , {-| + Whether the client normalizes line endings to the client specific + setting. + If set to `true` the client will normalize line ending characters + in a workspace edit to the client-specified new line + character. + + @since 3.16.0 + + -} + _normalizesLineEndings :: (Maybe Bool) + , {-| + Whether the client in general supports change annotations on text edits, + create file, rename file and delete file changes. + + @since 3.16.0 + + -} + _changeAnnotationSupport :: (Maybe (Row.Rec ("groupsOnLabel" Row..== (Maybe Bool) Row..+ Row.Empty))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceEditClientCapabilities where + toJSON (WorkspaceEditClientCapabilities arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ ["documentChanges" Language.LSP.Protocol.Types.Common..=? arg0 + ,"resourceOperations" Language.LSP.Protocol.Types.Common..=? arg1 + ,"failureHandling" Language.LSP.Protocol.Types.Common..=? arg2 + ,"normalizesLineEndings" Language.LSP.Protocol.Types.Common..=? arg3 + ,"changeAnnotationSupport" Language.LSP.Protocol.Types.Common..=? arg4] + +instance Aeson.FromJSON WorkspaceEditClientCapabilities where + parseJSON = Aeson.withObject "WorkspaceEditClientCapabilities" $ \arg -> WorkspaceEditClientCapabilities <$> arg Aeson..:! "documentChanges" <*> arg Aeson..:! "resourceOperations" <*> arg Aeson..:! "failureHandling" <*> arg Aeson..:! "normalizesLineEndings" <*> arg Aeson..:! "changeAnnotationSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFolder.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFolder.hs new file mode 100644 index 000000000..c6d77d6d1 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFolder.hs @@ -0,0 +1,39 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceFolder where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A workspace folder inside a client. + +-} +data WorkspaceFolder = WorkspaceFolder + { {-| + The associated URI for this workspace folder. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The name of the workspace folder. Used to refer to this + workspace folder in the user interface. + + -} + _name :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceFolder where + toJSON (WorkspaceFolder arg0 arg1) = Aeson.object $ concat $ [["uri" Aeson..= arg0] + ,["name" Aeson..= arg1]] + +instance Aeson.FromJSON WorkspaceFolder where + parseJSON = Aeson.withObject "WorkspaceFolder" $ \arg -> WorkspaceFolder <$> arg Aeson..: "uri" <*> arg Aeson..: "name" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersChangeEvent.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersChangeEvent.hs new file mode 100644 index 000000000..28f20f7c7 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersChangeEvent.hs @@ -0,0 +1,37 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceFoldersChangeEvent where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFolder +import qualified Language.LSP.Protocol.Types.Common + +{-| +The workspace folder change event. + +-} +data WorkspaceFoldersChangeEvent = WorkspaceFoldersChangeEvent + { {-| + The array of added workspace folders + + -} + _added :: [Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder] + , {-| + The array of the removed workspace folders + + -} + _removed :: [Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder] + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceFoldersChangeEvent where + toJSON (WorkspaceFoldersChangeEvent arg0 arg1) = Aeson.object $ concat $ [["added" Aeson..= arg0] + ,["removed" Aeson..= arg1]] + +instance Aeson.FromJSON WorkspaceFoldersChangeEvent where + parseJSON = Aeson.withObject "WorkspaceFoldersChangeEvent" $ \arg -> WorkspaceFoldersChangeEvent <$> arg Aeson..: "added" <*> arg Aeson..: "removed" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersInitializeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersInitializeParams.hs new file mode 100644 index 000000000..3a1962254 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersInitializeParams.hs @@ -0,0 +1,36 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceFoldersInitializeParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Internal.Types.WorkspaceFolder +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data WorkspaceFoldersInitializeParams = WorkspaceFoldersInitializeParams + { {-| + The workspace folders configured in the client when the server starts. + + This property is only available if the client supports workspace folders. + It can be `null` if the client supports workspace folders but none are + configured. + + @since 3.6.0 + + -} + _workspaceFolders :: (Maybe ([Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceFoldersInitializeParams where + toJSON (WorkspaceFoldersInitializeParams arg0) = Aeson.object $ concat $ ["workspaceFolders" Language.LSP.Protocol.Types.Common..=? arg0] + +instance Aeson.FromJSON WorkspaceFoldersInitializeParams where + parseJSON = Aeson.withObject "WorkspaceFoldersInitializeParams" $ \arg -> WorkspaceFoldersInitializeParams <$> arg Aeson..:! "workspaceFolders" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersServerCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersServerCapabilities.hs new file mode 100644 index 000000000..925eb8a8f --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersServerCapabilities.hs @@ -0,0 +1,42 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceFoldersServerCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common + +{-| + +-} +data WorkspaceFoldersServerCapabilities = WorkspaceFoldersServerCapabilities + { {-| + The server has support for workspace folders + + -} + _supported :: (Maybe Bool) + , {-| + Whether the server wants to receive workspace folder + change notifications. + + If a string is provided the string is treated as an ID + under which the notification is registered on the client + side. The ID can be used to unregister for these events + using the `client/unregisterCapability` request. + + -} + _changeNotifications :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Bool)) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceFoldersServerCapabilities where + toJSON (WorkspaceFoldersServerCapabilities arg0 arg1) = Aeson.object $ concat $ ["supported" Language.LSP.Protocol.Types.Common..=? arg0 + ,"changeNotifications" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON WorkspaceFoldersServerCapabilities where + parseJSON = Aeson.withObject "WorkspaceFoldersServerCapabilities" $ \arg -> WorkspaceFoldersServerCapabilities <$> arg Aeson..:! "supported" <*> arg Aeson..:! "changeNotifications" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFullDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFullDocumentDiagnosticReport.hs new file mode 100644 index 000000000..dd3bb9448 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFullDocumentDiagnosticReport.hs @@ -0,0 +1,63 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceFullDocumentDiagnosticReport where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Diagnostic +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Singletons +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A full document diagnostic report for a workspace diagnostic result. + +@since 3.17.0 + +-} +data WorkspaceFullDocumentDiagnosticReport = WorkspaceFullDocumentDiagnosticReport + { {-| + A full document diagnostic report. + + -} + _kind :: (Language.LSP.Protocol.Types.Singletons.AString "full") + , {-| + An optional result id. If provided it will + be sent on the next diagnostic request for the + same document. + + -} + _resultId :: (Maybe Data.Text.Text) + , {-| + The actual items. + + -} + _items :: [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic] + , {-| + The URI for which diagnostic information is reported. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The version number for which the diagnostics are reported. + If the document is not marked as open `null` can be provided. + + -} + _version :: (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceFullDocumentDiagnosticReport where + toJSON (WorkspaceFullDocumentDiagnosticReport arg0 arg1 arg2 arg3 arg4) = Aeson.object $ concat $ [["kind" Aeson..= arg0] + ,"resultId" Language.LSP.Protocol.Types.Common..=? arg1 + ,["items" Aeson..= arg2] + ,["uri" Aeson..= arg3] + ,["version" Aeson..= arg4]] + +instance Aeson.FromJSON WorkspaceFullDocumentDiagnosticReport where + parseJSON = Aeson.withObject "WorkspaceFullDocumentDiagnosticReport" $ \arg -> WorkspaceFullDocumentDiagnosticReport <$> arg Aeson..: "kind" <*> arg Aeson..:! "resultId" <*> arg Aeson..: "items" <*> arg Aeson..: "uri" <*> arg Aeson..: "version" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbol.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbol.hs new file mode 100644 index 000000000..02d13ad38 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbol.hs @@ -0,0 +1,81 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceSymbol where + +import GHC.Generics +import qualified Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.Location +import qualified Language.LSP.Protocol.Internal.Types.SymbolKind +import qualified Language.LSP.Protocol.Internal.Types.SymbolTag +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Uri + +{-| +A special workspace symbol that supports locations without a range. + +See also SymbolInformation. + +@since 3.17.0 + +-} +data WorkspaceSymbol = WorkspaceSymbol + { {-| + The name of this symbol. + + -} + _name :: Data.Text.Text + , {-| + The kind of this symbol. + + -} + _kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind + , {-| + Tags for this symbol. + + @since 3.16.0 + + -} + _tags :: (Maybe [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag]) + , {-| + The name of the symbol containing this symbol. This information is for + user interface purposes (e.g. to render a qualifier in the user interface + if necessary). It can't be used to re-infer a hierarchy for the document + symbols. + + -} + _containerName :: (Maybe Data.Text.Text) + , {-| + The location of the symbol. Whether a server is allowed to + return a location without a range depends on the client + capability `workspace.symbol.resolveSupport`. + + See SymbolInformation#location for more details. + + -} + _location :: (Language.LSP.Protocol.Internal.Types.Location.Location Language.LSP.Protocol.Types.Common.|? (Row.Rec ("uri" Row..== Language.LSP.Protocol.Types.Uri.Uri Row..+ Row.Empty))) + , {-| + A data entry field that is preserved on a workspace symbol between a + workspace symbol request and a workspace symbol resolve request. + + -} + _data_ :: (Maybe Data.Aeson.Value) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceSymbol where + toJSON (WorkspaceSymbol arg0 arg1 arg2 arg3 arg4 arg5) = Aeson.object $ concat $ [["name" Aeson..= arg0] + ,["kind" Aeson..= arg1] + ,"tags" Language.LSP.Protocol.Types.Common..=? arg2 + ,"containerName" Language.LSP.Protocol.Types.Common..=? arg3 + ,["location" Aeson..= arg4] + ,"data" Language.LSP.Protocol.Types.Common..=? arg5] + +instance Aeson.FromJSON WorkspaceSymbol where + parseJSON = Aeson.withObject "WorkspaceSymbol" $ \arg -> WorkspaceSymbol <$> arg Aeson..: "name" <*> arg Aeson..: "kind" <*> arg Aeson..:! "tags" <*> arg Aeson..:! "containerName" <*> arg Aeson..: "location" <*> arg Aeson..:! "data" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolClientCapabilities.hs new file mode 100644 index 000000000..fec7b4f15 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolClientCapabilities.hs @@ -0,0 +1,59 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceSymbolClientCapabilities where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row as Row +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.SymbolKind +import qualified Language.LSP.Protocol.Internal.Types.SymbolTag +import qualified Language.LSP.Protocol.Types.Common + +{-| +Client capabilities for a `WorkspaceSymbolRequest`. + +-} +data WorkspaceSymbolClientCapabilities = WorkspaceSymbolClientCapabilities + { {-| + Symbol request supports dynamic registration. + + -} + _dynamicRegistration :: (Maybe Bool) + , {-| + Specific capabilities for the `SymbolKind` in the `workspace/symbol` request. + + -} + _symbolKind :: (Maybe (Row.Rec ("valueSet" Row..== (Maybe [Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind]) Row..+ Row.Empty))) + , {-| + The client supports tags on `SymbolInformation`. + Clients supporting tags have to handle unknown tags gracefully. + + @since 3.16.0 + + -} + _tagSupport :: (Maybe (Row.Rec ("valueSet" Row..== [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag] Row..+ Row.Empty))) + , {-| + The client support partial workspace symbols. The client will send the + request `workspaceSymbol/resolve` to the server to resolve additional + properties. + + @since 3.17.0 + + -} + _resolveSupport :: (Maybe (Row.Rec ("properties" Row..== [Data.Text.Text] Row..+ Row.Empty))) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceSymbolClientCapabilities where + toJSON (WorkspaceSymbolClientCapabilities arg0 arg1 arg2 arg3) = Aeson.object $ concat $ ["dynamicRegistration" Language.LSP.Protocol.Types.Common..=? arg0 + ,"symbolKind" Language.LSP.Protocol.Types.Common..=? arg1 + ,"tagSupport" Language.LSP.Protocol.Types.Common..=? arg2 + ,"resolveSupport" Language.LSP.Protocol.Types.Common..=? arg3] + +instance Aeson.FromJSON WorkspaceSymbolClientCapabilities where + parseJSON = Aeson.withObject "WorkspaceSymbolClientCapabilities" $ \arg -> WorkspaceSymbolClientCapabilities <$> arg Aeson..:! "dynamicRegistration" <*> arg Aeson..:! "symbolKind" <*> arg Aeson..:! "tagSupport" <*> arg Aeson..:! "resolveSupport" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolOptions.hs new file mode 100644 index 000000000..76be7f42c --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolOptions.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceSymbolOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Server capabilities for a `WorkspaceSymbolRequest`. + +-} +data WorkspaceSymbolOptions = WorkspaceSymbolOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The server provides support to resolve additional + information for a workspace symbol. + + @since 3.17.0 + + -} + _resolveProvider :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceSymbolOptions where + toJSON (WorkspaceSymbolOptions arg0 arg1) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"resolveProvider" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON WorkspaceSymbolOptions where + parseJSON = Aeson.withObject "WorkspaceSymbolOptions" $ \arg -> WorkspaceSymbolOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "resolveProvider" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolParams.hs new file mode 100644 index 000000000..1de88fc53 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolParams.hs @@ -0,0 +1,46 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceSymbolParams where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Internal.Types.ProgressToken +import qualified Language.LSP.Protocol.Types.Common + +{-| +The parameters of a `WorkspaceSymbolRequest`. + +-} +data WorkspaceSymbolParams = WorkspaceSymbolParams + { {-| + An optional token that a server can use to report work done progress. + + -} + _workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + An optional token that a server can use to report partial results (e.g. streaming) to + the client. + + -} + _partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) + , {-| + A query string to filter symbols by. Clients may send an empty + string here to request all symbols. + + -} + _query :: Data.Text.Text + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceSymbolParams where + toJSON (WorkspaceSymbolParams arg0 arg1 arg2) = Aeson.object $ concat $ ["workDoneToken" Language.LSP.Protocol.Types.Common..=? arg0 + ,"partialResultToken" Language.LSP.Protocol.Types.Common..=? arg1 + ,["query" Aeson..= arg2]] + +instance Aeson.FromJSON WorkspaceSymbolParams where + parseJSON = Aeson.withObject "WorkspaceSymbolParams" $ \arg -> WorkspaceSymbolParams <$> arg Aeson..:! "workDoneToken" <*> arg Aeson..:! "partialResultToken" <*> arg Aeson..: "query" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolRegistrationOptions.hs new file mode 100644 index 000000000..fa8b92034 --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolRegistrationOptions.hs @@ -0,0 +1,38 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceSymbolRegistrationOptions where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Language.LSP.Protocol.Types.Common + +{-| +Registration options for a `WorkspaceSymbolRequest`. + +-} +data WorkspaceSymbolRegistrationOptions = WorkspaceSymbolRegistrationOptions + { {-| + + -} + _workDoneProgress :: (Maybe Bool) + , {-| + The server provides support to resolve additional + information for a workspace symbol. + + @since 3.17.0 + + -} + _resolveProvider :: (Maybe Bool) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceSymbolRegistrationOptions where + toJSON (WorkspaceSymbolRegistrationOptions arg0 arg1) = Aeson.object $ concat $ ["workDoneProgress" Language.LSP.Protocol.Types.Common..=? arg0 + ,"resolveProvider" Language.LSP.Protocol.Types.Common..=? arg1] + +instance Aeson.FromJSON WorkspaceSymbolRegistrationOptions where + parseJSON = Aeson.withObject "WorkspaceSymbolRegistrationOptions" $ \arg -> WorkspaceSymbolRegistrationOptions <$> arg Aeson..:! "workDoneProgress" <*> arg Aeson..:! "resolveProvider" \ No newline at end of file diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceUnchangedDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceUnchangedDocumentDiagnosticReport.hs new file mode 100644 index 000000000..f7af3739d --- /dev/null +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceUnchangedDocumentDiagnosticReport.hs @@ -0,0 +1,58 @@ +-- THIS IS A GENERATED FILE, DO NOT EDIT + +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +module Language.LSP.Protocol.Internal.Types.WorkspaceUnchangedDocumentDiagnosticReport where + +import GHC.Generics +import qualified Data.Aeson as Aeson +import qualified Data.Row.Aeson as Aeson +import qualified Data.Text +import qualified Language.LSP.Protocol.Types.Common +import qualified Language.LSP.Protocol.Types.Singletons +import qualified Language.LSP.Protocol.Types.Uri + +{-| +An unchanged document diagnostic report for a workspace diagnostic result. + +@since 3.17.0 + +-} +data WorkspaceUnchangedDocumentDiagnosticReport = WorkspaceUnchangedDocumentDiagnosticReport + { {-| + A document diagnostic report indicating + no changes to the last result. A server can + only return `unchanged` if result ids are + provided. + + -} + _kind :: (Language.LSP.Protocol.Types.Singletons.AString "unchanged") + , {-| + A result id which will be sent on the next + diagnostic request for the same document. + + -} + _resultId :: Data.Text.Text + , {-| + The URI for which diagnostic information is reported. + + -} + _uri :: Language.LSP.Protocol.Types.Uri.Uri + , {-| + The version number for which the diagnostics are reported. + If the document is not marked as open `null` can be provided. + + -} + _version :: (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + } + deriving stock (Show, Eq, Ord, Generic) + +instance Aeson.ToJSON WorkspaceUnchangedDocumentDiagnosticReport where + toJSON (WorkspaceUnchangedDocumentDiagnosticReport arg0 arg1 arg2 arg3) = Aeson.object $ concat $ [["kind" Aeson..= arg0] + ,["resultId" Aeson..= arg1] + ,["uri" Aeson..= arg2] + ,["version" Aeson..= arg3]] + +instance Aeson.FromJSON WorkspaceUnchangedDocumentDiagnosticReport where + parseJSON = Aeson.withObject "WorkspaceUnchangedDocumentDiagnosticReport" $ \arg -> WorkspaceUnchangedDocumentDiagnosticReport <$> arg Aeson..: "kind" <*> arg Aeson..: "resultId" <*> arg Aeson..: "uri" <*> arg Aeson..: "version" \ No newline at end of file diff --git a/lsp-types/generator/CodeGen.hs b/lsp-types/generator/CodeGen.hs new file mode 100644 index 000000000..aed4ee4a1 --- /dev/null +++ b/lsp-types/generator/CodeGen.hs @@ -0,0 +1,970 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE QuasiQuotes #-} +{- | The main module for generating code from the metamodel + +See Note [Code generation approach] for why we do it this way. +-} +module CodeGen where + +import qualified Data.Text as T +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified Text.RE.Replace as RE +import qualified Text.RE.TDFA.Text as RE +import Language.LSP.MetaModel as MM +import Control.Monad.Reader +import Control.Monad.Writer +import Prettyprinter +import Data.Traversable +import Data.Foldable +import System.FilePath +import System.Directory +import qualified Data.Text.IO as T +import Data.List (sort, intersperse) +import Data.Maybe (maybeToList, fromMaybe, catMaybes, mapMaybe) +import Data.Function + +-- | A mapping from names in the metamodel to their names in the generated Haskell. +type SymbolTable = Map.Map T.Text T.Text + +-- | A mapping from names in the metamodel to their structure definition, used for chasing +-- supertypes. +type StructTable = Map.Map T.Text Structure + +data CodeGenEnv = CodeGenEnv { + symbolTable :: SymbolTable + , structTable :: StructTable + , modulePrefix :: T.Text + , outputDir :: FilePath + } + +type CodeGenM = ReaderT CodeGenEnv IO +type ModuleGenM = WriterT (Set.Set T.Text) (ReaderT CodeGenEnv IO) + +typesModSegment :: T.Text +typesModSegment = "Types" + +pragma :: T.Text -> Doc ann -> Doc ann +pragma kind doc = "{-#" <+> pretty kind <+> doc <+> "#-}" + +-- comment out Generic for a faster build... +toStockDerive :: [T.Text] +toStockDerive = ["Show", "Eq", "Ord", "Generic"] + +indentSize :: Int +indentSize = 2 + +deprecatedPragma :: T.Text -> T.Text -> Doc ann +deprecatedPragma name reason = "{-# DEPRECATED" <+> pretty name <+> dquotes (pretty reason) <+> "#-}" + +optDeprecated :: T.Text -> Maybe T.Text -> [Doc ann] +optDeprecated name mreason = case mreason of + Just reason -> [deprecatedPragma name reason] + Nothing -> [] + +mkDocumentation :: Maybe T.Text -> Maybe T.Text -> Maybe Bool -> ModuleGenM (Maybe T.Text) +mkDocumentation doc _since proposed = + -- TODO: since and proposed are a mess, figure out whether there's a useful way to include them + let docLines = catMaybes [doc] + in + if null docLines + then pure Nothing + else Just <$> (fixupDocumentation $ T.unlines docLines) + +fixupDocumentation :: T.Text -> ModuleGenM T.Text +fixupDocumentation t = do + -- TODO: use the symbol table to map these to the actual entity names + let + fixupJSDocLinks t = RE.replaceAll "`$1`" (t RE.*=~ [RE.re|{@link[[:space:]]+$([[:word:].]+).*}|]) + fixupMarkdownLinks t = RE.replaceAll "`$1`" $ t RE.*=~ [RE.re|\[[[:word:].]+\][[:space:]]*\(#$([[:word:].]+)\)|] + let t' = fixupJSDocLinks t + let t'' = fixupMarkdownLinks t' + pure t'' + +multilineHaddock :: Doc ann -> Doc ann +multilineHaddock doc = vsep [ "{-|", doc , "-}" ] + +genModule :: forall ann . T.Text -> [T.Text] -> Maybe [T.Text] -> ModuleGenM (Doc ann) -> CodeGenM T.Text +genModule name pragmas mexports action = do + (doc, imports) <- runWriterT action + mp <- asks modulePrefix + dir <- asks outputDir + let + -- these are both common in the generated code + ghcOptions :: [T.Text] = ["-Wno-unused-imports", "-Wno-unused-matches", "-Wno-deprecations"] + fullModName = mp <> "." <> name + warning = "-- THIS IS A GENERATED FILE, DO NOT EDIT" + pragmaSection = hardvcat (fmap (\p -> "{-#" <+> "LANGUAGE" <+> pretty p <+> "#-}") pragmas) + optionsSection = hardvcat (fmap (\p -> "{-#" <+> "OPTIONS_GHC" <+> pretty p <+> "#-}") ghcOptions) + header = case mexports of + Just exports -> "module" <+> pretty fullModName <+> parens (cat $ punctuate "," (fmap pretty exports)) <+> "where" + Nothing -> "module" <+> pretty fullModName <+> "where" + -- TODO: replace with regex + isSelfImport imp = (" " <> fullModName <> " ") `T.isInfixOf` imp || (" " <> fullModName) `T.isSuffixOf` imp + importSection = hardvcat (fmap pretty $ filter (not . isSelfImport) $ toList imports) + mod = warning <> hardline <> pragmaSection <> hardline <> optionsSection <> hardline <> header <> hardline <> hardline <> importSection <> hardline <> hardline <> doc + printed = T.pack $ show mod + + modSegments = T.unpack <$> T.splitOn "." fullModName + modulePath = (foldl () dir modSegments) <.> "hs" + + lift $ createDirectoryIfMissing True $ takeDirectory modulePath + lift $ T.writeFile modulePath printed + pure fullModName + +data Qualification = Unqual | Qual | QualAs T.Text | As T.Text + +ensureImport :: T.Text -> Qualification -> ModuleGenM T.Text +ensureImport mod Unqual = tell (Set.singleton $ "import " <> mod) >> pure mod +ensureImport mod Qual = tell (Set.singleton $ "import qualified " <> mod) >> pure mod +ensureImport mod (QualAs qual) = tell (Set.singleton $ "import qualified " <> mod <> " as " <> qual) >> pure qual +ensureImport mod (As qual) = tell (Set.singleton $ "import " <> mod <> " as " <> qual) >> pure qual + +ensureLSPImport :: T.Text -> Qualification -> ModuleGenM T.Text +ensureLSPImport mod qual = do + mp <- asks modulePrefix + ensureImport (mp <> "." <> mod) qual + +ensureLSPImport' :: T.Text -> ModuleGenM T.Text +ensureLSPImport' mod = ensureLSPImport mod Qual + +entityName :: T.Text -> T.Text -> ModuleGenM T.Text +entityName mod n = do + qual <- ensureImport mod Qual + pure $ qual <> "." <> n + +lspEntityName :: T.Text -> T.Text -> ModuleGenM T.Text +lspEntityName mod n = do + qual <- ensureLSPImport' mod + pure $ qual <> "." <> n + +genFromMetaModel :: T.Text -> FilePath -> MetaModel -> IO () +genFromMetaModel prefix dir mm = do + let (symbolTable, structTable) = buildTables mm + flip runReaderT (CodeGenEnv symbolTable structTable prefix dir) $ do + structModuleNames <- traverse genStruct (structures mm) + aliasModuleNames <- traverse genAlias (typeAliases mm) + enumModuleNames <- traverse genEnum (enumerations mm) + methodModuleName <- genMethods (requests mm) (notifications mm) + -- not the methods, we export them separately! + genAllModule $ sort $ concat [structModuleNames, aliasModuleNames, enumModuleNames] + -- Have to use the string form of the generated Name + -- since we might have mangled the original name + let structNames = mapMaybe (\Structure{name} -> Map.lookup name symbolTable) (structures mm) + genLensModule structNames + pure () + pure () + + -- | Names we can't put in Haskell code. +reservedNames :: Set.Set T.Text +reservedNames = Set.fromList [ "data", "type" ] + +-- | Sanitize a name so we can use it in Haskell. +sanitizeName :: T.Text -> T.Text +sanitizeName n = + -- Names can't start with underscores! Replace that with a 'U' for lack + -- of a better idea + let n' = if "_" `T.isPrefixOf` n then T.cons 'U' $ T.tail n else n + -- Names can't have '$'s! Just throw them away. + n'' = T.filter (\c -> c /= '$') n' + -- If we end up with a reserved name, suffix with an underscore. This + -- relibly gets us something recognizable, rather than trying to systematize + -- the conversion of 'type' into 'tpe' or similar. + n''' = if n'' `Set.member` reservedNames then n'' <> "_" else n'' + in n''' + +-- | Make a name to be used at the top-level (i.e. not as a member of anything). +makeToplevelName :: T.Text -> T.Text +makeToplevelName n = capitalize $ sanitizeName n + +-- | Make a name for a constructor, optionally including a contextual name to qualify it with. +makeConstrName :: Maybe T.Text -> T.Text -> T.Text +makeConstrName context n = + let + cap = capitalize n + disambiguated = case context of { Just t -> t <> "_" <> cap; Nothing -> cap } + in sanitizeName disambiguated + +-- | Make a name for a field. +makeFieldName :: T.Text -> T.Text +makeFieldName n = "_" <> sanitizeName n + +buildTables :: MetaModel -> (SymbolTable, StructTable) +buildTables (MetaModel{structures, enumerations, typeAliases}) = + let bothEntries = (flip fmap) structures $ \s@Structure{name} -> + ((name, makeToplevelName name), (name, s)) + (entries, sentries) = unzip bothEntries + + entries' = (flip fmap) enumerations $ \Enumeration{name} -> (name, makeToplevelName name) + + entries'' = (flip fmap) typeAliases $ \TypeAlias{name} -> (name, makeToplevelName name) + symbolTable = Map.fromList $ entries <> entries' <> entries'' + + structTable = Map.fromList sentries + in (symbolTable, structTable) + +-- | Translate a type in the metamodel into the corresponding Haskell type. +-- See Note [Translating metamodel types] +convertType :: Type -> ModuleGenM (Doc ann) +convertType = \case + BaseType n -> case n of + URI -> pretty <$> entityName "Language.LSP.Protocol.Types.Uri" "Uri" + DocumentUri -> pretty <$> entityName "Language.LSP.Protocol.Types.Uri" "Uri" + Integer -> pretty <$> entityName "Language.LSP.Protocol.Types.Common" "Int32" + UInteger -> pretty <$> entityName "Language.LSP.Protocol.Types.Common" "UInt" + Decimal -> pure "Float" + RegExp -> pretty <$> entityName "Data.Text" "Text" + String -> pretty <$> entityName "Data.Text" "Text" + Boolean -> pure "Bool" + Null -> pretty <$> entityName "Language.LSP.Protocol.Types.Common" "Null" + + -- Special cases: these are in fact defined in the meta model, but + -- we have way better types for them + + -- 'LSPAny' is a big union of anything in the metamodel, we just + -- keep that as an aeson 'Value' + ReferenceType "LSPAny" -> pretty <$> entityName "Data.Aeson" "Value" + -- 'LSPObject' is an empty structure ... better to just say it's an aeson 'Object'! + ReferenceType "LSPObject" -> pretty <$> entityName "Data.Aeson" "Object" + -- 'LSPArray' is a list of 'LSPAny'... better to just say it's an aeson 'Array'! + ReferenceType "LSPArray" -> pretty <$> entityName "Data.Aeson" "Array" + + ReferenceType n -> do + st <- asks symbolTable + case Map.lookup n st of + Just thn -> pretty <$> lspEntityName (typesModSegment <> "." <> thn) thn + Nothing -> fail $ "Reference to unknown type: " <> show n + ArrayType e -> do + innerType <- convertType e + pure $ brackets innerType + MapType k v -> do + kt <- convertType k + vt <- convertType v + n <- pretty <$> entityName "Data.Map" "Map" + pure $ parens $ n <+> kt <+> vt + OrType es -> do + est <- traverse convertType es + n <- pretty <$> entityName "Language.LSP.Protocol.Types.Common" "|?" + pure $ foldr1 (\ty o -> parens (ty <+> n <+> o)) est + AndType es -> do + st <- asks structTable + props <- for es $ \case + ReferenceType t | Just e <- Map.lookup t st -> getStructProperties e + t -> fail $ "element of 'and' type was not a reference to a structure: " ++ show t + genAnonymousStruct $ concat props + StructureLiteralType (StructureLiteral {properties}) -> genAnonymousStruct properties + TupleType es -> do + est <- traverse convertType es + pure $ tupled est + StringLiteralType s -> do + tycon <- entityName "Language.LSP.Protocol.Types.Singletons" "AString" + let ty = pretty tycon <+> dquotes (pretty s) + pure $ parens ty + IntegerLiteralType n -> do + tycon <- entityName "Language.LSP.Protocol.Types.Singletons" "AnInteger" + let ty = pretty tycon <+> pretty n + pure $ parens ty + BooleanLiteralType _ -> fail "unsupported: boolean literal types" + +genStruct :: Structure -> CodeGenM T.Text +genStruct s@Structure{name} = do + st <- asks symbolTable + hsName <- case Map.lookup name st of + Just hsn -> pure hsn + Nothing -> fail $ "Unknown type: " <> show name + genModule (typesModSegment <> "." <> hsName) [] Nothing (printStruct hsName s) + +printStruct :: T.Text -> Structure -> ModuleGenM (Doc ann) +printStruct tn s@Structure{name, documentation, since, proposed, deprecated} = do + let structName = name + + let ctor = makeToplevelName name + + props <- getStructProperties s + args <- for props $ \Property{name, type_, optional, documentation, since, proposed, deprecated} -> do + pty <- convertType type_ + let mty = case optional of + Just True -> parens ("Maybe" <+> pty) + _ -> pty + let n = makeFieldName name + propDoc <- multilineHaddock . pretty <$> mkDocumentation documentation since proposed + pure $ hardvcat [propDoc, pretty n <+> "::" <+> mty] + + -- Annoyingly, this won't deprecate the lens, which is defined somewhere else entirely. Unclear what to do about that. + let deprecations = optDeprecated tn deprecated ++ (flip concatMap props $ \Property{name, deprecated} -> optDeprecated (makeFieldName name) deprecated) + + ensureImport "GHC.Generics" Unqual + let derivDoc = indent indentSize $ "deriving stock" <+> tupled (fmap pretty toStockDerive) + dataDoc <- multilineHaddock . pretty <$> mkDocumentation documentation since proposed + let dataDecl = "data" <+> pretty tn <+> "=" <+> pretty ctor <+> nest indentSize (encloseSep (line <> "{ ") (line <> "}") ", " args) + datad = hardvcat (deprecations ++ [dataDoc, dataDecl, derivDoc]) + + ensureImport "Data.Aeson" (QualAs "Aeson") + ensureImport "Data.Row.Aeson" (QualAs "Aeson") + matcherName <- entityName "Language.LSP.Protocol.Types.Common" ".=?" + let toJsonD = + let (unzip -> (args, pairEs)) = (flip fmap) (zip props [0..]) $ \(Property{name, optional}, i) -> + let n :: T.Text = "arg" <> (T.pack $ show i) + pairE = case optional of + Just True -> dquotes (pretty name) <+> pretty matcherName <+> pretty n + _ -> brackets (dquotes (pretty name) <+> "Aeson..=" <+> pretty n) + in (pretty n, pairE) + body = "Aeson.object $ concat $ " <+> encloseSep "[" "]" "," pairEs + toJsonDoc = "toJSON" <+> parens (pretty ctor <+> hsep args) <+> "=" <+> nest indentSize body + instanceDoc = "instance Aeson.ToJSON" <+> pretty tn <+> "where" <> nest indentSize (hardline <> toJsonDoc) + in instanceDoc + + fromJsonD <- do + let vn :: T.Text = "arg" + let exprs = flip fmap props $ \Property{name, optional} -> + case optional of + Just True -> pretty vn <+> "Aeson..:!" <+> dquotes (pretty name) + _ -> pretty vn <+> "Aeson..:" <+> dquotes (pretty name) + let lamBody = mkIterApplicativeApp (pretty ctor) exprs + let body = "Aeson.withObject" <+> dquotes (pretty structName) <+> "$" <+> "\\" <> pretty vn <+> "->" <+> nest indentSize lamBody + let fromJsonDoc = "parseJSON" <+> "=" <+> nest indentSize body + let instanceDoc = "instance Aeson.FromJSON" <+> pretty tn <+> "where" <> nest indentSize (hardline <> fromJsonDoc) + pure instanceDoc + + pure $ + datad <> + hardline <> hardline <> + toJsonD <> + hardline <> hardline <> + fromJsonD + +-- | Get the list of properties of a struct, including inherited ones. +getStructProperties :: Structure -> ModuleGenM [Property] +getStructProperties s@Structure{name, properties, extends, mixins} = do + st <- asks structTable + let + extends' = fromMaybe [] extends + mixins' = fromMaybe [] mixins + supertypes = extends' ++ mixins' + superProps <- for supertypes $ \case + ReferenceType t | Just e <- Map.lookup t st -> getStructProperties e + t -> fail $ "supertype of structure " ++ show name ++ " was not a reference to a structure: " ++ show t + let allSuperProps = concat superProps + -- If a property is redefined in the current type, then it overrides the inherited one + localNames = foldMap (\Property{name} -> Set.singleton name) properties + filteredSuperProps = filter (\Property{name} -> name `Set.notMember` localNames) allSuperProps + pure (filteredSuperProps ++ properties) + +-- | Generate a type corresponding to an anonymous struct. +genAnonymousStruct :: [Property] -> ModuleGenM (Doc ann) +genAnonymousStruct properties = do + row <- for properties $ \Property{name, type_, optional} -> do + pty <- convertType type_ + let mty = case optional of + Just True -> parens ("Maybe" <+> pty) + _ -> pty + ensureImport "Data.Row" (QualAs "Row") + pure $ dquotes (pretty name) <+> "Row..==" <+> mty + let tyList = foldr (\ty l -> parens $ ty <+> "Row..+" <+> l) "Row.Empty" row + pure $ parens $ "Row.Rec" <+> tyList + +genEnum :: Enumeration -> CodeGenM T.Text +genEnum e@Enumeration{name} = do + st <- asks symbolTable + hsName <- case Map.lookup name st of + Just hsn -> pure hsn + Nothing -> fail $ "Unknown type: " <> show name + genModule (typesModSegment <> "." <> hsName) [] Nothing (printEnum hsName e) + +printEnum :: T.Text -> Enumeration -> ModuleGenM (Doc ann) +printEnum tn Enumeration{name, type_, values, supportsCustomValues, documentation, since, proposed, deprecated} = do + st <- asks symbolTable + + let enumName = name + enumNameString = T.unpack enumName + -- This indicates whether or not the enum is "open" and supports custom values. + -- We need to branch on this a lot! + custom = fromMaybe False supportsCustomValues + + -- The (Haskell) type of the elements of this enum. Useful, so we can generate various + -- code (e.g. for parsing JSON) generically but use this type to pin down what we want to do. + ty <- case type_ of + BaseType Integer -> pretty <$> entityName "Language.LSP.Protocol.Types.Common" "Int32" + BaseType UInteger -> pretty <$> entityName "Language.LSP.Protocol.Types.Common" "UInt" + BaseType String -> pretty <$> entityName "Data.Text" "Text" + _ -> fail $ "enumeration of unexpected type " ++ show type_ + + let isString = case type_ of + BaseType String -> True + _ -> False + + -- https://github.com/microsoft/vscode-languageserver-node/issues/1035 + let badEnumValues = ["jsonrpcReservedErrorRangeStart", "jsonrpcReservedErrorRangeEnd", "serverErrorStart", "serverErrorEnd"] + values' = filter (\EnumerationEntry{name} -> not $ name `elem` badEnumValues) values + -- The associations between constructor names and their literals + assocs <- for values' $ \EnumerationEntry{name, value, documentation, since, proposed} -> do + let cn = makeConstrName (Just enumName) name + -- The literal for the actual enum value in this case + lit = case value of + T t -> pretty $ show $ T.unpack t + I i -> pretty $ show i + doc <- mkDocumentation documentation since proposed + pure (cn, lit, doc) + + let normalCons = flip fmap assocs $ \(cn, _, doc) -> + hardvcat [ multilineHaddock $ pretty doc, pretty cn ] + let customCon = + let cn = makeConstrName (Just enumName) "Custom" + in if custom then Just (cn, pretty cn <+> ty) else Nothing + let cons = normalCons ++ (fmap snd $ maybeToList customCon) + + ensureImport "Data.Aeson" (QualAs "Aeson") + ensureImport "Data.Row.Aeson" (QualAs "Aeson") + + lspEnumN <- pretty <$> entityName "Language.LSP.Protocol.Types.LspEnum" "LspEnum" + let knownValuesN = "knownValues" + let toBaseTypeN = "toEnumBaseType" + let fromBaseTypeN = "fromEnumBaseType" + lspOpenEnumN <- pretty <$> entityName "Language.LSP.Protocol.Types.LspEnum" "LspOpenEnum" + let fromOpenBaseTypeN = "fromOpenEnumBaseType" + asLspEnumN <- pretty <$> entityName "Language.LSP.Protocol.Types.LspEnum" "AsLspEnum" + isStringN <- pretty <$> entityName "Data.String" "IsString" + + let deprecations = optDeprecated tn deprecated ++ (flip concatMap values' $ \EnumerationEntry{name, deprecated} -> optDeprecated (makeConstrName (Just enumName) name) deprecated) + + ensureImport "GHC.Generics" Unqual + dataDoc <- multilineHaddock . pretty <$> mkDocumentation documentation since proposed + let derivDoc = + let + toDeriveViaLspEnum = ["Aeson.ToJSON", "Aeson.FromJSON"] ++ if custom && isString then [isStringN] else [] + stockDeriv = "deriving stock" <+> tupled (fmap pretty toStockDerive) + viaDeriv = "deriving" <+> tupled toDeriveViaLspEnum <+> "via" <+> parens (asLspEnumN <+> pretty tn <+> ty) + in indent indentSize $ hardvcat [stockDeriv, viaDeriv] + let dataDecl = "data" <+> pretty tn <+> "=" <+> nest indentSize (encloseSep (line <> " ") mempty "| " cons) + dataD = hardvcat (deprecations ++ [dataDoc, dataDecl, derivDoc]) + + setFromListN <- pretty <$> entityName "Data.Set" "fromList" + let knownValuesD = + let valuesList = nest indentSize $ encloseSep "[" "]" "," $ (flip fmap) assocs $ \(n, _, _) -> pretty n + in knownValuesN <+> "=" <+> setFromListN <+> valuesList + + let toBaseTypeD = + -- xToValue X1 = + let normalClauses = (flip fmap) assocs $ \(n, v, _) -> toBaseTypeN <+> pretty n <+> "=" <+> v + -- xToValue (CustomX c) = c + customClause = case customCon of + Just (cn, _) -> + let vn :: T.Text = "arg" + in Just $ toBaseTypeN <+> parens (pretty cn <+> pretty vn) <+> "=" <+> pretty vn + Nothing -> Nothing + clauses = normalClauses ++ maybeToList customClause + in hardvcat clauses + + let fromBaseTypeD = + let fn = if custom then fromOpenBaseTypeN else fromBaseTypeN + -- valueToX = X + -- or + -- valueToX = Just X + normalClauses = (flip fmap) assocs $ \(n, v, _) -> fn <+> v <+> "=" <+> if custom then pretty n else "pure" <+> pretty n + -- valueToX c = CustomX c + -- or + -- valueToX _ = Nothing + fallThroughClause = case customCon of + Just (cn, _) -> + let vn :: T.Text = "arg" + in fn <+> pretty vn <+> "=" <+> pretty cn <+> pretty vn + Nothing -> fn <+> "_ = Nothing" + clauses = normalClauses ++ [fallThroughClause] + in hardvcat clauses + + let lspEnumD = + let + baseTypeD = "type EnumBaseType" <+> pretty tn <+> "=" <+> ty + decls = [knownValuesD, baseTypeD, toBaseTypeD] ++ if custom then [] else [fromBaseTypeD] + instanceDoc = "instance" <+> lspEnumN <+> pretty tn <+> "where" <> nest indentSize (hardline <> vcat decls) + in instanceDoc + let lspOpenEnumD = "instance" <+> lspOpenEnumN <+> pretty tn <+> "where" <> nest indentSize (hardline <> fromBaseTypeD) + + pure $ + dataD <> + hardline <> hardline <> + lspEnumD <> + hardline <> hardline <> + (if custom then lspOpenEnumD <> hardline <> hardline else "") + +genAlias :: TypeAlias -> CodeGenM T.Text +genAlias a@TypeAlias{name} = do + st <- asks symbolTable + hsName <- case Map.lookup name st of + Just hsn -> pure hsn + Nothing -> fail $ "Unknown type: " <> show name + genModule (typesModSegment <> "." <> hsName) [] Nothing (printAlias hsName a) + +printAlias :: forall ann . T.Text -> TypeAlias -> ModuleGenM (Doc ann) +printAlias hsName TypeAlias{name, type_, documentation, since, proposed, deprecated} = do + st <- asks symbolTable + rhs <- convertType type_ + + ensureImport "GHC.Generics" Unqual + ensureImport "Data.Aeson" (QualAs "Aeson") + ensureImport "Data.Row.Aeson" (QualAs "Aeson") + -- In practice, it seems that only base types and aliases to base types get used as map keys, so deriving + -- To/FromJSONKey for them seems to be enough + let aesonDeriving :: [Doc ann] = ["Aeson.ToJSON", "Aeson.FromJSON"] ++ case type_ of { BaseType _ -> ["Aeson.ToJSONKey", "Aeson.FromJSONKey"]; _ -> [] } + derivDoc = indent indentSize $ hardvcat ["deriving stock" <+> tupled (fmap pretty toStockDerive), "deriving newtype" <+> tupled aesonDeriving] + dataDoc <- multilineHaddock . pretty <$> mkDocumentation documentation since proposed + let dataDecl = "newtype" <+> pretty hsName <+> "=" <+> pretty hsName <+> rhs + datad = hardvcat (optDeprecated hsName deprecated ++ [dataDoc, dataDecl, derivDoc]) + pure datad + +--------------- + +data RequestData ann = RequestData + { methCon :: Doc ann + , singCon :: Doc ann + , paramsEq :: Doc ann + , resultEq :: Doc ann + , errorDataEq :: Doc ann + , registrationOptionsEq :: Doc ann + , toStringClause :: Doc ann + , fromStringClause :: Doc ann + , messageDirectionClause :: Doc ann + , messageKindClause :: Doc ann + } + +data NotificationData ann = NotificationData + { methCon :: Doc ann + , singCon :: Doc ann + , paramsEq :: Doc ann + , registrationOptionsEq :: Doc ann + , toStringClause :: Doc ann + , fromStringClause :: Doc ann + , messageDirectionClause :: Doc ann + , messageKindClause :: Doc ann + } + +data CustomData ann = CustomData + { methCon :: Doc ann + , singCon :: Doc ann + , paramsEq :: Doc ann + , resultEq :: Doc ann + , errorDataEq :: Doc ann + , registrationOptionsEq :: Doc ann + , toStringClause :: Doc ann + , fromStringClause :: Doc ann + , messageDirectionClause :: Doc ann + , messageKindClause :: Doc ann + } + +-- See Note [Generating code for methods] +-- TODO: partial result params +printMethods :: [Request] -> [Notification] -> ModuleGenM (Doc ann) +printMethods reqs nots = do + let mtyN = "Method" + styN = "SMethod" + sstyN = "SomeMethod" + smcn = "SomeMethod" + mpN = "MessageParams" + mrN = "MessageResult" + edN = "ErrorData" + roN = "RegistrationOptions" + toStringN = "someMethodToMethodString" + fromStringN = "methodStringToSomeMethod" + mdN = "messageDirection" + mkN = "messageKind" + + let methodName context fullName = + let pieces = T.splitOn "/" fullName + in pretty $ makeConstrName context $ foldMap capitalize pieces + let messagePartType t = case t of + Just ty -> convertType ty + -- See Note [Absent parameters/results/errors] + Nothing -> do + ensureImport "Data.Void" Qual + pure "Maybe Data.Void.Void" + + ensureImport "Language.LSP.Protocol.Message.Meta" (QualAs "MM") + + -- Construct the various pieces we'll need for the declarations in one go + reqData <- for reqs $ \Request{method, params, result, errorData, registrationOptions, messageDirection} -> do + -- :: Method + let mcn = methodName (Just mtyN) method + direction = case messageDirection of + MM.ClientToServer -> "MM.ClientToServer" + MM.ServerToClient -> "MM.ServerToClient" + MM.Both -> "f" + methCon = mcn <+> "::" <+> pretty mtyN <+> direction <+> "MM.Request" + scn = methodName (Just styN) method + singCon = scn <+> "::" <+> pretty styN <+> mcn + + -- MessageParams = + paramTy <- messagePartType params + let paramsEq = mpN <+> mcn <+> "=" <+> paramTy + -- MessageResult = + resultTy <- messagePartType (Just result) + let resultEq = mrN <+> mcn <+> "=" <+> resultTy + errDatTy <- messagePartType errorData + let errorDataEq = edN <+> mcn <+> "=" <+> errDatTy + regOptsTy <- messagePartType registrationOptions + let registrationOptionsEq = roN <+> mcn <+> "=" <+> regOptsTy + + let toStringClause = toStringN <+> parens (smcn <+> scn) <+> "=" <+> dquotes (pretty method) + fromStringClause = fromStringN <+> dquotes (pretty method) <+> "=" <+> smcn <+> scn + messageDirectionClause = + let d = case messageDirection of + MM.ClientToServer -> "MM.SClientToServer" + MM.ServerToClient -> "MM.SServerToClient" + MM.Both -> "MM.SBothDirections" + in mdN <+> scn <+> "=" <+> d + messageKindClause = "messageKind" <+> scn <+> "=" <+> "MM.SRequest" + pure $ RequestData {..} + + notData <- for nots $ \Notification{method, params, registrationOptions, messageDirection} -> do + let mcn = methodName (Just mtyN) method + direction = case messageDirection of + MM.ClientToServer -> "MM.ClientToServer" + MM.ServerToClient -> "MM.ServerToClient" + MM.Both -> "f" + methCon = mcn <+> "::" <+> pretty mtyN <+> direction <+> "MM.Notification" + scn = methodName (Just styN) method + singCon = scn <+> "::" <+> pretty styN <+> mcn + + -- MessageParams = + paramTy <- messagePartType params + let paramsEq = mpN <+> mcn <+> "=" <+> paramTy + regOptsTy <- messagePartType registrationOptions + let registrationOptionsEq = roN <+> mcn <+> "=" <+> regOptsTy + + let toStringClause = toStringN <+> parens (smcn <+> scn) <+> "=" <+> dquotes (pretty method) + fromStringClause = fromStringN <+> dquotes (pretty method) <+> "=" <+> smcn <+> scn + messageDirectionClause = + let d = case messageDirection of + MM.ClientToServer -> "MM.SClientToServer" + MM.ServerToClient -> "MM.SServerToClient" + MM.Both -> "MM.SBothDirections" + in "messageDirection" <+> scn <+> "=" <+> d + messageKindClause = "messageKind" <+> scn <+> "=" <+> "MM.SNotification" + + pure $ NotificationData {..} + + -- Add the custom method case, which isn't in the metamodel + customDat <- do + let mcn = methodName (Just mtyN) "CustomMethod" + -- Method_CustomMethod :: Symbol -> Method f t + methCon = mcn <+> "::" <+> "GHC.TypeLits.Symbol" <+> "->" <+> pretty mtyN <+> "f" <+> "t" + -- SMethod_CustomMethod :: KnownSymbol s => SMethod Method_CustomMethod + scn = methodName (Just styN) "CustomMethod" + ensureImport "Data.Proxy" Qual + ensureImport "GHC.TypeLits" Qual + let singCon = scn <+> "::" <+> "forall s . GHC.TypeLits.KnownSymbol s =>" <+> "Data.Proxy.Proxy s" <+> "->" <+> pretty styN <+> parens (mcn <+> "s") + -- MessageParams (Method_CustomMethod s) = Value + ensureImport "Data.Aeson" (QualAs "Aeson") + let paramsEq = mpN <+> parens (mcn <+> "s") <+> "=" <+> "Aeson.Value" + -- MessageResult (Method_CustomMethod s) = Value + resultEq = mrN <+> parens (mcn <+> "s") <+> "=" <+> "Aeson.Value" + -- Can shove whatever you want in the error data for custom methods? + -- ErrorData (Method_CustomMethod s) = Value + errorDataEq = edN <+> parens (mcn <+> "s") <+> "=" <+> "Aeson.Value" + -- Can't register custom methods + -- RegistrationOptions (Method_CustomMethod s) = Void + ensureImport "Data.Void" Qual + let registrationOptionsEq = roN <+> parens (mcn <+> "s") <+> "=" <+> "Data.Void.Void" + + let toStringClause = toStringN <+> parens (smcn <+> parens (scn <+> "v")) <+> "=" <+> "GHC.TypeLits.symbolVal v" + fromStringClause = fromStringN <+> "v = case GHC.TypeLits.someSymbolVal v of { GHC.TypeLits.SomeSymbol p ->" <+> smcn <+> parens (scn <+> "p") <+> "; }" + messageDirectionClause = mdN <+> parens (scn <+> "_") <+> "=" <+> "MM.SBothDirections" + messageKindClause = mkN <+> parens (scn <+> "_") <+> "=" <+> "MM.SBothTypes" + + pure $ CustomData {..} + + ensureImport "Data.Kind" (QualAs "Kind") + let dataD = + let sigD = "type" <+> pretty mtyN <+> ":: MM.MessageDirection -> MM.MessageKind -> Kind.Type" + docD = "-- | A type representing a LSP method (or class of methods), intended to be used mostly at the type level." + ctors = fmap (\RequestData{..} -> methCon) reqData ++ fmap (\NotificationData{..} -> methCon) notData ++ [(\CustomData{..} -> methCon) customDat] + dataD = nest indentSize $ "data" <+> pretty mtyN <+> "f t" <+> "where" <+> (hardline <> hardvcat ctors) + -- This only really exists on the type level so we don't really want instances anyway + in hardvcat [docD, sigD, dataD] + + let mpD = + let sigD = "type" <+> mpN <+> ":: forall f t ." <+> pretty mtyN <+> "f t" <+> "->" <+> "Kind.Type" + docD = "-- | Maps a LSP method to its parameter type." + eqns = fmap (\RequestData{..} -> paramsEq) reqData ++ fmap (\NotificationData{..} -> paramsEq) notData ++ [(\CustomData{..} -> paramsEq) customDat] + declD = nest indentSize $ "type family" <+> mpN <+> parens ("m :: " <+> pretty mtyN <+> "f t") <+> "where" <+> (hardline <> hardvcat eqns) + in hardvcat [docD, sigD, declD] + + let mrD = + let sigD = "type" <+> mrN <+> ":: forall f t ." <+> pretty mtyN <+> "f t" <+> "->" <+> "Kind.Type" + docD = "-- | Maps a LSP method to its result type." + -- TODO: should we give notifiations ()? + eqns = fmap (\RequestData{..} -> resultEq) reqData ++ [(\CustomData{..} -> resultEq) customDat] + declD = nest indentSize $ "type family" <+> mrN <+> parens ("m :: " <+> pretty mtyN <+> "f t") <+> "where" <+> (hardline <> hardvcat eqns) + in hardvcat [docD, sigD, declD] + + let edD = + let sigD = "type" <+> edN <+> ":: forall f t ." <+> pretty mtyN <+> "f t" <+> "->" <+> "Kind.Type" + docD = "-- | Maps a LSP method to its error data type." + -- TODO: should we give notifiations ()? + eqns = fmap (\RequestData{..} -> errorDataEq) reqData ++ [(\CustomData{..} -> errorDataEq) customDat] + declD = nest indentSize $ "type family" <+> edN <+> parens ("m :: " <+> pretty mtyN <+> "f t") <+> "where" <+> (hardline <> hardvcat eqns) + in hardvcat [docD, sigD, declD] + + let roD = + let sigD = "type" <+> roN <+> ":: forall f t ." <+> pretty mtyN <+> "f t" <+> "->" <+> "Kind.Type" + docD = "-- | Maps a LSP method to its registration options type." + eqns = fmap (\RequestData{..} -> registrationOptionsEq) reqData ++ fmap (\NotificationData{..} -> registrationOptionsEq) notData ++ [(\CustomData{..} -> registrationOptionsEq) customDat] + declD = nest indentSize $ "type family" <+> roN <+> parens ("m :: " <+> pretty mtyN <+> "f t") <+> "where" <+> (hardline <> hardvcat eqns) + in hardvcat [docD, sigD, declD] + + let singD = + let sigD = "type" <+> pretty styN <+> ":: forall f t ." <+> pretty mtyN <+> "f t" <+> "->" <+> "Kind.Type" + docD = "-- | A singleton type for 'Method'." + ctors = fmap (\RequestData{..} -> singCon) reqData ++ fmap (\NotificationData{..} -> singCon) notData ++ [(\CustomData{..} -> singCon) customDat] + -- Can't derive instances, it's a GADT, will do them later + dataD = nest indentSize $ "data" <+> pretty styN <+> "m" <+> "where" <+> (hardline <> hardvcat ctors) + in hardvcat [docD, sigD, dataD] + + let ssmD = + let ctor = smcn <+> "::" <+> "forall m ." <+> pretty styN <+> "m" <+> "->" <+> sstyN + docD = "-- | A method which isn't statically known." + -- Can't derive instances because it's a GADT and we're not doing the instances for SMethod here either + dataD = nest indentSize $ "data" <+> sstyN <+> "where" <+> (hardline <> ctor) + in hardvcat [docD, dataD] + + -- methodToString :: SomeMethod -> String + let toStringD = + let docD = "-- | Turn a 'SomeMethod' into its LSP method string." + sigD = toStringN <+> "::" <+> sstyN <+> "->" <+> "String" + clauses = fmap (\RequestData{..} -> toStringClause) reqData ++ fmap (\NotificationData{..} -> toStringClause) notData ++ [(\CustomData{..} -> toStringClause) customDat] + in hardvcat [docD, sigD, hardvcat clauses] + -- stringToMethod :: String -> SomeMethod + let fromStringD = + let docD = "-- | Turn a LSP method string into a 'SomeMethod'." + sigD = fromStringN <+> "::" <+> "String" <+> "->" <+> sstyN + clauses = fmap (\RequestData{..} -> fromStringClause) reqData ++ fmap (\NotificationData{..} -> fromStringClause) notData ++ [(\CustomData{..} -> fromStringClause) customDat] + in hardvcat [docD, sigD, hardvcat clauses] + + let messageDirectionD = + let docD = "-- | Get a singleton witness for the message direction of a 'SMethod'." + sigD = mdN <+> ":: forall f t (m :: Method f t) ." <+> pretty styN <+> "m" <+> "->" <+> "MM.SMessageDirection f" + clauses = fmap (\RequestData{..} -> messageDirectionClause) reqData ++ fmap (\NotificationData{..} -> messageDirectionClause) notData ++ [(\CustomData{..} -> messageDirectionClause) customDat] + in hardvcat [docD, sigD, hardvcat clauses] + + let messageKindD = + let docD = "-- | Get a singleton witness for the message kind of a 'SMethod'." + sigD = mkN <+> ":: forall f t (m :: Method f t) ." <+> pretty styN <+> "m" <+> "->" <+> "MM.SMessageKind t" + clauses = fmap (\RequestData{..} -> messageKindClause) reqData ++ fmap (\NotificationData{..} -> messageKindClause) notData ++ [(\CustomData{..} -> messageKindClause) customDat] + in hardvcat [docD, sigD, hardvcat clauses] + + pure $ + dataD <> + hardline <> hardline <> + mpD <> + hardline <> hardline <> + mrD <> + hardline <> hardline <> + edD <> + hardline <> hardline <> + roD <> + hardline <> hardline <> + singD <> + hardline <> hardline <> + ssmD <> + hardline <> hardline <> + toStringD <> + hardline <> hardline <> + fromStringD <> + hardline <> hardline <> + messageDirectionD <> + hardline <> hardline <> + messageKindD + +genMethods :: [Request] -> [Notification] -> CodeGenM T.Text +genMethods reqs nots = do + genModule "Method" [] Nothing (printMethods reqs nots) + +-------------- + +genLensModule :: [T.Text] -> CodeGenM T.Text +genLensModule names = do + genModule "Lens" ["TemplateHaskell"] Nothing $ do + mkLensesN <- pretty <$> entityName "Control.Lens.TH" "makeFieldsNoPrefix" + decls <- for names $ \thn -> do + nm <- pretty <$> lspEntityName (typesModSegment <> "." <> thn) thn + let lensesD = mkLensesN <+> "''" <> nm + pure $ lensesD + pure $ hardvcat decls + +--------------- + +printReExports :: [T.Text] -> ModuleGenM (Doc ann) +printReExports names = do + for_ names $ \n -> ensureImport n (As "Export") + pure mempty + +genAllModule :: [T.Text] -> CodeGenM T.Text +genAllModule names = do + genModule typesModSegment [] (Just ["module Export"]) (printReExports names) + +--------------- + +capitalize :: T.Text -> T.Text +capitalize s = T.toUpper (T.singleton (T.head s)) `T.append` T.tail s + +uncapitalize :: T.Text -> T.Text +uncapitalize s = T.toLower (T.singleton (T.head s)) `T.append` T.tail s + +hardvcat :: [Doc ann] -> Doc ann +hardvcat = concatWith (\x y -> x <> hardline <> y) + +mkIterApplicativeApp :: Doc a -> [Doc a] -> Doc a +mkIterApplicativeApp hd = go + where + go [] = "pure" <+> hd + go (a:rest) = + let acc = hd <+> "<$>" <+> a + in go' acc rest + go' acc [] = acc + go' acc (a:rest) = + let acc' = acc <+> "<*>" <+> a + in go' acc' rest + +{- Note [Code generation approach] +The approach we take here is quite primitive: we just print out Haskell modules +as strings. This ends up being better than the alternatives! + +Using TH: +- Hard to make it work reliably on all GHC versions +- Have to produce everything in a single module +- Slow compilation: the TH itself is slow, and then it produces a gigantic module + which must be compiled in one go +- Hard to debug: you have to dump splices and dig through the output + +Various other libraries for generating Haskell: +- Only support old versions of Haskell syntax (we need GADTs and type families) +- Are dubiously supported +-} + +{- Note [Translating metamodel types] + += Or types + +Or types are translated directly into anonymous unions using '(|?)'. + += And types + +And types are difficult to handle in general (it's not even clear what that means). We assume +that they contain only references to structures, and translate them as anonymous records +with the union of the fields of the components of the and type. + += Null + +We would like a type that reliably serializes to/from null, since null alternatives +are called out explicitly in the LSP spec. In the end, we just defined a specific type for +this: 'Null'. + += Enumerations + +Enumerations are compiled as simple sum types. + +Enums that allow custom values get a special extra constructor for that. + += Type aliases + +Type aliases are compiled to newtype definitions. + +The alternative would be to compile them to type aliases. It's not at all clear which +one is better, but this way is closer to how we did things before and in some cases +makes things easier (e.g. when there is a type alias for an anoymous record you get +slightly better errors before you go under the newtype). + += Structures + +Top level strutures are compiled into record datatypes. + +Properties for structures are included in the following order: +- Properties from types in 'extends' (including all their inherited properties). +- Properties from types in 'mixins' (including all their inherited properties). +- Properties defined in the struct itself. + +We insist that extended and mixed in types are references to top-level structures (it's +unclear that anything else makes sense). + +Field names for structure properties are not disambiguated: we rely on `DuplicateRecordFields`. +We generate lenses for conveniently accessing all the duplicate fields, hence +the fields themselves are prefixed with an underscore so they don't clash with the lenses. + +== Optional fields + +Optional fields are translated as 'Maybe' types. We can configure `aeson` to do the right thing +for datatypes, and for anonymous records we have our own instances in 'Data.Row.Aeson'. + +== Structure literals + +Structure literals are translated directly as anonymous records. See Note [Anonymous records]. + +== String/integer literals + +String and integer literal types are weird. They're inhabited by only that specific +string or integer. They're often used for "kind" fields i.e. to encode sum types. +We do try to represent this faithfully, so we have types 'AString' and 'AnInteger' +which behave like this. + +-} + +{- Note [Generating code for methods] +The code generation for methods is in many ways the most complicated part, +because there are some type-level parts. We follow the same basic approach as the +old way: +- A 'Method' type that represents a method, with type parameters for direction and +type (notification/request). +- A 'SMethod' singleton GADT indexed by a 'Method' that can be passed around at runtime. +- A variety of type families for mapping 'Method's to their parameter types, result types, etc. + +We also generate a few functions. The ultimate goal would be to avoid any non-generated +code having to do a full pattern match on 'Method', since it's gigantic and that's not +very maintainable. We don't quite achieve that yet. +-} + +{- Note [Absent parameters/results/errors] +Many methods don't *have* parameters/results/errors. What are we supposed to do there? +We can't say the type is 'Null', because the client will send us messages where the +value is absent, not just null. We really need a way to say the value is *absent*. + +We have a cunning trick for this: use 'Maybe Void'. That can only ever be 'Nothing', +and sine we're configuring aeson to omit 'Nothing' fields in objects, that's exactly +what we want. + +See also https://github.com/haskell/aeson/issues/646 for some relevant discussion. +-} + +{- Note [Anonymous records] +We need anonymous records in a few places. We could lift each of these to the top +level and declare a new Haskell record type for them, but this requires us to make +lots of arbitrary choices (e.g. what do we call all these new types?) and takes us +further from representing the metamodel accurately. So we instead use an actual +anonymous records library, in this case `row-types`. +-} + +{- Note [Avoiding name clashes] +It is difficult to avoid name clashes, especially since we don't control the input +source. And there are plenty of name clashes in the metamodel. +- Field names clash a lot +- Constructor names clash +- There are a few instances where constructor names clash with type names. + +One approach would be to generate lots of modules and use Haskell's module system +to disambiguate. But this would prevent us from providing large modules that +re-export things, rather we would need users to import each module that they +use individually, which would be quite tedious. That would also force us to +expose the generated module structure. + +The main thing we do is just pick non-clashing names. The crude heuristic +we have adopted is to prefix many values with the name of the type with which they +are associated, followed by an underscore. So the constructors of `X` will be +`X_A`, `X_B` etc. + +We don't do this for fields, instead we rely on `DuplicateRecordFields` and +use classy lenses. +-} diff --git a/lsp-types/generator/Main.hs b/lsp-types/generator/Main.hs new file mode 100644 index 000000000..463f33dbb --- /dev/null +++ b/lsp-types/generator/Main.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import CodeGen +import Language.LSP.MetaModel + +-- Run this from the lsp-types directory with "cabal run generator" to regenerate +-- the generated files from the metamodel. +main :: IO () +main = genFromMetaModel "Language.LSP.Protocol.Internal" "generated" metaModel diff --git a/lsp-types/lsp-types.cabal b/lsp-types/lsp-types.cabal index a457da8dc..335c6ddb2 100644 --- a/lsp-types/lsp-types.cabal +++ b/lsp-types/lsp-types.cabal @@ -1,139 +1,572 @@ -cabal-version: 2.2 -name: lsp-types -version: 1.6.0.0 -synopsis: Haskell library for the Microsoft Language Server Protocol, data types - -description: An implementation of the types to allow language implementors to - support the Language Server Protocol for their specific language. - -homepage: https://github.com/haskell/lsp -license: MIT -license-file: LICENSE -author: Alan Zimmerman -maintainer: alan.zimm@gmail.com -copyright: Alan Zimmerman, 2016-2021 -category: Development -build-type: Simple -extra-source-files: ChangeLog.md, README.md +cabal-version: 3.0 +name: lsp-types +version: 2.0.0.0 +synopsis: + Haskell library for the Microsoft Language Server Protocol, data types + +description: + An implementation of the types to allow language implementors to + support the Language Server Protocol for their specific language. + +homepage: https://github.com/haskell/lsp +license: MIT +license-file: LICENSE +author: Alan Zimmerman +maintainer: alan.zimm@gmail.com +copyright: Alan Zimmerman, 2016-2021 +category: Development +build-type: Simple +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/haskell/lsp flag force-ospath - default: False - manual: False - description: Force a version bound on filepath library, to enable 'OsPath'. + default: False + manual: False + description: + Force a version bound on filepath library, to enable 'OsPath'. library - exposed-modules: Language.LSP.Types - , Language.LSP.Types.Capabilities - , Language.LSP.Types.Lens - , Language.LSP.Types.SMethodMap - , Data.IxMap - other-modules: Language.LSP.Types.CallHierarchy - , Language.LSP.Types.Cancellation - , Language.LSP.Types.ClientCapabilities - , Language.LSP.Types.CodeAction - , Language.LSP.Types.CodeLens - , Language.LSP.Types.Command - , Language.LSP.Types.Common - , Language.LSP.Types.Completion - , Language.LSP.Types.Configuration - , Language.LSP.Types.Declaration - , Language.LSP.Types.Definition - , Language.LSP.Types.Diagnostic - , Language.LSP.Types.DocumentColor - , Language.LSP.Types.DocumentFilter - , Language.LSP.Types.DocumentHighlight - , Language.LSP.Types.DocumentLink - , Language.LSP.Types.DocumentSymbol - , Language.LSP.Types.FoldingRange - , Language.LSP.Types.Formatting - , Language.LSP.Types.Hover - , Language.LSP.Types.Implementation - , Language.LSP.Types.Initialize - , Language.LSP.Types.Location - , Language.LSP.Types.LspId - , Language.LSP.Types.MarkupContent - , Language.LSP.Types.Method - , Language.LSP.Types.Message - , Language.LSP.Types.Parsing - , Language.LSP.Types.Progress - , Language.LSP.Types.Registration - , Language.LSP.Types.References - , Language.LSP.Types.Rename - , Language.LSP.Types.SelectionRange - , Language.LSP.Types.ServerCapabilities - , Language.LSP.Types.SemanticTokens - , Language.LSP.Types.SignatureHelp - , Language.LSP.Types.StaticRegistrationOptions - , Language.LSP.Types.TextDocument - , Language.LSP.Types.TypeDefinition - , Language.LSP.Types.Uri - , Language.LSP.Types.Utils - , Language.LSP.Types.Window - , Language.LSP.Types.WatchedFiles - , Language.LSP.Types.WorkspaceEdit - , Language.LSP.Types.WorkspaceFolders - , Language.LSP.Types.WorkspaceSymbol - , Language.LSP.Types.Uri.OsPath - -- other-extensions: - ghc-options: -Wall - build-depends: base >= 4.11 && < 5 - , aeson >=1.2.2.0 - , binary - , containers - , data-default - , deepseq - , Diff >= 0.2 - , dlist - , hashable - , lens >= 4.15.2 - , mtl < 2.4 - , network-uri >= 2.6 - , mod - , scientific - , some - , text - , template-haskell - , unordered-containers - , exceptions - , safe + hs-source-dirs: src generated + default-language: Haskell2010 + -- Various things we want on by default + -- * syntactic niceties, QOL + -- * we always want more deriving options + -- * we want all data strict by default + -- * we have lots of duplicte record fields + -- * extended type class stuff particularly for the + -- lens classes + -- * fancy types for singletons etc. + default-extensions: + DataKinds + DeriveGeneric + DerivingStrategies + DerivingVia + DuplicateRecordFields + FlexibleInstances + FunctionalDependencies + GADTs + GeneralizedNewtypeDeriving + KindSignatures + MultiParamTypeClasses + NegativeLiterals + OverloadedStrings + PolyKinds + ScopedTypeVariables + StandaloneDeriving + StandaloneKindSignatures + StrictData + TypeApplications + TypeFamilies + TypeOperators + UndecidableInstances + + build-depends: + , aeson >=1.2.2.0 + , base >=4.11 && <5 + , binary + , containers + , deepseq + , Diff >=0.2 + , dlist + , hashable + , lens >=4.15.2 + , mod + , mtl <2.4 + , network-uri >=2.6 + , row-types + , safe + , some + , template-haskell + , text + if flag(force-ospath) - build-depends: filepath ^>= 1.4.100.0 + build-depends: filepath ^>=1.4.100.0 else build-depends: filepath - hs-source-dirs: src - default-language: Haskell2010 + + ghc-options: + -Wall -Wmissing-deriving-strategies + -Wno-unticked-promoted-constructors + + exposed-modules: + Data.IxMap + Data.Row.Aeson + Language.LSP.Protocol.Capabilities + Language.LSP.Protocol.Message + Language.LSP.Protocol.Types + Language.LSP.Protocol.Utils.Misc + Language.LSP.Protocol.Utils.SMethodMap + + other-modules: + Language.LSP.Protocol.Message.LspId + Language.LSP.Protocol.Message.Meta + Language.LSP.Protocol.Message.Method + Language.LSP.Protocol.Message.Parsing + Language.LSP.Protocol.Message.Registration + Language.LSP.Protocol.Message.Types + Language.LSP.Protocol.Types.Common + Language.LSP.Protocol.Types.Edit + Language.LSP.Protocol.Types.Location + Language.LSP.Protocol.Types.LspEnum + Language.LSP.Protocol.Types.MarkupContent + Language.LSP.Protocol.Types.Progress + Language.LSP.Protocol.Types.SemanticTokens + Language.LSP.Protocol.Types.Singletons + Language.LSP.Protocol.Types.Uri + Language.LSP.Protocol.Types.Uri.OsPath + + -- The generated modules + -- In principle these could be in a separate component, + -- but a) the generated modules depend on some of the common code + -- and b) some of the helper code depends on the generated modules + -- It's simpler to just have everything in together, otherwise we'd + -- actually need three layers! + other-modules: + Language.LSP.Protocol.Internal.Lens + Language.LSP.Protocol.Internal.Method + Language.LSP.Protocol.Internal.Types + Language.LSP.Protocol.Internal.Types.AnnotatedTextEdit + Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditParams + Language.LSP.Protocol.Internal.Types.ApplyWorkspaceEditResult + Language.LSP.Protocol.Internal.Types.BaseSymbolInformation + Language.LSP.Protocol.Internal.Types.CallHierarchyClientCapabilities + Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCall + Language.LSP.Protocol.Internal.Types.CallHierarchyIncomingCallsParams + Language.LSP.Protocol.Internal.Types.CallHierarchyItem + Language.LSP.Protocol.Internal.Types.CallHierarchyOptions + Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCall + Language.LSP.Protocol.Internal.Types.CallHierarchyOutgoingCallsParams + Language.LSP.Protocol.Internal.Types.CallHierarchyPrepareParams + Language.LSP.Protocol.Internal.Types.CallHierarchyRegistrationOptions + Language.LSP.Protocol.Internal.Types.CancelParams + Language.LSP.Protocol.Internal.Types.ChangeAnnotation + Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier + Language.LSP.Protocol.Internal.Types.ClientCapabilities + Language.LSP.Protocol.Internal.Types.CodeAction + Language.LSP.Protocol.Internal.Types.CodeActionClientCapabilities + Language.LSP.Protocol.Internal.Types.CodeActionContext + Language.LSP.Protocol.Internal.Types.CodeActionKind + Language.LSP.Protocol.Internal.Types.CodeActionOptions + Language.LSP.Protocol.Internal.Types.CodeActionParams + Language.LSP.Protocol.Internal.Types.CodeActionRegistrationOptions + Language.LSP.Protocol.Internal.Types.CodeActionTriggerKind + Language.LSP.Protocol.Internal.Types.CodeDescription + Language.LSP.Protocol.Internal.Types.CodeLens + Language.LSP.Protocol.Internal.Types.CodeLensClientCapabilities + Language.LSP.Protocol.Internal.Types.CodeLensOptions + Language.LSP.Protocol.Internal.Types.CodeLensParams + Language.LSP.Protocol.Internal.Types.CodeLensRegistrationOptions + Language.LSP.Protocol.Internal.Types.CodeLensWorkspaceClientCapabilities + Language.LSP.Protocol.Internal.Types.Color + Language.LSP.Protocol.Internal.Types.ColorInformation + Language.LSP.Protocol.Internal.Types.ColorPresentation + Language.LSP.Protocol.Internal.Types.ColorPresentationParams + Language.LSP.Protocol.Internal.Types.Command + Language.LSP.Protocol.Internal.Types.CompletionClientCapabilities + Language.LSP.Protocol.Internal.Types.CompletionContext + Language.LSP.Protocol.Internal.Types.CompletionItem + Language.LSP.Protocol.Internal.Types.CompletionItemKind + Language.LSP.Protocol.Internal.Types.CompletionItemLabelDetails + Language.LSP.Protocol.Internal.Types.CompletionItemTag + Language.LSP.Protocol.Internal.Types.CompletionList + Language.LSP.Protocol.Internal.Types.CompletionOptions + Language.LSP.Protocol.Internal.Types.CompletionParams + Language.LSP.Protocol.Internal.Types.CompletionRegistrationOptions + Language.LSP.Protocol.Internal.Types.CompletionTriggerKind + Language.LSP.Protocol.Internal.Types.ConfigurationItem + Language.LSP.Protocol.Internal.Types.ConfigurationParams + Language.LSP.Protocol.Internal.Types.CreateFile + Language.LSP.Protocol.Internal.Types.CreateFileOptions + Language.LSP.Protocol.Internal.Types.CreateFilesParams + Language.LSP.Protocol.Internal.Types.Declaration + Language.LSP.Protocol.Internal.Types.DeclarationClientCapabilities + Language.LSP.Protocol.Internal.Types.DeclarationLink + Language.LSP.Protocol.Internal.Types.DeclarationOptions + Language.LSP.Protocol.Internal.Types.DeclarationParams + Language.LSP.Protocol.Internal.Types.DeclarationRegistrationOptions + Language.LSP.Protocol.Internal.Types.Definition + Language.LSP.Protocol.Internal.Types.DefinitionClientCapabilities + Language.LSP.Protocol.Internal.Types.DefinitionLink + Language.LSP.Protocol.Internal.Types.DefinitionOptions + Language.LSP.Protocol.Internal.Types.DefinitionParams + Language.LSP.Protocol.Internal.Types.DefinitionRegistrationOptions + Language.LSP.Protocol.Internal.Types.DeleteFile + Language.LSP.Protocol.Internal.Types.DeleteFileOptions + Language.LSP.Protocol.Internal.Types.DeleteFilesParams + Language.LSP.Protocol.Internal.Types.Diagnostic + Language.LSP.Protocol.Internal.Types.DiagnosticClientCapabilities + Language.LSP.Protocol.Internal.Types.DiagnosticOptions + Language.LSP.Protocol.Internal.Types.DiagnosticRegistrationOptions + Language.LSP.Protocol.Internal.Types.DiagnosticRelatedInformation + Language.LSP.Protocol.Internal.Types.DiagnosticServerCancellationData + Language.LSP.Protocol.Internal.Types.DiagnosticSeverity + Language.LSP.Protocol.Internal.Types.DiagnosticTag + Language.LSP.Protocol.Internal.Types.DiagnosticWorkspaceClientCapabilities + Language.LSP.Protocol.Internal.Types.DidChangeConfigurationClientCapabilities + Language.LSP.Protocol.Internal.Types.DidChangeConfigurationParams + Language.LSP.Protocol.Internal.Types.DidChangeConfigurationRegistrationOptions + Language.LSP.Protocol.Internal.Types.DidChangeNotebookDocumentParams + Language.LSP.Protocol.Internal.Types.DidChangeTextDocumentParams + Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesClientCapabilities + Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesParams + Language.LSP.Protocol.Internal.Types.DidChangeWatchedFilesRegistrationOptions + Language.LSP.Protocol.Internal.Types.DidChangeWorkspaceFoldersParams + Language.LSP.Protocol.Internal.Types.DidCloseNotebookDocumentParams + Language.LSP.Protocol.Internal.Types.DidCloseTextDocumentParams + Language.LSP.Protocol.Internal.Types.DidOpenNotebookDocumentParams + Language.LSP.Protocol.Internal.Types.DidOpenTextDocumentParams + Language.LSP.Protocol.Internal.Types.DidSaveNotebookDocumentParams + Language.LSP.Protocol.Internal.Types.DidSaveTextDocumentParams + Language.LSP.Protocol.Internal.Types.DocumentColorClientCapabilities + Language.LSP.Protocol.Internal.Types.DocumentColorOptions + Language.LSP.Protocol.Internal.Types.DocumentColorParams + Language.LSP.Protocol.Internal.Types.DocumentColorRegistrationOptions + Language.LSP.Protocol.Internal.Types.DocumentDiagnosticParams + Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReport + Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReportKind + Language.LSP.Protocol.Internal.Types.DocumentDiagnosticReportPartialResult + Language.LSP.Protocol.Internal.Types.DocumentFilter + Language.LSP.Protocol.Internal.Types.DocumentFormattingClientCapabilities + Language.LSP.Protocol.Internal.Types.DocumentFormattingOptions + Language.LSP.Protocol.Internal.Types.DocumentFormattingParams + Language.LSP.Protocol.Internal.Types.DocumentFormattingRegistrationOptions + Language.LSP.Protocol.Internal.Types.DocumentHighlight + Language.LSP.Protocol.Internal.Types.DocumentHighlightClientCapabilities + Language.LSP.Protocol.Internal.Types.DocumentHighlightKind + Language.LSP.Protocol.Internal.Types.DocumentHighlightOptions + Language.LSP.Protocol.Internal.Types.DocumentHighlightParams + Language.LSP.Protocol.Internal.Types.DocumentHighlightRegistrationOptions + Language.LSP.Protocol.Internal.Types.DocumentLink + Language.LSP.Protocol.Internal.Types.DocumentLinkClientCapabilities + Language.LSP.Protocol.Internal.Types.DocumentLinkOptions + Language.LSP.Protocol.Internal.Types.DocumentLinkParams + Language.LSP.Protocol.Internal.Types.DocumentLinkRegistrationOptions + Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingClientCapabilities + Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingOptions + Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingParams + Language.LSP.Protocol.Internal.Types.DocumentOnTypeFormattingRegistrationOptions + Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingClientCapabilities + Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingOptions + Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingParams + Language.LSP.Protocol.Internal.Types.DocumentRangeFormattingRegistrationOptions + Language.LSP.Protocol.Internal.Types.DocumentSelector + Language.LSP.Protocol.Internal.Types.DocumentSymbol + Language.LSP.Protocol.Internal.Types.DocumentSymbolClientCapabilities + Language.LSP.Protocol.Internal.Types.DocumentSymbolOptions + Language.LSP.Protocol.Internal.Types.DocumentSymbolParams + Language.LSP.Protocol.Internal.Types.DocumentSymbolRegistrationOptions + Language.LSP.Protocol.Internal.Types.ErrorCodes + Language.LSP.Protocol.Internal.Types.ExecuteCommandClientCapabilities + Language.LSP.Protocol.Internal.Types.ExecuteCommandOptions + Language.LSP.Protocol.Internal.Types.ExecuteCommandParams + Language.LSP.Protocol.Internal.Types.ExecuteCommandRegistrationOptions + Language.LSP.Protocol.Internal.Types.ExecutionSummary + Language.LSP.Protocol.Internal.Types.FailureHandlingKind + Language.LSP.Protocol.Internal.Types.FileChangeType + Language.LSP.Protocol.Internal.Types.FileCreate + Language.LSP.Protocol.Internal.Types.FileDelete + Language.LSP.Protocol.Internal.Types.FileEvent + Language.LSP.Protocol.Internal.Types.FileOperationClientCapabilities + Language.LSP.Protocol.Internal.Types.FileOperationFilter + Language.LSP.Protocol.Internal.Types.FileOperationOptions + Language.LSP.Protocol.Internal.Types.FileOperationPattern + Language.LSP.Protocol.Internal.Types.FileOperationPatternKind + Language.LSP.Protocol.Internal.Types.FileOperationPatternOptions + Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions + Language.LSP.Protocol.Internal.Types.FileRename + Language.LSP.Protocol.Internal.Types.FileSystemWatcher + Language.LSP.Protocol.Internal.Types.FoldingRange + Language.LSP.Protocol.Internal.Types.FoldingRangeClientCapabilities + Language.LSP.Protocol.Internal.Types.FoldingRangeKind + Language.LSP.Protocol.Internal.Types.FoldingRangeOptions + Language.LSP.Protocol.Internal.Types.FoldingRangeParams + Language.LSP.Protocol.Internal.Types.FoldingRangeRegistrationOptions + Language.LSP.Protocol.Internal.Types.FormattingOptions + Language.LSP.Protocol.Internal.Types.FullDocumentDiagnosticReport + Language.LSP.Protocol.Internal.Types.GeneralClientCapabilities + Language.LSP.Protocol.Internal.Types.GlobPattern + Language.LSP.Protocol.Internal.Types.Hover + Language.LSP.Protocol.Internal.Types.HoverClientCapabilities + Language.LSP.Protocol.Internal.Types.HoverOptions + Language.LSP.Protocol.Internal.Types.HoverParams + Language.LSP.Protocol.Internal.Types.HoverRegistrationOptions + Language.LSP.Protocol.Internal.Types.ImplementationClientCapabilities + Language.LSP.Protocol.Internal.Types.ImplementationOptions + Language.LSP.Protocol.Internal.Types.ImplementationParams + Language.LSP.Protocol.Internal.Types.ImplementationRegistrationOptions + Language.LSP.Protocol.Internal.Types.InitializedParams + Language.LSP.Protocol.Internal.Types.InitializeError + Language.LSP.Protocol.Internal.Types.InitializeParams + Language.LSP.Protocol.Internal.Types.InitializeResult + Language.LSP.Protocol.Internal.Types.InlayHint + Language.LSP.Protocol.Internal.Types.InlayHintClientCapabilities + Language.LSP.Protocol.Internal.Types.InlayHintKind + Language.LSP.Protocol.Internal.Types.InlayHintLabelPart + Language.LSP.Protocol.Internal.Types.InlayHintOptions + Language.LSP.Protocol.Internal.Types.InlayHintParams + Language.LSP.Protocol.Internal.Types.InlayHintRegistrationOptions + Language.LSP.Protocol.Internal.Types.InlayHintWorkspaceClientCapabilities + Language.LSP.Protocol.Internal.Types.InlineValue + Language.LSP.Protocol.Internal.Types.InlineValueClientCapabilities + Language.LSP.Protocol.Internal.Types.InlineValueContext + Language.LSP.Protocol.Internal.Types.InlineValueEvaluatableExpression + Language.LSP.Protocol.Internal.Types.InlineValueOptions + Language.LSP.Protocol.Internal.Types.InlineValueParams + Language.LSP.Protocol.Internal.Types.InlineValueRegistrationOptions + Language.LSP.Protocol.Internal.Types.InlineValueText + Language.LSP.Protocol.Internal.Types.InlineValueVariableLookup + Language.LSP.Protocol.Internal.Types.InlineValueWorkspaceClientCapabilities + Language.LSP.Protocol.Internal.Types.InsertReplaceEdit + Language.LSP.Protocol.Internal.Types.InsertTextFormat + Language.LSP.Protocol.Internal.Types.InsertTextMode + Language.LSP.Protocol.Internal.Types.LinkedEditingRangeClientCapabilities + Language.LSP.Protocol.Internal.Types.LinkedEditingRangeOptions + Language.LSP.Protocol.Internal.Types.LinkedEditingRangeParams + Language.LSP.Protocol.Internal.Types.LinkedEditingRangeRegistrationOptions + Language.LSP.Protocol.Internal.Types.LinkedEditingRanges + Language.LSP.Protocol.Internal.Types.Location + Language.LSP.Protocol.Internal.Types.LocationLink + Language.LSP.Protocol.Internal.Types.LogMessageParams + Language.LSP.Protocol.Internal.Types.LogTraceParams + Language.LSP.Protocol.Internal.Types.LSPAny + Language.LSP.Protocol.Internal.Types.LSPArray + Language.LSP.Protocol.Internal.Types.LSPErrorCodes + Language.LSP.Protocol.Internal.Types.LSPObject + Language.LSP.Protocol.Internal.Types.MarkdownClientCapabilities + Language.LSP.Protocol.Internal.Types.MarkedString + Language.LSP.Protocol.Internal.Types.MarkupContent + Language.LSP.Protocol.Internal.Types.MarkupKind + Language.LSP.Protocol.Internal.Types.MessageActionItem + Language.LSP.Protocol.Internal.Types.MessageType + Language.LSP.Protocol.Internal.Types.Moniker + Language.LSP.Protocol.Internal.Types.MonikerClientCapabilities + Language.LSP.Protocol.Internal.Types.MonikerKind + Language.LSP.Protocol.Internal.Types.MonikerOptions + Language.LSP.Protocol.Internal.Types.MonikerParams + Language.LSP.Protocol.Internal.Types.MonikerRegistrationOptions + Language.LSP.Protocol.Internal.Types.NotebookCell + Language.LSP.Protocol.Internal.Types.NotebookCellArrayChange + Language.LSP.Protocol.Internal.Types.NotebookCellKind + Language.LSP.Protocol.Internal.Types.NotebookCellTextDocumentFilter + Language.LSP.Protocol.Internal.Types.NotebookDocument + Language.LSP.Protocol.Internal.Types.NotebookDocumentChangeEvent + Language.LSP.Protocol.Internal.Types.NotebookDocumentClientCapabilities + Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter + Language.LSP.Protocol.Internal.Types.NotebookDocumentIdentifier + Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncClientCapabilities + Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncOptions + Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncRegistrationOptions + Language.LSP.Protocol.Internal.Types.OptionalVersionedTextDocumentIdentifier + Language.LSP.Protocol.Internal.Types.ParameterInformation + Language.LSP.Protocol.Internal.Types.PartialResultParams + Language.LSP.Protocol.Internal.Types.Pattern + Language.LSP.Protocol.Internal.Types.Position + Language.LSP.Protocol.Internal.Types.PositionEncodingKind + Language.LSP.Protocol.Internal.Types.PrepareRenameParams + Language.LSP.Protocol.Internal.Types.PrepareRenameResult + Language.LSP.Protocol.Internal.Types.PrepareSupportDefaultBehavior + Language.LSP.Protocol.Internal.Types.PreviousResultId + Language.LSP.Protocol.Internal.Types.ProgressParams + Language.LSP.Protocol.Internal.Types.ProgressToken + Language.LSP.Protocol.Internal.Types.PublishDiagnosticsClientCapabilities + Language.LSP.Protocol.Internal.Types.PublishDiagnosticsParams + Language.LSP.Protocol.Internal.Types.Range + Language.LSP.Protocol.Internal.Types.ReferenceClientCapabilities + Language.LSP.Protocol.Internal.Types.ReferenceContext + Language.LSP.Protocol.Internal.Types.ReferenceOptions + Language.LSP.Protocol.Internal.Types.ReferenceParams + Language.LSP.Protocol.Internal.Types.ReferenceRegistrationOptions + Language.LSP.Protocol.Internal.Types.Registration + Language.LSP.Protocol.Internal.Types.RegistrationParams + Language.LSP.Protocol.Internal.Types.RegularExpressionsClientCapabilities + Language.LSP.Protocol.Internal.Types.RelatedFullDocumentDiagnosticReport + Language.LSP.Protocol.Internal.Types.RelatedUnchangedDocumentDiagnosticReport + Language.LSP.Protocol.Internal.Types.RelativePattern + Language.LSP.Protocol.Internal.Types.RenameClientCapabilities + Language.LSP.Protocol.Internal.Types.RenameFile + Language.LSP.Protocol.Internal.Types.RenameFileOptions + Language.LSP.Protocol.Internal.Types.RenameFilesParams + Language.LSP.Protocol.Internal.Types.RenameOptions + Language.LSP.Protocol.Internal.Types.RenameParams + Language.LSP.Protocol.Internal.Types.RenameRegistrationOptions + Language.LSP.Protocol.Internal.Types.ResourceOperation + Language.LSP.Protocol.Internal.Types.ResourceOperationKind + Language.LSP.Protocol.Internal.Types.SaveOptions + Language.LSP.Protocol.Internal.Types.SelectionRange + Language.LSP.Protocol.Internal.Types.SelectionRangeClientCapabilities + Language.LSP.Protocol.Internal.Types.SelectionRangeOptions + Language.LSP.Protocol.Internal.Types.SelectionRangeParams + Language.LSP.Protocol.Internal.Types.SelectionRangeRegistrationOptions + Language.LSP.Protocol.Internal.Types.SemanticTokenModifiers + Language.LSP.Protocol.Internal.Types.SemanticTokens + Language.LSP.Protocol.Internal.Types.SemanticTokensClientCapabilities + Language.LSP.Protocol.Internal.Types.SemanticTokensDelta + Language.LSP.Protocol.Internal.Types.SemanticTokensDeltaParams + Language.LSP.Protocol.Internal.Types.SemanticTokensDeltaPartialResult + Language.LSP.Protocol.Internal.Types.SemanticTokensEdit + Language.LSP.Protocol.Internal.Types.SemanticTokensLegend + Language.LSP.Protocol.Internal.Types.SemanticTokensOptions + Language.LSP.Protocol.Internal.Types.SemanticTokensParams + Language.LSP.Protocol.Internal.Types.SemanticTokensPartialResult + Language.LSP.Protocol.Internal.Types.SemanticTokensRangeParams + Language.LSP.Protocol.Internal.Types.SemanticTokensRegistrationOptions + Language.LSP.Protocol.Internal.Types.SemanticTokensWorkspaceClientCapabilities + Language.LSP.Protocol.Internal.Types.SemanticTokenTypes + Language.LSP.Protocol.Internal.Types.ServerCapabilities + Language.LSP.Protocol.Internal.Types.SetTraceParams + Language.LSP.Protocol.Internal.Types.ShowDocumentClientCapabilities + Language.LSP.Protocol.Internal.Types.ShowDocumentParams + Language.LSP.Protocol.Internal.Types.ShowDocumentResult + Language.LSP.Protocol.Internal.Types.ShowMessageParams + Language.LSP.Protocol.Internal.Types.ShowMessageRequestClientCapabilities + Language.LSP.Protocol.Internal.Types.ShowMessageRequestParams + Language.LSP.Protocol.Internal.Types.SignatureHelp + Language.LSP.Protocol.Internal.Types.SignatureHelpClientCapabilities + Language.LSP.Protocol.Internal.Types.SignatureHelpContext + Language.LSP.Protocol.Internal.Types.SignatureHelpOptions + Language.LSP.Protocol.Internal.Types.SignatureHelpParams + Language.LSP.Protocol.Internal.Types.SignatureHelpRegistrationOptions + Language.LSP.Protocol.Internal.Types.SignatureHelpTriggerKind + Language.LSP.Protocol.Internal.Types.SignatureInformation + Language.LSP.Protocol.Internal.Types.StaticRegistrationOptions + Language.LSP.Protocol.Internal.Types.SymbolInformation + Language.LSP.Protocol.Internal.Types.SymbolKind + Language.LSP.Protocol.Internal.Types.SymbolTag + Language.LSP.Protocol.Internal.Types.TextDocumentChangeRegistrationOptions + Language.LSP.Protocol.Internal.Types.TextDocumentClientCapabilities + Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent + Language.LSP.Protocol.Internal.Types.TextDocumentEdit + Language.LSP.Protocol.Internal.Types.TextDocumentFilter + Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier + Language.LSP.Protocol.Internal.Types.TextDocumentItem + Language.LSP.Protocol.Internal.Types.TextDocumentPositionParams + Language.LSP.Protocol.Internal.Types.TextDocumentRegistrationOptions + Language.LSP.Protocol.Internal.Types.TextDocumentSaveReason + Language.LSP.Protocol.Internal.Types.TextDocumentSaveRegistrationOptions + Language.LSP.Protocol.Internal.Types.TextDocumentSyncClientCapabilities + Language.LSP.Protocol.Internal.Types.TextDocumentSyncKind + Language.LSP.Protocol.Internal.Types.TextDocumentSyncOptions + Language.LSP.Protocol.Internal.Types.TextEdit + Language.LSP.Protocol.Internal.Types.TokenFormat + Language.LSP.Protocol.Internal.Types.TraceValues + Language.LSP.Protocol.Internal.Types.TypeDefinitionClientCapabilities + Language.LSP.Protocol.Internal.Types.TypeDefinitionOptions + Language.LSP.Protocol.Internal.Types.TypeDefinitionParams + Language.LSP.Protocol.Internal.Types.TypeDefinitionRegistrationOptions + Language.LSP.Protocol.Internal.Types.TypeHierarchyClientCapabilities + Language.LSP.Protocol.Internal.Types.TypeHierarchyItem + Language.LSP.Protocol.Internal.Types.TypeHierarchyOptions + Language.LSP.Protocol.Internal.Types.TypeHierarchyPrepareParams + Language.LSP.Protocol.Internal.Types.TypeHierarchyRegistrationOptions + Language.LSP.Protocol.Internal.Types.TypeHierarchySubtypesParams + Language.LSP.Protocol.Internal.Types.TypeHierarchySupertypesParams + Language.LSP.Protocol.Internal.Types.UInitializeParams + Language.LSP.Protocol.Internal.Types.UnchangedDocumentDiagnosticReport + Language.LSP.Protocol.Internal.Types.UniquenessLevel + Language.LSP.Protocol.Internal.Types.Unregistration + Language.LSP.Protocol.Internal.Types.UnregistrationParams + Language.LSP.Protocol.Internal.Types.VersionedNotebookDocumentIdentifier + Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier + Language.LSP.Protocol.Internal.Types.WatchKind + Language.LSP.Protocol.Internal.Types.WillSaveTextDocumentParams + Language.LSP.Protocol.Internal.Types.WindowClientCapabilities + Language.LSP.Protocol.Internal.Types.WorkDoneProgressBegin + Language.LSP.Protocol.Internal.Types.WorkDoneProgressCancelParams + Language.LSP.Protocol.Internal.Types.WorkDoneProgressCreateParams + Language.LSP.Protocol.Internal.Types.WorkDoneProgressEnd + Language.LSP.Protocol.Internal.Types.WorkDoneProgressOptions + Language.LSP.Protocol.Internal.Types.WorkDoneProgressParams + Language.LSP.Protocol.Internal.Types.WorkDoneProgressReport + Language.LSP.Protocol.Internal.Types.WorkspaceClientCapabilities + Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticParams + Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticReport + Language.LSP.Protocol.Internal.Types.WorkspaceDiagnosticReportPartialResult + Language.LSP.Protocol.Internal.Types.WorkspaceDocumentDiagnosticReport + Language.LSP.Protocol.Internal.Types.WorkspaceEdit + Language.LSP.Protocol.Internal.Types.WorkspaceEditClientCapabilities + Language.LSP.Protocol.Internal.Types.WorkspaceFolder + Language.LSP.Protocol.Internal.Types.WorkspaceFoldersChangeEvent + Language.LSP.Protocol.Internal.Types.WorkspaceFoldersInitializeParams + Language.LSP.Protocol.Internal.Types.WorkspaceFoldersServerCapabilities + Language.LSP.Protocol.Internal.Types.WorkspaceFullDocumentDiagnosticReport + Language.LSP.Protocol.Internal.Types.WorkspaceSymbol + Language.LSP.Protocol.Internal.Types.WorkspaceSymbolClientCapabilities + Language.LSP.Protocol.Internal.Types.WorkspaceSymbolOptions + Language.LSP.Protocol.Internal.Types.WorkspaceSymbolParams + Language.LSP.Protocol.Internal.Types.WorkspaceSymbolRegistrationOptions + Language.LSP.Protocol.Internal.Types.WorkspaceUnchangedDocumentDiagnosticReport + +library metamodel + -- We don't currently re-export this from the main + -- library, but it's here if people want it + visibility: public + hs-source-dirs: metamodel + default-language: Haskell2010 + default-extensions: StrictData + exposed-modules: + Language.LSP.MetaModel + Language.LSP.MetaModel.Types + + build-depends: + , aeson >=1.2.2.0 + , base >=4.11 && <5 + , file-embed + , lens >=4.15.2 + , template-haskell + , text + +executable generator + hs-source-dirs: generator + default-language: Haskell2010 default-extensions: StrictData + main-is: Main.hs + other-modules: CodeGen + build-depends: + , base >=4.11 && <5 + , containers + , directory + , filepath + , lsp-types:metamodel + , mtl + , prettyprinter + , regex + , text test-suite lsp-types-test - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Main.hs - other-modules: Spec - CapabilitiesSpec - JsonSpec - MethodSpec - ServerCapabilitiesSpec - SemanticTokensSpec - TypesSpec - URIFilePathSpec - WorkspaceEditSpec - LocationSpec - build-depends: base - , QuickCheck - -- for instance Arbitrary Value - , aeson >= 2.0.3.0 - , filepath - , hspec - , lsp-types - , lens >= 4.15.2 - , network-uri - , quickcheck-instances - , text - , tuple - build-tool-depends: hspec-discover:hspec-discover - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall - default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + default-language: Haskell2010 + main-is: Main.hs + other-modules: + CapabilitiesSpec + JsonSpec + LocationSpec + MethodSpec + SemanticTokensSpec + ServerCapabilitiesSpec + Spec + TypesSpec + URIFilePathSpec + WorkspaceEditSpec -source-repository head - type: git - location: https://github.com/haskell/lsp + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + + build-depends: + , aeson >=2.0.3.0 + , base + , filepath + , hspec + , lens >=4.15.2 + , lsp-types + , network-uri + , QuickCheck + , quickcheck-instances + , row-types + , text + + build-tool-depends: hspec-discover:hspec-discover diff --git a/lsp-types/metaModel.json b/lsp-types/metaModel.json new file mode 100644 index 000000000..52f71da3a --- /dev/null +++ b/lsp-types/metaModel.json @@ -0,0 +1,14373 @@ +{ + "metaData": { + "version": "3.17.0" + }, + "requests": [ + { + "method": "textDocument/implementation", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Definition" + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "DefinitionLink" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "ImplementationParams" + }, + "partialResult": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "Location" + } + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "DefinitionLink" + } + } + ] + }, + "registrationOptions": { + "kind": "reference", + "name": "ImplementationRegistrationOptions" + }, + "documentation": "A request to resolve the implementation locations of a symbol at a given text\ndocument position. The request's parameter is of type [TextDocumentPositionParams]\n(#TextDocumentPositionParams) the response is of type {@link Definition} or a\nThenable that resolves to such." + }, + { + "method": "textDocument/typeDefinition", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Definition" + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "DefinitionLink" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "TypeDefinitionParams" + }, + "partialResult": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "Location" + } + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "DefinitionLink" + } + } + ] + }, + "registrationOptions": { + "kind": "reference", + "name": "TypeDefinitionRegistrationOptions" + }, + "documentation": "A request to resolve the type definition locations of a symbol at a given text\ndocument position. The request's parameter is of type [TextDocumentPositionParams]\n(#TextDocumentPositionParams) the response is of type {@link Definition} or a\nThenable that resolves to such." + }, + { + "method": "workspace/workspaceFolders", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "WorkspaceFolder" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "serverToClient", + "documentation": "The `workspace/workspaceFolders` is sent from the server to the client to fetch the open workspace folders." + }, + { + "method": "workspace/configuration", + "result": { + "kind": "array", + "element": { + "kind": "reference", + "name": "LSPAny" + } + }, + "messageDirection": "serverToClient", + "params": { + "kind": "reference", + "name": "ConfigurationParams" + }, + "documentation": "The 'workspace/configuration' request is sent from the server to the client to fetch a certain\nconfiguration setting.\n\nThis pull model replaces the old push model were the client signaled configuration change via an\nevent. If the server still needs to react to configuration changes (since the server caches the\nresult of `workspace/configuration` requests) the server should register for an empty configuration\nchange event and empty the cache if such an event is received." + }, + { + "method": "textDocument/documentColor", + "result": { + "kind": "array", + "element": { + "kind": "reference", + "name": "ColorInformation" + } + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DocumentColorParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "ColorInformation" + } + }, + "registrationOptions": { + "kind": "reference", + "name": "DocumentColorRegistrationOptions" + }, + "documentation": "A request to list all color symbols found in a given text document. The request's\nparameter is of type {@link DocumentColorParams} the\nresponse is of type {@link ColorInformation ColorInformation[]} or a Thenable\nthat resolves to such." + }, + { + "method": "textDocument/colorPresentation", + "result": { + "kind": "array", + "element": { + "kind": "reference", + "name": "ColorPresentation" + } + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "ColorPresentationParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "ColorPresentation" + } + }, + "registrationOptions": { + "kind": "and", + "items": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + }, + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + } + ] + }, + "documentation": "A request to list all presentation for a color. The request's\nparameter is of type {@link ColorPresentationParams} the\nresponse is of type {@link ColorInformation ColorInformation[]} or a Thenable\nthat resolves to such." + }, + { + "method": "textDocument/foldingRange", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "FoldingRange" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "FoldingRangeParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "FoldingRange" + } + }, + "registrationOptions": { + "kind": "reference", + "name": "FoldingRangeRegistrationOptions" + }, + "documentation": "A request to provide folding ranges in a document. The request's\nparameter is of type {@link FoldingRangeParams}, the\nresponse is of type {@link FoldingRangeList} or a Thenable\nthat resolves to such." + }, + { + "method": "textDocument/declaration", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Declaration" + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "DeclarationLink" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DeclarationParams" + }, + "partialResult": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "Location" + } + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "DeclarationLink" + } + } + ] + }, + "registrationOptions": { + "kind": "reference", + "name": "DeclarationRegistrationOptions" + }, + "documentation": "A request to resolve the type definition locations of a symbol at a given text\ndocument position. The request's parameter is of type [TextDocumentPositionParams]\n(#TextDocumentPositionParams) the response is of type {@link Declaration}\nor a typed array of {@link DeclarationLink} or a Thenable that resolves\nto such." + }, + { + "method": "textDocument/selectionRange", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "SelectionRange" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "SelectionRangeParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "SelectionRange" + } + }, + "registrationOptions": { + "kind": "reference", + "name": "SelectionRangeRegistrationOptions" + }, + "documentation": "A request to provide selection ranges in a document. The request's\nparameter is of type {@link SelectionRangeParams}, the\nresponse is of type {@link SelectionRange SelectionRange[]} or a Thenable\nthat resolves to such." + }, + { + "method": "window/workDoneProgress/create", + "result": { + "kind": "base", + "name": "null" + }, + "messageDirection": "serverToClient", + "params": { + "kind": "reference", + "name": "WorkDoneProgressCreateParams" + }, + "documentation": "The `window/workDoneProgress/create` request is sent from the server to the client to initiate progress\nreporting from the server." + }, + { + "method": "textDocument/prepareCallHierarchy", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "CallHierarchyItem" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "CallHierarchyPrepareParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "CallHierarchyRegistrationOptions" + }, + "documentation": "A request to result a `CallHierarchyItem` in a document at a given position.\nCan be used as an input to an incoming or outgoing call hierarchy.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "callHierarchy/incomingCalls", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "CallHierarchyIncomingCall" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "CallHierarchyIncomingCallsParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "CallHierarchyIncomingCall" + } + }, + "documentation": "A request to resolve the incoming calls for a given `CallHierarchyItem`.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "callHierarchy/outgoingCalls", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "CallHierarchyOutgoingCall" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "CallHierarchyOutgoingCallsParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "CallHierarchyOutgoingCall" + } + }, + "documentation": "A request to resolve the outgoing calls for a given `CallHierarchyItem`.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "textDocument/semanticTokens/full", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "SemanticTokens" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "SemanticTokensParams" + }, + "partialResult": { + "kind": "reference", + "name": "SemanticTokensPartialResult" + }, + "registrationMethod": "textDocument/semanticTokens", + "registrationOptions": { + "kind": "reference", + "name": "SemanticTokensRegistrationOptions" + }, + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "textDocument/semanticTokens/full/delta", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "SemanticTokens" + }, + { + "kind": "reference", + "name": "SemanticTokensDelta" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "SemanticTokensDeltaParams" + }, + "partialResult": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "SemanticTokensPartialResult" + }, + { + "kind": "reference", + "name": "SemanticTokensDeltaPartialResult" + } + ] + }, + "registrationMethod": "textDocument/semanticTokens", + "registrationOptions": { + "kind": "reference", + "name": "SemanticTokensRegistrationOptions" + }, + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "textDocument/semanticTokens/range", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "SemanticTokens" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "SemanticTokensRangeParams" + }, + "partialResult": { + "kind": "reference", + "name": "SemanticTokensPartialResult" + }, + "registrationMethod": "textDocument/semanticTokens", + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "workspace/semanticTokens/refresh", + "result": { + "kind": "base", + "name": "null" + }, + "messageDirection": "serverToClient", + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "window/showDocument", + "result": { + "kind": "reference", + "name": "ShowDocumentResult" + }, + "messageDirection": "serverToClient", + "params": { + "kind": "reference", + "name": "ShowDocumentParams" + }, + "documentation": "A request to show a document. This request might open an\nexternal program depending on the value of the URI to open.\nFor example a request to open `https://code.visualstudio.com/`\nwill very likely open the URI in a WEB browser.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "textDocument/linkedEditingRange", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "LinkedEditingRanges" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "LinkedEditingRangeParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "LinkedEditingRangeRegistrationOptions" + }, + "documentation": "A request to provide ranges that can be edited together.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "workspace/willCreateFiles", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "WorkspaceEdit" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "CreateFilesParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "FileOperationRegistrationOptions" + }, + "documentation": "The will create files request is sent from the client to the server before files are actually\ncreated as long as the creation is triggered from within the client.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "workspace/willRenameFiles", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "WorkspaceEdit" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "RenameFilesParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "FileOperationRegistrationOptions" + }, + "documentation": "The will rename files request is sent from the client to the server before files are actually\nrenamed as long as the rename is triggered from within the client.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "workspace/willDeleteFiles", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "WorkspaceEdit" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DeleteFilesParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "FileOperationRegistrationOptions" + }, + "documentation": "The did delete files notification is sent from the client to the server when\nfiles were deleted from within the client.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "textDocument/moniker", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "Moniker" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "MonikerParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "Moniker" + } + }, + "registrationOptions": { + "kind": "reference", + "name": "MonikerRegistrationOptions" + }, + "documentation": "A request to get the moniker of a symbol at a given text document position.\nThe request parameter is of type {@link TextDocumentPositionParams}.\nThe response is of type {@link Moniker Moniker[]} or `null`." + }, + { + "method": "textDocument/prepareTypeHierarchy", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "TypeHierarchyItem" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "TypeHierarchyPrepareParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "TypeHierarchyRegistrationOptions" + }, + "documentation": "A request to result a `TypeHierarchyItem` in a document at a given position.\nCan be used as an input to a subtypes or supertypes type hierarchy.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "typeHierarchy/supertypes", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "TypeHierarchyItem" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "TypeHierarchySupertypesParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TypeHierarchyItem" + } + }, + "documentation": "A request to resolve the supertypes for a given `TypeHierarchyItem`.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "typeHierarchy/subtypes", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "TypeHierarchyItem" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "TypeHierarchySubtypesParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TypeHierarchyItem" + } + }, + "documentation": "A request to resolve the subtypes for a given `TypeHierarchyItem`.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "textDocument/inlineValue", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "InlineValue" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "InlineValueParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "InlineValue" + } + }, + "registrationOptions": { + "kind": "reference", + "name": "InlineValueRegistrationOptions" + }, + "documentation": "A request to provide inline values in a document. The request's parameter is of\ntype {@link InlineValueParams}, the response is of type\n{@link InlineValue InlineValue[]} or a Thenable that resolves to such.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "workspace/inlineValue/refresh", + "result": { + "kind": "base", + "name": "null" + }, + "messageDirection": "serverToClient", + "documentation": "@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "textDocument/inlayHint", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "InlayHint" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "InlayHintParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "InlayHint" + } + }, + "registrationOptions": { + "kind": "reference", + "name": "InlayHintRegistrationOptions" + }, + "documentation": "A request to provide inlay hints in a document. The request's parameter is of\ntype {@link InlayHintsParams}, the response is of type\n{@link InlayHint InlayHint[]} or a Thenable that resolves to such.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "inlayHint/resolve", + "result": { + "kind": "reference", + "name": "InlayHint" + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "InlayHint" + }, + "documentation": "A request to resolve additional properties for an inlay hint.\nThe request's parameter is of type {@link InlayHint}, the response is\nof type {@link InlayHint} or a Thenable that resolves to such.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "workspace/inlayHint/refresh", + "result": { + "kind": "base", + "name": "null" + }, + "messageDirection": "serverToClient", + "documentation": "@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "textDocument/diagnostic", + "result": { + "kind": "reference", + "name": "DocumentDiagnosticReport" + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DocumentDiagnosticParams" + }, + "partialResult": { + "kind": "reference", + "name": "DocumentDiagnosticReportPartialResult" + }, + "errorData": { + "kind": "reference", + "name": "DiagnosticServerCancellationData" + }, + "registrationOptions": { + "kind": "reference", + "name": "DiagnosticRegistrationOptions" + }, + "documentation": "The document diagnostic request definition.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "workspace/diagnostic", + "result": { + "kind": "reference", + "name": "WorkspaceDiagnosticReport" + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "WorkspaceDiagnosticParams" + }, + "partialResult": { + "kind": "reference", + "name": "WorkspaceDiagnosticReportPartialResult" + }, + "errorData": { + "kind": "reference", + "name": "DiagnosticServerCancellationData" + }, + "documentation": "The workspace diagnostic request definition.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "workspace/diagnostic/refresh", + "result": { + "kind": "base", + "name": "null" + }, + "messageDirection": "serverToClient", + "documentation": "The diagnostic refresh request definition.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "client/registerCapability", + "result": { + "kind": "base", + "name": "null" + }, + "messageDirection": "serverToClient", + "params": { + "kind": "reference", + "name": "RegistrationParams" + }, + "documentation": "The `client/registerCapability` request is sent from the server to the client to register a new capability\nhandler on the client side." + }, + { + "method": "client/unregisterCapability", + "result": { + "kind": "base", + "name": "null" + }, + "messageDirection": "serverToClient", + "params": { + "kind": "reference", + "name": "UnregistrationParams" + }, + "documentation": "The `client/unregisterCapability` request is sent from the server to the client to unregister a previously registered capability\nhandler on the client side." + }, + { + "method": "initialize", + "result": { + "kind": "reference", + "name": "InitializeResult" + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "InitializeParams" + }, + "errorData": { + "kind": "reference", + "name": "InitializeError" + }, + "documentation": "The initialize request is sent from the client to the server.\nIt is sent once as the request after starting up the server.\nThe requests parameter is of type {@link InitializeParams}\nthe response if of type {@link InitializeResult} of a Thenable that\nresolves to such." + }, + { + "method": "shutdown", + "result": { + "kind": "base", + "name": "null" + }, + "messageDirection": "clientToServer", + "documentation": "A shutdown request is sent from the client to the server.\nIt is sent once when the client decides to shutdown the\nserver. The only notification that is sent after a shutdown request\nis the exit event." + }, + { + "method": "window/showMessageRequest", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "MessageActionItem" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "serverToClient", + "params": { + "kind": "reference", + "name": "ShowMessageRequestParams" + }, + "documentation": "The show message request is sent from the server to the client to show a message\nand a set of options actions to the user." + }, + { + "method": "textDocument/willSaveWaitUntil", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextEdit" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "WillSaveTextDocumentParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + "documentation": "A document will save request is sent from the client to the server before\nthe document is actually saved. The request can return an array of TextEdits\nwhich will be applied to the text document before it is saved. Please note that\nclients might drop results if computing the text edits took too long or if a\nserver constantly fails on this request. This is done to keep the save fast and\nreliable." + }, + { + "method": "textDocument/completion", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "CompletionItem" + } + }, + { + "kind": "reference", + "name": "CompletionList" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "CompletionParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "CompletionItem" + } + }, + "registrationOptions": { + "kind": "reference", + "name": "CompletionRegistrationOptions" + }, + "documentation": "Request to request completion at a given text document position. The request's\nparameter is of type {@link TextDocumentPosition} the response\nis of type {@link CompletionItem CompletionItem[]} or {@link CompletionList}\nor a Thenable that resolves to such.\n\nThe request can delay the computation of the {@link CompletionItem.detail `detail`}\nand {@link CompletionItem.documentation `documentation`} properties to the `completionItem/resolve`\nrequest. However, properties that are needed for the initial sorting and filtering, like `sortText`,\n`filterText`, `insertText`, and `textEdit`, must not be changed during resolve." + }, + { + "method": "completionItem/resolve", + "result": { + "kind": "reference", + "name": "CompletionItem" + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "CompletionItem" + }, + "documentation": "Request to resolve additional information for a given completion item.The request's\nparameter is of type {@link CompletionItem} the response\nis of type {@link CompletionItem} or a Thenable that resolves to such." + }, + { + "method": "textDocument/hover", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Hover" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "HoverParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "HoverRegistrationOptions" + }, + "documentation": "Request to request hover information at a given text document position. The request's\nparameter is of type {@link TextDocumentPosition} the response is of\ntype {@link Hover} or a Thenable that resolves to such." + }, + { + "method": "textDocument/signatureHelp", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "SignatureHelp" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "SignatureHelpParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "SignatureHelpRegistrationOptions" + } + }, + { + "method": "textDocument/definition", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Definition" + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "DefinitionLink" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DefinitionParams" + }, + "partialResult": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "Location" + } + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "DefinitionLink" + } + } + ] + }, + "registrationOptions": { + "kind": "reference", + "name": "DefinitionRegistrationOptions" + }, + "documentation": "A request to resolve the definition location of a symbol at a given text\ndocument position. The request's parameter is of type [TextDocumentPosition]\n(#TextDocumentPosition) the response is of either type {@link Definition}\nor a typed array of {@link DefinitionLink} or a Thenable that resolves\nto such." + }, + { + "method": "textDocument/references", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "Location" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "ReferenceParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "Location" + } + }, + "registrationOptions": { + "kind": "reference", + "name": "ReferenceRegistrationOptions" + }, + "documentation": "A request to resolve project-wide references for the symbol denoted\nby the given text document position. The request's parameter is of\ntype {@link ReferenceParams} the response is of type\n{@link Location Location[]} or a Thenable that resolves to such." + }, + { + "method": "textDocument/documentHighlight", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "DocumentHighlight" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DocumentHighlightParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "DocumentHighlight" + } + }, + "registrationOptions": { + "kind": "reference", + "name": "DocumentHighlightRegistrationOptions" + }, + "documentation": "Request to resolve a {@link DocumentHighlight} for a given\ntext document position. The request's parameter is of type [TextDocumentPosition]\n(#TextDocumentPosition) the request response is of type [DocumentHighlight[]]\n(#DocumentHighlight) or a Thenable that resolves to such." + }, + { + "method": "textDocument/documentSymbol", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "SymbolInformation" + } + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "DocumentSymbol" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DocumentSymbolParams" + }, + "partialResult": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "SymbolInformation" + } + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "DocumentSymbol" + } + } + ] + }, + "registrationOptions": { + "kind": "reference", + "name": "DocumentSymbolRegistrationOptions" + }, + "documentation": "A request to list all symbols found in a given text document. The request's\nparameter is of type {@link TextDocumentIdentifier} the\nresponse is of type {@link SymbolInformation SymbolInformation[]} or a Thenable\nthat resolves to such." + }, + { + "method": "textDocument/codeAction", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Command" + }, + { + "kind": "reference", + "name": "CodeAction" + } + ] + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "CodeActionParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Command" + }, + { + "kind": "reference", + "name": "CodeAction" + } + ] + } + }, + "registrationOptions": { + "kind": "reference", + "name": "CodeActionRegistrationOptions" + }, + "documentation": "A request to provide commands for the given text document and range." + }, + { + "method": "codeAction/resolve", + "result": { + "kind": "reference", + "name": "CodeAction" + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "CodeAction" + }, + "documentation": "Request to resolve additional information for a given code action.The request's\nparameter is of type {@link CodeAction} the response\nis of type {@link CodeAction} or a Thenable that resolves to such." + }, + { + "method": "workspace/symbol", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "SymbolInformation" + } + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "WorkspaceSymbol" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "WorkspaceSymbolParams" + }, + "partialResult": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "SymbolInformation" + } + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "WorkspaceSymbol" + } + } + ] + }, + "registrationOptions": { + "kind": "reference", + "name": "WorkspaceSymbolRegistrationOptions" + }, + "documentation": "A request to list project-wide symbols matching the query string given\nby the {@link WorkspaceSymbolParams}. The response is\nof type {@link SymbolInformation SymbolInformation[]} or a Thenable that\nresolves to such.\n\n@since 3.17.0 - support for WorkspaceSymbol in the returned data. Clients\n need to advertise support for WorkspaceSymbols via the client capability\n `workspace.symbol.resolveSupport`.\n", + "since": "3.17.0 - support for WorkspaceSymbol in the returned data. Clients\nneed to advertise support for WorkspaceSymbols via the client capability\n`workspace.symbol.resolveSupport`." + }, + { + "method": "workspaceSymbol/resolve", + "result": { + "kind": "reference", + "name": "WorkspaceSymbol" + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "WorkspaceSymbol" + }, + "documentation": "A request to resolve the range inside the workspace\nsymbol's location.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "textDocument/codeLens", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "CodeLens" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "CodeLensParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "CodeLens" + } + }, + "registrationOptions": { + "kind": "reference", + "name": "CodeLensRegistrationOptions" + }, + "documentation": "A request to provide code lens for the given text document." + }, + { + "method": "codeLens/resolve", + "result": { + "kind": "reference", + "name": "CodeLens" + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "CodeLens" + }, + "documentation": "A request to resolve a command for a given code lens." + }, + { + "method": "workspace/codeLens/refresh", + "result": { + "kind": "base", + "name": "null" + }, + "messageDirection": "serverToClient", + "documentation": "A request to refresh all code actions\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "textDocument/documentLink", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "DocumentLink" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DocumentLinkParams" + }, + "partialResult": { + "kind": "array", + "element": { + "kind": "reference", + "name": "DocumentLink" + } + }, + "registrationOptions": { + "kind": "reference", + "name": "DocumentLinkRegistrationOptions" + }, + "documentation": "A request to provide document links" + }, + { + "method": "documentLink/resolve", + "result": { + "kind": "reference", + "name": "DocumentLink" + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DocumentLink" + }, + "documentation": "Request to resolve additional information for a given document link. The request's\nparameter is of type {@link DocumentLink} the response\nis of type {@link DocumentLink} or a Thenable that resolves to such." + }, + { + "method": "textDocument/formatting", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextEdit" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DocumentFormattingParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "DocumentFormattingRegistrationOptions" + }, + "documentation": "A request to to format a whole document." + }, + { + "method": "textDocument/rangeFormatting", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextEdit" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DocumentRangeFormattingParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "DocumentRangeFormattingRegistrationOptions" + }, + "documentation": "A request to to format a range in a document." + }, + { + "method": "textDocument/onTypeFormatting", + "result": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextEdit" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DocumentOnTypeFormattingParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "DocumentOnTypeFormattingRegistrationOptions" + }, + "documentation": "A request to format a document on type." + }, + { + "method": "textDocument/rename", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "WorkspaceEdit" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "RenameParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "RenameRegistrationOptions" + }, + "documentation": "A request to rename a symbol." + }, + { + "method": "textDocument/prepareRename", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "PrepareRenameResult" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "PrepareRenameParams" + }, + "documentation": "A request to test and perform the setup necessary for a rename.\n\n@since 3.16 - support for default behavior", + "since": "3.16 - support for default behavior" + }, + { + "method": "workspace/executeCommand", + "result": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "LSPAny" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "ExecuteCommandParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "ExecuteCommandRegistrationOptions" + }, + "documentation": "A request send from the client to the server to execute a command. The request might return\na workspace edit which the client will apply to the workspace." + }, + { + "method": "workspace/applyEdit", + "result": { + "kind": "reference", + "name": "ApplyWorkspaceEditResult" + }, + "messageDirection": "serverToClient", + "params": { + "kind": "reference", + "name": "ApplyWorkspaceEditParams" + }, + "documentation": "A request sent from the server to the client to modified certain resources." + } + ], + "notifications": [ + { + "method": "workspace/didChangeWorkspaceFolders", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DidChangeWorkspaceFoldersParams" + }, + "documentation": "The `workspace/didChangeWorkspaceFolders` notification is sent from the client to the server when the workspace\nfolder configuration changes." + }, + { + "method": "window/workDoneProgress/cancel", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "WorkDoneProgressCancelParams" + }, + "documentation": "The `window/workDoneProgress/cancel` notification is sent from the client to the server to cancel a progress\ninitiated on the server side." + }, + { + "method": "workspace/didCreateFiles", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "CreateFilesParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "FileOperationRegistrationOptions" + }, + "documentation": "The did create files notification is sent from the client to the server when\nfiles were created from within the client.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "workspace/didRenameFiles", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "RenameFilesParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "FileOperationRegistrationOptions" + }, + "documentation": "The did rename files notification is sent from the client to the server when\nfiles were renamed from within the client.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "workspace/didDeleteFiles", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DeleteFilesParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "FileOperationRegistrationOptions" + }, + "documentation": "The will delete files request is sent from the client to the server before files are actually\ndeleted as long as the deletion is triggered from within the client.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "method": "notebookDocument/didOpen", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DidOpenNotebookDocumentParams" + }, + "registrationMethod": "notebookDocument/sync", + "documentation": "A notification sent when a notebook opens.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "notebookDocument/didChange", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DidChangeNotebookDocumentParams" + }, + "registrationMethod": "notebookDocument/sync" + }, + { + "method": "notebookDocument/didSave", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DidSaveNotebookDocumentParams" + }, + "registrationMethod": "notebookDocument/sync", + "documentation": "A notification sent when a notebook document is saved.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "notebookDocument/didClose", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DidCloseNotebookDocumentParams" + }, + "registrationMethod": "notebookDocument/sync", + "documentation": "A notification sent when a notebook closes.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "method": "initialized", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "InitializedParams" + }, + "documentation": "The initialized notification is sent from the client to the\nserver after the client is fully initialized and the server\nis allowed to send requests from the server to the client." + }, + { + "method": "exit", + "messageDirection": "clientToServer", + "documentation": "The exit event is sent from the client to the server to\nask the server to exit its process." + }, + { + "method": "workspace/didChangeConfiguration", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DidChangeConfigurationParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "DidChangeConfigurationRegistrationOptions" + }, + "documentation": "The configuration change notification is sent from the client to the server\nwhen the client's configuration has changed. The notification contains\nthe changed configuration as defined by the language client." + }, + { + "method": "window/showMessage", + "messageDirection": "serverToClient", + "params": { + "kind": "reference", + "name": "ShowMessageParams" + }, + "documentation": "The show message notification is sent from a server to a client to ask\nthe client to display a particular message in the user interface." + }, + { + "method": "window/logMessage", + "messageDirection": "serverToClient", + "params": { + "kind": "reference", + "name": "LogMessageParams" + }, + "documentation": "The log message notification is sent from the server to the client to ask\nthe client to log a particular message." + }, + { + "method": "telemetry/event", + "messageDirection": "serverToClient", + "params": { + "kind": "reference", + "name": "LSPAny" + }, + "documentation": "The telemetry event notification is sent from the server to the client to ask\nthe client to log telemetry data." + }, + { + "method": "textDocument/didOpen", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DidOpenTextDocumentParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + "documentation": "The document open notification is sent from the client to the server to signal\nnewly opened text documents. The document's truth is now managed by the client\nand the server must not try to read the document's truth using the document's\nuri. Open in this sense means it is managed by the client. It doesn't necessarily\nmean that its content is presented in an editor. An open notification must not\nbe sent more than once without a corresponding close notification send before.\nThis means open and close notification must be balanced and the max open count\nis one." + }, + { + "method": "textDocument/didChange", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DidChangeTextDocumentParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "TextDocumentChangeRegistrationOptions" + }, + "documentation": "The document change notification is sent from the client to the server to signal\nchanges to a text document." + }, + { + "method": "textDocument/didClose", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DidCloseTextDocumentParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + "documentation": "The document close notification is sent from the client to the server when\nthe document got closed in the client. The document's truth now exists where\nthe document's uri points to (e.g. if the document's uri is a file uri the\ntruth now exists on disk). As with the open notification the close notification\nis about managing the document's content. Receiving a close notification\ndoesn't mean that the document was open in an editor before. A close\nnotification requires a previous open notification to be sent." + }, + { + "method": "textDocument/didSave", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DidSaveTextDocumentParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "TextDocumentSaveRegistrationOptions" + }, + "documentation": "The document save notification is sent from the client to the server when\nthe document got saved in the client." + }, + { + "method": "textDocument/willSave", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "WillSaveTextDocumentParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + "documentation": "A document will save notification is sent from the client to the server before\nthe document is actually saved." + }, + { + "method": "workspace/didChangeWatchedFiles", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "DidChangeWatchedFilesParams" + }, + "registrationOptions": { + "kind": "reference", + "name": "DidChangeWatchedFilesRegistrationOptions" + }, + "documentation": "The watched files notification is sent from the client to the server when\nthe client detects changes to file watched by the language client." + }, + { + "method": "textDocument/publishDiagnostics", + "messageDirection": "serverToClient", + "params": { + "kind": "reference", + "name": "PublishDiagnosticsParams" + }, + "documentation": "Diagnostics notification are sent from the server to the client to signal\nresults of validation runs." + }, + { + "method": "$/setTrace", + "messageDirection": "clientToServer", + "params": { + "kind": "reference", + "name": "SetTraceParams" + } + }, + { + "method": "$/logTrace", + "messageDirection": "serverToClient", + "params": { + "kind": "reference", + "name": "LogTraceParams" + } + }, + { + "method": "$/cancelRequest", + "messageDirection": "both", + "params": { + "kind": "reference", + "name": "CancelParams" + } + }, + { + "method": "$/progress", + "messageDirection": "both", + "params": { + "kind": "reference", + "name": "ProgressParams" + } + } + ], + "structures": [ + { + "name": "ImplementationParams", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ] + }, + { + "name": "Location", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + } + }, + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + } + } + ], + "documentation": "Represents a location inside a resource, such as a line\ninside a text file." + }, + { + "name": "ImplementationRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "ImplementationOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ] + }, + { + "name": "TypeDefinitionParams", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ] + }, + { + "name": "TypeDefinitionRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "TypeDefinitionOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ] + }, + { + "name": "WorkspaceFolder", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "URI" + }, + "documentation": "The associated URI for this workspace folder." + }, + { + "name": "name", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The name of the workspace folder. Used to refer to this\nworkspace folder in the user interface." + } + ], + "documentation": "A workspace folder inside a client." + }, + { + "name": "DidChangeWorkspaceFoldersParams", + "properties": [ + { + "name": "event", + "type": { + "kind": "reference", + "name": "WorkspaceFoldersChangeEvent" + }, + "documentation": "The actual workspace folder change event." + } + ], + "documentation": "The parameters of a `workspace/didChangeWorkspaceFolders` notification." + }, + { + "name": "ConfigurationParams", + "properties": [ + { + "name": "items", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "ConfigurationItem" + } + } + } + ], + "documentation": "The parameters of a configuration request." + }, + { + "name": "DocumentColorParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The text document." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "Parameters for a {@link DocumentColorRequest}." + }, + { + "name": "ColorInformation", + "properties": [ + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range in the document where this color appears." + }, + { + "name": "color", + "type": { + "kind": "reference", + "name": "Color" + }, + "documentation": "The actual color value for this color range." + } + ], + "documentation": "Represents a color range from a document." + }, + { + "name": "DocumentColorRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "DocumentColorOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ] + }, + { + "name": "ColorPresentationParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The text document." + }, + { + "name": "color", + "type": { + "kind": "reference", + "name": "Color" + }, + "documentation": "The color to request presentations for." + }, + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range where the color would be inserted. Serves as a context." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "Parameters for a {@link ColorPresentationRequest}." + }, + { + "name": "ColorPresentation", + "properties": [ + { + "name": "label", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The label of this color presentation. It will be shown on the color\npicker header. By default this is also the text that is inserted when selecting\nthis color presentation." + }, + { + "name": "textEdit", + "type": { + "kind": "reference", + "name": "TextEdit" + }, + "optional": true, + "documentation": "An {@link TextEdit edit} which is applied to a document when selecting\nthis presentation for the color. When `falsy` the {@link ColorPresentation.label label}\nis used." + }, + { + "name": "additionalTextEdits", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextEdit" + } + }, + "optional": true, + "documentation": "An optional array of additional {@link TextEdit text edits} that are applied when\nselecting this color presentation. Edits must not overlap with the main {@link ColorPresentation.textEdit edit} nor with themselves." + } + ] + }, + { + "name": "WorkDoneProgressOptions", + "properties": [ + { + "name": "workDoneProgress", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true + } + ] + }, + { + "name": "TextDocumentRegistrationOptions", + "properties": [ + { + "name": "documentSelector", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "DocumentSelector" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "documentation": "A document selector to identify the scope of the registration. If set to null\nthe document selector provided on the client side will be used." + } + ], + "documentation": "General text document registration options." + }, + { + "name": "FoldingRangeParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The text document." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "Parameters for a {@link FoldingRangeRequest}." + }, + { + "name": "FoldingRange", + "properties": [ + { + "name": "startLine", + "type": { + "kind": "base", + "name": "uinteger" + }, + "documentation": "The zero-based start line of the range to fold. The folded area starts after the line's last character.\nTo be valid, the end must be zero or larger and smaller than the number of lines in the document." + }, + { + "name": "startCharacter", + "type": { + "kind": "base", + "name": "uinteger" + }, + "optional": true, + "documentation": "The zero-based character offset from where the folded range starts. If not defined, defaults to the length of the start line." + }, + { + "name": "endLine", + "type": { + "kind": "base", + "name": "uinteger" + }, + "documentation": "The zero-based end line of the range to fold. The folded area ends with the line's last character.\nTo be valid, the end must be zero or larger and smaller than the number of lines in the document." + }, + { + "name": "endCharacter", + "type": { + "kind": "base", + "name": "uinteger" + }, + "optional": true, + "documentation": "The zero-based character offset before the folded range ends. If not defined, defaults to the length of the end line." + }, + { + "name": "kind", + "type": { + "kind": "reference", + "name": "FoldingRangeKind" + }, + "optional": true, + "documentation": "Describes the kind of the folding range such as `comment' or 'region'. The kind\nis used to categorize folding ranges and used by commands like 'Fold all comments'.\nSee {@link FoldingRangeKind} for an enumeration of standardized kinds." + }, + { + "name": "collapsedText", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The text that the client should show when the specified range is\ncollapsed. If not defined or not supported by the client, a default\nwill be chosen by the client.\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "documentation": "Represents a folding range. To be valid, start and end line must be bigger than zero and smaller\nthan the number of lines in the document. Clients are free to ignore invalid ranges." + }, + { + "name": "FoldingRangeRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "FoldingRangeOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ] + }, + { + "name": "DeclarationParams", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ] + }, + { + "name": "DeclarationRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "DeclarationOptions" + }, + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ] + }, + { + "name": "SelectionRangeParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The text document." + }, + { + "name": "positions", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "Position" + } + }, + "documentation": "The positions inside the text document." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "A parameter literal used in selection range requests." + }, + { + "name": "SelectionRange", + "properties": [ + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The {@link Range range} of this selection range." + }, + { + "name": "parent", + "type": { + "kind": "reference", + "name": "SelectionRange" + }, + "optional": true, + "documentation": "The parent selection range containing this range. Therefore `parent.range` must contain `this.range`." + } + ], + "documentation": "A selection range represents a part of a selection hierarchy. A selection range\nmay have a parent selection range that contains it." + }, + { + "name": "SelectionRangeRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "SelectionRangeOptions" + }, + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ] + }, + { + "name": "WorkDoneProgressCreateParams", + "properties": [ + { + "name": "token", + "type": { + "kind": "reference", + "name": "ProgressToken" + }, + "documentation": "The token to be used to report progress." + } + ] + }, + { + "name": "WorkDoneProgressCancelParams", + "properties": [ + { + "name": "token", + "type": { + "kind": "reference", + "name": "ProgressToken" + }, + "documentation": "The token to be used to report progress." + } + ] + }, + { + "name": "CallHierarchyPrepareParams", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ], + "documentation": "The parameter of a `textDocument/prepareCallHierarchy` request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "CallHierarchyItem", + "properties": [ + { + "name": "name", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The name of this item." + }, + { + "name": "kind", + "type": { + "kind": "reference", + "name": "SymbolKind" + }, + "documentation": "The kind of this item." + }, + { + "name": "tags", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "SymbolTag" + } + }, + "optional": true, + "documentation": "Tags for this item." + }, + { + "name": "detail", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "More detail for this item, e.g. the signature of a function." + }, + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The resource identifier of this item." + }, + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range enclosing this symbol not including leading/trailing whitespace but everything else, e.g. comments and code." + }, + { + "name": "selectionRange", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range that should be selected and revealed when this symbol is being picked, e.g. the name of a function.\nMust be contained by the {@link CallHierarchyItem.range `range`}." + }, + { + "name": "data", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "A data entry field that is preserved between a call hierarchy prepare and\nincoming calls or outgoing calls requests." + } + ], + "documentation": "Represents programming constructs like functions or constructors in the context\nof call hierarchy.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "CallHierarchyRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "CallHierarchyOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ], + "documentation": "Call hierarchy options used during static or dynamic registration.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "CallHierarchyIncomingCallsParams", + "properties": [ + { + "name": "item", + "type": { + "kind": "reference", + "name": "CallHierarchyItem" + } + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "The parameter of a `callHierarchy/incomingCalls` request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "CallHierarchyIncomingCall", + "properties": [ + { + "name": "from", + "type": { + "kind": "reference", + "name": "CallHierarchyItem" + }, + "documentation": "The item that makes the call." + }, + { + "name": "fromRanges", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "Range" + } + }, + "documentation": "The ranges at which the calls appear. This is relative to the caller\ndenoted by {@link CallHierarchyIncomingCall.from `this.from`}." + } + ], + "documentation": "Represents an incoming call, e.g. a caller of a method or constructor.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "CallHierarchyOutgoingCallsParams", + "properties": [ + { + "name": "item", + "type": { + "kind": "reference", + "name": "CallHierarchyItem" + } + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "The parameter of a `callHierarchy/outgoingCalls` request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "CallHierarchyOutgoingCall", + "properties": [ + { + "name": "to", + "type": { + "kind": "reference", + "name": "CallHierarchyItem" + }, + "documentation": "The item that is called." + }, + { + "name": "fromRanges", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "Range" + } + }, + "documentation": "The range at which this item is called. This is the range relative to the caller, e.g the item\npassed to {@link CallHierarchyItemProvider.provideCallHierarchyOutgoingCalls `provideCallHierarchyOutgoingCalls`}\nand not {@link CallHierarchyOutgoingCall.to `this.to`}." + } + ], + "documentation": "Represents an outgoing call, e.g. calling a getter from a method or a method from a constructor etc.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "SemanticTokensParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The text document." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "SemanticTokens", + "properties": [ + { + "name": "resultId", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "An optional result id. If provided and clients support delta updating\nthe client will include the result id in the next semantic token request.\nA server can then instead of computing all semantic tokens again simply\nsend a delta." + }, + { + "name": "data", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "uinteger" + } + }, + "documentation": "The actual tokens." + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "SemanticTokensPartialResult", + "properties": [ + { + "name": "data", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "uinteger" + } + } + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "SemanticTokensRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "SemanticTokensOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "SemanticTokensDeltaParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The text document." + }, + { + "name": "previousResultId", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The result id of a previous response. The result Id can either point to a full response\nor a delta response depending on what was received last." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "SemanticTokensDelta", + "properties": [ + { + "name": "resultId", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true + }, + { + "name": "edits", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "SemanticTokensEdit" + } + }, + "documentation": "The semantic token edits to transform a previous result into a new result." + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "SemanticTokensDeltaPartialResult", + "properties": [ + { + "name": "edits", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "SemanticTokensEdit" + } + } + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "SemanticTokensRangeParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The text document." + }, + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range the semantic tokens are requested for." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "ShowDocumentParams", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "URI" + }, + "documentation": "The document uri to show." + }, + { + "name": "external", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Indicates to show the resource in an external program.\nTo show for example `https://code.visualstudio.com/`\nin the default WEB browser set `external` to `true`." + }, + { + "name": "takeFocus", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "An optional property to indicate whether the editor\nshowing the document should take focus or not.\nClients might ignore this property if an external\nprogram is started." + }, + { + "name": "selection", + "type": { + "kind": "reference", + "name": "Range" + }, + "optional": true, + "documentation": "An optional selection range if the document is a text\ndocument. Clients might ignore the property if an\nexternal program is started or the file is not a text\nfile." + } + ], + "documentation": "Params to show a document.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "ShowDocumentResult", + "properties": [ + { + "name": "success", + "type": { + "kind": "base", + "name": "boolean" + }, + "documentation": "A boolean indicating if the show was successful." + } + ], + "documentation": "The result of a showDocument request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "LinkedEditingRangeParams", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ] + }, + { + "name": "LinkedEditingRanges", + "properties": [ + { + "name": "ranges", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "Range" + } + }, + "documentation": "A list of ranges that can be edited together. The ranges must have\nidentical length and contain identical text content. The ranges cannot overlap." + }, + { + "name": "wordPattern", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "An optional word pattern (regular expression) that describes valid contents for\nthe given ranges. If no pattern is provided, the client configuration's word\npattern will be used." + } + ], + "documentation": "The result of a linked editing range request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "LinkedEditingRangeRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "LinkedEditingRangeOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ] + }, + { + "name": "CreateFilesParams", + "properties": [ + { + "name": "files", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "FileCreate" + } + }, + "documentation": "An array of all files/folders created in this operation." + } + ], + "documentation": "The parameters sent in notifications/requests for user-initiated creation of\nfiles.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "WorkspaceEdit", + "properties": [ + { + "name": "changes", + "type": { + "kind": "map", + "key": { + "kind": "base", + "name": "DocumentUri" + }, + "value": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextEdit" + } + } + }, + "optional": true, + "documentation": "Holds changes to existing resources." + }, + { + "name": "documentChanges", + "type": { + "kind": "array", + "element": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "TextDocumentEdit" + }, + { + "kind": "reference", + "name": "CreateFile" + }, + { + "kind": "reference", + "name": "RenameFile" + }, + { + "kind": "reference", + "name": "DeleteFile" + } + ] + } + }, + "optional": true, + "documentation": "Depending on the client capability `workspace.workspaceEdit.resourceOperations` document changes\nare either an array of `TextDocumentEdit`s to express changes to n different text documents\nwhere each text document edit addresses a specific version of a text document. Or it can contain\nabove `TextDocumentEdit`s mixed with create, rename and delete file / folder operations.\n\nWhether a client supports versioned document edits is expressed via\n`workspace.workspaceEdit.documentChanges` client capability.\n\nIf a client neither supports `documentChanges` nor `workspace.workspaceEdit.resourceOperations` then\nonly plain `TextEdit`s using the `changes` property are supported." + }, + { + "name": "changeAnnotations", + "type": { + "kind": "map", + "key": { + "kind": "reference", + "name": "ChangeAnnotationIdentifier" + }, + "value": { + "kind": "reference", + "name": "ChangeAnnotation" + } + }, + "optional": true, + "documentation": "A map of change annotations that can be referenced in `AnnotatedTextEdit`s or create, rename and\ndelete file / folder operations.\n\nWhether clients honor this property depends on the client capability `workspace.changeAnnotationSupport`.\n\n@since 3.16.0", + "since": "3.16.0" + } + ], + "documentation": "A workspace edit represents changes to many resources managed in the workspace. The edit\nshould either provide `changes` or `documentChanges`. If documentChanges are present\nthey are preferred over `changes` if the client can handle versioned document edits.\n\nSince version 3.13.0 a workspace edit can contain resource operations as well. If resource\noperations are present clients need to execute the operations in the order in which they\nare provided. So a workspace edit for example can consist of the following two changes:\n(1) a create file a.txt and (2) a text document edit which insert text into file a.txt.\n\nAn invalid sequence (e.g. (1) delete file a.txt and (2) insert text into file a.txt) will\ncause failure of the operation. How the client recovers from the failure is described by\nthe client capability: `workspace.workspaceEdit.failureHandling`" + }, + { + "name": "FileOperationRegistrationOptions", + "properties": [ + { + "name": "filters", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "FileOperationFilter" + } + }, + "documentation": "The actual filters." + } + ], + "documentation": "The options to register for file operations.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "RenameFilesParams", + "properties": [ + { + "name": "files", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "FileRename" + } + }, + "documentation": "An array of all files/folders renamed in this operation. When a folder is renamed, only\nthe folder will be included, and not its children." + } + ], + "documentation": "The parameters sent in notifications/requests for user-initiated renames of\nfiles.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "DeleteFilesParams", + "properties": [ + { + "name": "files", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "FileDelete" + } + }, + "documentation": "An array of all files/folders deleted in this operation." + } + ], + "documentation": "The parameters sent in notifications/requests for user-initiated deletes of\nfiles.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "MonikerParams", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ] + }, + { + "name": "Moniker", + "properties": [ + { + "name": "scheme", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The scheme of the moniker. For example tsc or .Net" + }, + { + "name": "identifier", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The identifier of the moniker. The value is opaque in LSIF however\nschema owners are allowed to define the structure if they want." + }, + { + "name": "unique", + "type": { + "kind": "reference", + "name": "UniquenessLevel" + }, + "documentation": "The scope in which the moniker is unique" + }, + { + "name": "kind", + "type": { + "kind": "reference", + "name": "MonikerKind" + }, + "optional": true, + "documentation": "The moniker kind if known." + } + ], + "documentation": "Moniker definition to match LSIF 0.5 moniker definition.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "MonikerRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "MonikerOptions" + } + ] + }, + { + "name": "TypeHierarchyPrepareParams", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ], + "documentation": "The parameter of a `textDocument/prepareTypeHierarchy` request.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "TypeHierarchyItem", + "properties": [ + { + "name": "name", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The name of this item." + }, + { + "name": "kind", + "type": { + "kind": "reference", + "name": "SymbolKind" + }, + "documentation": "The kind of this item." + }, + { + "name": "tags", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "SymbolTag" + } + }, + "optional": true, + "documentation": "Tags for this item." + }, + { + "name": "detail", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "More detail for this item, e.g. the signature of a function." + }, + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The resource identifier of this item." + }, + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range enclosing this symbol not including leading/trailing whitespace\nbut everything else, e.g. comments and code." + }, + { + "name": "selectionRange", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range that should be selected and revealed when this symbol is being\npicked, e.g. the name of a function. Must be contained by the\n{@link TypeHierarchyItem.range `range`}." + }, + { + "name": "data", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "A data entry field that is preserved between a type hierarchy prepare and\nsupertypes or subtypes requests. It could also be used to identify the\ntype hierarchy in the server, helping improve the performance on\nresolving supertypes and subtypes." + } + ], + "documentation": "@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "TypeHierarchyRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "TypeHierarchyOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ], + "documentation": "Type hierarchy options used during static or dynamic registration.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "TypeHierarchySupertypesParams", + "properties": [ + { + "name": "item", + "type": { + "kind": "reference", + "name": "TypeHierarchyItem" + } + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "The parameter of a `typeHierarchy/supertypes` request.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "TypeHierarchySubtypesParams", + "properties": [ + { + "name": "item", + "type": { + "kind": "reference", + "name": "TypeHierarchyItem" + } + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "The parameter of a `typeHierarchy/subtypes` request.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlineValueParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The text document." + }, + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The document range for which inline values should be computed." + }, + { + "name": "context", + "type": { + "kind": "reference", + "name": "InlineValueContext" + }, + "documentation": "Additional information about the context in which inline values were\nrequested." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ], + "documentation": "A parameter literal used in inline value requests.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlineValueRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "InlineValueOptions" + }, + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ], + "documentation": "Inline value options used during static or dynamic registration.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlayHintParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The text document." + }, + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The document range for which inlay hints should be computed." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ], + "documentation": "A parameter literal used in inlay hint requests.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlayHint", + "properties": [ + { + "name": "position", + "type": { + "kind": "reference", + "name": "Position" + }, + "documentation": "The position of this hint." + }, + { + "name": "label", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "InlayHintLabelPart" + } + } + ] + }, + "documentation": "The label of this hint. A human readable string or an array of\nInlayHintLabelPart label parts.\n\n*Note* that neither the string nor the label part can be empty." + }, + { + "name": "kind", + "type": { + "kind": "reference", + "name": "InlayHintKind" + }, + "optional": true, + "documentation": "The kind of this hint. Can be omitted in which case the client\nshould fall back to a reasonable default." + }, + { + "name": "textEdits", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextEdit" + } + }, + "optional": true, + "documentation": "Optional text edits that are performed when accepting this inlay hint.\n\n*Note* that edits are expected to change the document so that the inlay\nhint (or its nearest variant) is now part of the document and the inlay\nhint itself is now obsolete." + }, + { + "name": "tooltip", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "reference", + "name": "MarkupContent" + } + ] + }, + "optional": true, + "documentation": "The tooltip text when you hover over this item." + }, + { + "name": "paddingLeft", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Render padding before the hint.\n\nNote: Padding should use the editor's background color, not the\nbackground color of the hint itself. That means padding can be used\nto visually align/separate an inlay hint." + }, + { + "name": "paddingRight", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Render padding after the hint.\n\nNote: Padding should use the editor's background color, not the\nbackground color of the hint itself. That means padding can be used\nto visually align/separate an inlay hint." + }, + { + "name": "data", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "A data entry field that is preserved on an inlay hint between\na `textDocument/inlayHint` and a `inlayHint/resolve` request." + } + ], + "documentation": "Inlay hint information.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlayHintRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "InlayHintOptions" + }, + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ], + "documentation": "Inlay hint options used during static or dynamic registration.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "DocumentDiagnosticParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The text document." + }, + { + "name": "identifier", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The additional identifier provided during registration." + }, + { + "name": "previousResultId", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The result id of a previous response if provided." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "Parameters of the document diagnostic request.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "DocumentDiagnosticReportPartialResult", + "properties": [ + { + "name": "relatedDocuments", + "type": { + "kind": "map", + "key": { + "kind": "base", + "name": "DocumentUri" + }, + "value": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "FullDocumentDiagnosticReport" + }, + { + "kind": "reference", + "name": "UnchangedDocumentDiagnosticReport" + } + ] + } + } + } + ], + "documentation": "A partial result for a document diagnostic report.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "DiagnosticServerCancellationData", + "properties": [ + { + "name": "retriggerRequest", + "type": { + "kind": "base", + "name": "boolean" + } + } + ], + "documentation": "Cancellation data returned from a diagnostic request.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "DiagnosticRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "DiagnosticOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ], + "documentation": "Diagnostic registration options.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "WorkspaceDiagnosticParams", + "properties": [ + { + "name": "identifier", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The additional identifier provided during registration." + }, + { + "name": "previousResultIds", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "PreviousResultId" + } + }, + "documentation": "The currently known diagnostic reports with their\nprevious result ids." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "Parameters of the workspace diagnostic request.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "WorkspaceDiagnosticReport", + "properties": [ + { + "name": "items", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "WorkspaceDocumentDiagnosticReport" + } + } + } + ], + "documentation": "A workspace diagnostic report.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "WorkspaceDiagnosticReportPartialResult", + "properties": [ + { + "name": "items", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "WorkspaceDocumentDiagnosticReport" + } + } + } + ], + "documentation": "A partial result for a workspace diagnostic report.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "DidOpenNotebookDocumentParams", + "properties": [ + { + "name": "notebookDocument", + "type": { + "kind": "reference", + "name": "NotebookDocument" + }, + "documentation": "The notebook document that got opened." + }, + { + "name": "cellTextDocuments", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextDocumentItem" + } + }, + "documentation": "The text documents that represent the content\nof a notebook cell." + } + ], + "documentation": "The params sent in an open notebook document notification.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "DidChangeNotebookDocumentParams", + "properties": [ + { + "name": "notebookDocument", + "type": { + "kind": "reference", + "name": "VersionedNotebookDocumentIdentifier" + }, + "documentation": "The notebook document that did change. The version number points\nto the version after all provided changes have been applied. If\nonly the text document content of a cell changes the notebook version\ndoesn't necessarily have to change." + }, + { + "name": "change", + "type": { + "kind": "reference", + "name": "NotebookDocumentChangeEvent" + }, + "documentation": "The actual changes to the notebook document.\n\nThe changes describe single state changes to the notebook document.\nSo if there are two changes c1 (at array index 0) and c2 (at array\nindex 1) for a notebook in state S then c1 moves the notebook from\nS to S' and c2 from S' to S''. So c1 is computed on the state S and\nc2 is computed on the state S'.\n\nTo mirror the content of a notebook using change events use the following approach:\n- start with the same initial content\n- apply the 'notebookDocument/didChange' notifications in the order you receive them.\n- apply the `NotebookChangeEvent`s in a single notification in the order\n you receive them." + } + ], + "documentation": "The params sent in a change notebook document notification.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "DidSaveNotebookDocumentParams", + "properties": [ + { + "name": "notebookDocument", + "type": { + "kind": "reference", + "name": "NotebookDocumentIdentifier" + }, + "documentation": "The notebook document that got saved." + } + ], + "documentation": "The params sent in a save notebook document notification.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "DidCloseNotebookDocumentParams", + "properties": [ + { + "name": "notebookDocument", + "type": { + "kind": "reference", + "name": "NotebookDocumentIdentifier" + }, + "documentation": "The notebook document that got closed." + }, + { + "name": "cellTextDocuments", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextDocumentIdentifier" + } + }, + "documentation": "The text documents that represent the content\nof a notebook cell that got closed." + } + ], + "documentation": "The params sent in a close notebook document notification.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "RegistrationParams", + "properties": [ + { + "name": "registrations", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "Registration" + } + } + } + ] + }, + { + "name": "UnregistrationParams", + "properties": [ + { + "name": "unregisterations", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "Unregistration" + } + } + } + ] + }, + { + "name": "InitializeParams", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "_InitializeParams" + }, + { + "kind": "reference", + "name": "WorkspaceFoldersInitializeParams" + } + ] + }, + { + "name": "InitializeResult", + "properties": [ + { + "name": "capabilities", + "type": { + "kind": "reference", + "name": "ServerCapabilities" + }, + "documentation": "The capabilities the language server provides." + }, + { + "name": "serverInfo", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "name", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The name of the server as defined by the server." + }, + { + "name": "version", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The server's version as defined by the server." + } + ] + } + }, + "optional": true, + "documentation": "Information about the server.\n\n@since 3.15.0", + "since": "3.15.0" + } + ], + "documentation": "The result returned from an initialize request." + }, + { + "name": "InitializeError", + "properties": [ + { + "name": "retry", + "type": { + "kind": "base", + "name": "boolean" + }, + "documentation": "Indicates whether the client execute the following retry logic:\n(1) show the message provided by the ResponseError to the user\n(2) user selects retry or cancel\n(3) if user selected retry the initialize method is sent again." + } + ], + "documentation": "The data type of the ResponseError if the\ninitialize request fails." + }, + { + "name": "InitializedParams", + "properties": [] + }, + { + "name": "DidChangeConfigurationParams", + "properties": [ + { + "name": "settings", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "documentation": "The actual changed settings" + } + ], + "documentation": "The parameters of a change configuration notification." + }, + { + "name": "DidChangeConfigurationRegistrationOptions", + "properties": [ + { + "name": "section", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + } + ] + }, + "optional": true + } + ] + }, + { + "name": "ShowMessageParams", + "properties": [ + { + "name": "type", + "type": { + "kind": "reference", + "name": "MessageType" + }, + "documentation": "The message type. See {@link MessageType}" + }, + { + "name": "message", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The actual message." + } + ], + "documentation": "The parameters of a notification message." + }, + { + "name": "ShowMessageRequestParams", + "properties": [ + { + "name": "type", + "type": { + "kind": "reference", + "name": "MessageType" + }, + "documentation": "The message type. See {@link MessageType}" + }, + { + "name": "message", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The actual message." + }, + { + "name": "actions", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "MessageActionItem" + } + }, + "optional": true, + "documentation": "The message action items to present." + } + ] + }, + { + "name": "MessageActionItem", + "properties": [ + { + "name": "title", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A short title like 'Retry', 'Open Log' etc." + } + ] + }, + { + "name": "LogMessageParams", + "properties": [ + { + "name": "type", + "type": { + "kind": "reference", + "name": "MessageType" + }, + "documentation": "The message type. See {@link MessageType}" + }, + { + "name": "message", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The actual message." + } + ], + "documentation": "The log message parameters." + }, + { + "name": "DidOpenTextDocumentParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentItem" + }, + "documentation": "The document that was opened." + } + ], + "documentation": "The parameters sent in an open text document notification" + }, + { + "name": "DidChangeTextDocumentParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "VersionedTextDocumentIdentifier" + }, + "documentation": "The document that did change. The version number points\nto the version after all provided content changes have\nbeen applied." + }, + { + "name": "contentChanges", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextDocumentContentChangeEvent" + } + }, + "documentation": "The actual content changes. The content changes describe single state changes\nto the document. So if there are two content changes c1 (at array index 0) and\nc2 (at array index 1) for a document in state S then c1 moves the document from\nS to S' and c2 from S' to S''. So c1 is computed on the state S and c2 is computed\non the state S'.\n\nTo mirror the content of a document using change events use the following approach:\n- start with the same initial content\n- apply the 'textDocument/didChange' notifications in the order you receive them.\n- apply the `TextDocumentContentChangeEvent`s in a single notification in the order\n you receive them." + } + ], + "documentation": "The change text document notification's parameters." + }, + { + "name": "TextDocumentChangeRegistrationOptions", + "properties": [ + { + "name": "syncKind", + "type": { + "kind": "reference", + "name": "TextDocumentSyncKind" + }, + "documentation": "How documents are synced to the server." + } + ], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + } + ], + "documentation": "Describe options to be used when registered for text document change events." + }, + { + "name": "DidCloseTextDocumentParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The document that was closed." + } + ], + "documentation": "The parameters sent in a close text document notification" + }, + { + "name": "DidSaveTextDocumentParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The document that was saved." + }, + { + "name": "text", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "Optional the content when saved. Depends on the includeText value\nwhen the save notification was requested." + } + ], + "documentation": "The parameters sent in a save text document notification" + }, + { + "name": "TextDocumentSaveRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "SaveOptions" + } + ], + "documentation": "Save registration options." + }, + { + "name": "WillSaveTextDocumentParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The document that will be saved." + }, + { + "name": "reason", + "type": { + "kind": "reference", + "name": "TextDocumentSaveReason" + }, + "documentation": "The 'TextDocumentSaveReason'." + } + ], + "documentation": "The parameters sent in a will save text document notification." + }, + { + "name": "TextEdit", + "properties": [ + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range of the text document to be manipulated. To insert\ntext into a document create a range where start === end." + }, + { + "name": "newText", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The string to be inserted. For delete operations use an\nempty string." + } + ], + "documentation": "A text edit applicable to a text document." + }, + { + "name": "DidChangeWatchedFilesParams", + "properties": [ + { + "name": "changes", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "FileEvent" + } + }, + "documentation": "The actual file events." + } + ], + "documentation": "The watched files change notification's parameters." + }, + { + "name": "DidChangeWatchedFilesRegistrationOptions", + "properties": [ + { + "name": "watchers", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "FileSystemWatcher" + } + }, + "documentation": "The watchers to register." + } + ], + "documentation": "Describe options to be used when registered for text document change events." + }, + { + "name": "PublishDiagnosticsParams", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The URI for which diagnostic information is reported." + }, + { + "name": "version", + "type": { + "kind": "base", + "name": "integer" + }, + "optional": true, + "documentation": "Optional the version number of the document the diagnostics are published for.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "diagnostics", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "Diagnostic" + } + }, + "documentation": "An array of diagnostic information items." + } + ], + "documentation": "The publish diagnostic notification's parameters." + }, + { + "name": "CompletionParams", + "properties": [ + { + "name": "context", + "type": { + "kind": "reference", + "name": "CompletionContext" + }, + "optional": true, + "documentation": "The completion context. This is only available it the client specifies\nto send this using the client capability `textDocument.completion.contextSupport === true`" + } + ], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "Completion parameters" + }, + { + "name": "CompletionItem", + "properties": [ + { + "name": "label", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The label of this completion item.\n\nThe label property is also by default the text that\nis inserted when selecting this completion.\n\nIf label details are provided the label itself should\nbe an unqualified name of the completion item." + }, + { + "name": "labelDetails", + "type": { + "kind": "reference", + "name": "CompletionItemLabelDetails" + }, + "optional": true, + "documentation": "Additional details for the label\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "kind", + "type": { + "kind": "reference", + "name": "CompletionItemKind" + }, + "optional": true, + "documentation": "The kind of this completion item. Based of the kind\nan icon is chosen by the editor." + }, + { + "name": "tags", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "CompletionItemTag" + } + }, + "optional": true, + "documentation": "Tags for this completion item.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "detail", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A human-readable string with additional information\nabout this item, like type or symbol information." + }, + { + "name": "documentation", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "reference", + "name": "MarkupContent" + } + ] + }, + "optional": true, + "documentation": "A human-readable string that represents a doc-comment." + }, + { + "name": "deprecated", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Indicates if this item is deprecated.\n@deprecated Use `tags` instead.", + "deprecated": "Use `tags` instead." + }, + { + "name": "preselect", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Select this item when showing.\n\n*Note* that only one completion item can be selected and that the\ntool / client decides which item that is. The rule is that the *first*\nitem of those that match best is selected." + }, + { + "name": "sortText", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A string that should be used when comparing this item\nwith other items. When `falsy` the {@link CompletionItem.label label}\nis used." + }, + { + "name": "filterText", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A string that should be used when filtering a set of\ncompletion items. When `falsy` the {@link CompletionItem.label label}\nis used." + }, + { + "name": "insertText", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A string that should be inserted into a document when selecting\nthis completion. When `falsy` the {@link CompletionItem.label label}\nis used.\n\nThe `insertText` is subject to interpretation by the client side.\nSome tools might not take the string literally. For example\nVS Code when code complete is requested in this example\n`con` and a completion item with an `insertText` of\n`console` is provided it will only insert `sole`. Therefore it is\nrecommended to use `textEdit` instead since it avoids additional client\nside interpretation." + }, + { + "name": "insertTextFormat", + "type": { + "kind": "reference", + "name": "InsertTextFormat" + }, + "optional": true, + "documentation": "The format of the insert text. The format applies to both the\n`insertText` property and the `newText` property of a provided\n`textEdit`. If omitted defaults to `InsertTextFormat.PlainText`.\n\nPlease note that the insertTextFormat doesn't apply to\n`additionalTextEdits`." + }, + { + "name": "insertTextMode", + "type": { + "kind": "reference", + "name": "InsertTextMode" + }, + "optional": true, + "documentation": "How whitespace and indentation is handled during completion\nitem insertion. If not provided the clients default value depends on\nthe `textDocument.completion.insertTextMode` client capability.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "textEdit", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "TextEdit" + }, + { + "kind": "reference", + "name": "InsertReplaceEdit" + } + ] + }, + "optional": true, + "documentation": "An {@link TextEdit edit} which is applied to a document when selecting\nthis completion. When an edit is provided the value of\n{@link CompletionItem.insertText insertText} is ignored.\n\nMost editors support two different operations when accepting a completion\nitem. One is to insert a completion text and the other is to replace an\nexisting text with a completion text. Since this can usually not be\npredetermined by a server it can report both ranges. Clients need to\nsignal support for `InsertReplaceEdits` via the\n`textDocument.completion.insertReplaceSupport` client capability\nproperty.\n\n*Note 1:* The text edit's range as well as both ranges from an insert\nreplace edit must be a [single line] and they must contain the position\nat which completion has been requested.\n*Note 2:* If an `InsertReplaceEdit` is returned the edit's insert range\nmust be a prefix of the edit's replace range, that means it must be\ncontained and starting at the same position.\n\n@since 3.16.0 additional type `InsertReplaceEdit`", + "since": "3.16.0 additional type `InsertReplaceEdit`" + }, + { + "name": "textEditText", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The edit text used if the completion item is part of a CompletionList and\nCompletionList defines an item default for the text edit range.\n\nClients will only honor this property if they opt into completion list\nitem defaults using the capability `completionList.itemDefaults`.\n\nIf not provided and a list's default range is provided the label\nproperty is used as a text.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "additionalTextEdits", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextEdit" + } + }, + "optional": true, + "documentation": "An optional array of additional {@link TextEdit text edits} that are applied when\nselecting this completion. Edits must not overlap (including the same insert position)\nwith the main {@link CompletionItem.textEdit edit} nor with themselves.\n\nAdditional text edits should be used to change text unrelated to the current cursor position\n(for example adding an import statement at the top of the file if the completion item will\ninsert an unqualified type)." + }, + { + "name": "commitCharacters", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "optional": true, + "documentation": "An optional set of characters that when pressed while this completion is active will accept it first and\nthen type that character. *Note* that all commit characters should have `length=1` and that superfluous\ncharacters will be ignored." + }, + { + "name": "command", + "type": { + "kind": "reference", + "name": "Command" + }, + "optional": true, + "documentation": "An optional {@link Command command} that is executed *after* inserting this completion. *Note* that\nadditional modifications to the current document should be described with the\n{@link CompletionItem.additionalTextEdits additionalTextEdits}-property." + }, + { + "name": "data", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "A data entry field that is preserved on a completion item between a\n{@link CompletionRequest} and a {@link CompletionResolveRequest}." + } + ], + "documentation": "A completion item represents a text snippet that is\nproposed to complete text that is being typed." + }, + { + "name": "CompletionList", + "properties": [ + { + "name": "isIncomplete", + "type": { + "kind": "base", + "name": "boolean" + }, + "documentation": "This list it not complete. Further typing results in recomputing this list.\n\nRecomputed lists have all their items replaced (not appended) in the\nincomplete completion sessions." + }, + { + "name": "itemDefaults", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "commitCharacters", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "optional": true, + "documentation": "A default commit character set.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "editRange", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Range" + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "insert", + "type": { + "kind": "reference", + "name": "Range" + } + }, + { + "name": "replace", + "type": { + "kind": "reference", + "name": "Range" + } + } + ] + } + } + ] + }, + "optional": true, + "documentation": "A default edit range.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "insertTextFormat", + "type": { + "kind": "reference", + "name": "InsertTextFormat" + }, + "optional": true, + "documentation": "A default insert text format.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "insertTextMode", + "type": { + "kind": "reference", + "name": "InsertTextMode" + }, + "optional": true, + "documentation": "A default insert text mode.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "data", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "A default data value.\n\n@since 3.17.0", + "since": "3.17.0" + } + ] + } + }, + "optional": true, + "documentation": "In many cases the items of an actual completion result share the same\nvalue for properties like `commitCharacters` or the range of a text\nedit. A completion list can therefore define item defaults which will\nbe used if a completion item itself doesn't specify the value.\n\nIf a completion list specifies a default value and a completion item\nalso specifies a corresponding value the one from the item is used.\n\nServers are only allowed to return default values if the client\nsignals support for this via the `completionList.itemDefaults`\ncapability.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "items", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "CompletionItem" + } + }, + "documentation": "The completion items." + } + ], + "documentation": "Represents a collection of {@link CompletionItem completion items} to be presented\nin the editor." + }, + { + "name": "CompletionRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "CompletionOptions" + } + ], + "documentation": "Registration options for a {@link CompletionRequest}." + }, + { + "name": "HoverParams", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ], + "documentation": "Parameters for a {@link HoverRequest}." + }, + { + "name": "Hover", + "properties": [ + { + "name": "contents", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "MarkupContent" + }, + { + "kind": "reference", + "name": "MarkedString" + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "MarkedString" + } + } + ] + }, + "documentation": "The hover's content" + }, + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "optional": true, + "documentation": "An optional range inside the text document that is used to\nvisualize the hover, e.g. by changing the background color." + } + ], + "documentation": "The result of a hover request." + }, + { + "name": "HoverRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "HoverOptions" + } + ], + "documentation": "Registration options for a {@link HoverRequest}." + }, + { + "name": "SignatureHelpParams", + "properties": [ + { + "name": "context", + "type": { + "kind": "reference", + "name": "SignatureHelpContext" + }, + "optional": true, + "documentation": "The signature help context. This is only available if the client specifies\nto send this using the client capability `textDocument.signatureHelp.contextSupport === true`\n\n@since 3.15.0", + "since": "3.15.0" + } + ], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ], + "documentation": "Parameters for a {@link SignatureHelpRequest}." + }, + { + "name": "SignatureHelp", + "properties": [ + { + "name": "signatures", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "SignatureInformation" + } + }, + "documentation": "One or more signatures." + }, + { + "name": "activeSignature", + "type": { + "kind": "base", + "name": "uinteger" + }, + "optional": true, + "documentation": "The active signature. If omitted or the value lies outside the\nrange of `signatures` the value defaults to zero or is ignored if\nthe `SignatureHelp` has no signatures.\n\nWhenever possible implementors should make an active decision about\nthe active signature and shouldn't rely on a default value.\n\nIn future version of the protocol this property might become\nmandatory to better express this." + }, + { + "name": "activeParameter", + "type": { + "kind": "base", + "name": "uinteger" + }, + "optional": true, + "documentation": "The active parameter of the active signature. If omitted or the value\nlies outside the range of `signatures[activeSignature].parameters`\ndefaults to 0 if the active signature has parameters. If\nthe active signature has no parameters it is ignored.\nIn future version of the protocol this property might become\nmandatory to better express the active parameter if the\nactive signature does have any." + } + ], + "documentation": "Signature help represents the signature of something\ncallable. There can be multiple signature but only one\nactive and only one active parameter." + }, + { + "name": "SignatureHelpRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "SignatureHelpOptions" + } + ], + "documentation": "Registration options for a {@link SignatureHelpRequest}." + }, + { + "name": "DefinitionParams", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "Parameters for a {@link DefinitionRequest}." + }, + { + "name": "DefinitionRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "DefinitionOptions" + } + ], + "documentation": "Registration options for a {@link DefinitionRequest}." + }, + { + "name": "ReferenceParams", + "properties": [ + { + "name": "context", + "type": { + "kind": "reference", + "name": "ReferenceContext" + } + } + ], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "Parameters for a {@link ReferencesRequest}." + }, + { + "name": "ReferenceRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "ReferenceOptions" + } + ], + "documentation": "Registration options for a {@link ReferencesRequest}." + }, + { + "name": "DocumentHighlightParams", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "Parameters for a {@link DocumentHighlightRequest}." + }, + { + "name": "DocumentHighlight", + "properties": [ + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range this highlight applies to." + }, + { + "name": "kind", + "type": { + "kind": "reference", + "name": "DocumentHighlightKind" + }, + "optional": true, + "documentation": "The highlight kind, default is {@link DocumentHighlightKind.Text text}." + } + ], + "documentation": "A document highlight is a range inside a text document which deserves\nspecial attention. Usually a document highlight is visualized by changing\nthe background color of its range." + }, + { + "name": "DocumentHighlightRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "DocumentHighlightOptions" + } + ], + "documentation": "Registration options for a {@link DocumentHighlightRequest}." + }, + { + "name": "DocumentSymbolParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The text document." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "Parameters for a {@link DocumentSymbolRequest}." + }, + { + "name": "SymbolInformation", + "properties": [ + { + "name": "deprecated", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Indicates if this symbol is deprecated.\n\n@deprecated Use tags instead", + "deprecated": "Use tags instead" + }, + { + "name": "location", + "type": { + "kind": "reference", + "name": "Location" + }, + "documentation": "The location of this symbol. The location's range is used by a tool\nto reveal the location in the editor. If the symbol is selected in the\ntool the range's start information is used to position the cursor. So\nthe range usually spans more than the actual symbol's name and does\nnormally include things like visibility modifiers.\n\nThe range doesn't have to denote a node range in the sense of an abstract\nsyntax tree. It can therefore not be used to re-construct a hierarchy of\nthe symbols." + } + ], + "extends": [ + { + "kind": "reference", + "name": "BaseSymbolInformation" + } + ], + "documentation": "Represents information about programming constructs like variables, classes,\ninterfaces etc." + }, + { + "name": "DocumentSymbol", + "properties": [ + { + "name": "name", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The name of this symbol. Will be displayed in the user interface and therefore must not be\nan empty string or a string only consisting of white spaces." + }, + { + "name": "detail", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "More detail for this symbol, e.g the signature of a function." + }, + { + "name": "kind", + "type": { + "kind": "reference", + "name": "SymbolKind" + }, + "documentation": "The kind of this symbol." + }, + { + "name": "tags", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "SymbolTag" + } + }, + "optional": true, + "documentation": "Tags for this document symbol.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "deprecated", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Indicates if this symbol is deprecated.\n\n@deprecated Use tags instead", + "deprecated": "Use tags instead" + }, + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range enclosing this symbol not including leading/trailing whitespace but everything else\nlike comments. This information is typically used to determine if the clients cursor is\ninside the symbol to reveal in the symbol in the UI." + }, + { + "name": "selectionRange", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range that should be selected and revealed when this symbol is being picked, e.g the name of a function.\nMust be contained by the `range`." + }, + { + "name": "children", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "DocumentSymbol" + } + }, + "optional": true, + "documentation": "Children of this symbol, e.g. properties of a class." + } + ], + "documentation": "Represents programming constructs like variables, classes, interfaces etc.\nthat appear in a document. Document symbols can be hierarchical and they\nhave two ranges: one that encloses its definition and one that points to\nits most interesting range, e.g. the range of an identifier." + }, + { + "name": "DocumentSymbolRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "DocumentSymbolOptions" + } + ], + "documentation": "Registration options for a {@link DocumentSymbolRequest}." + }, + { + "name": "CodeActionParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The document in which the command was invoked." + }, + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range for which the command was invoked." + }, + { + "name": "context", + "type": { + "kind": "reference", + "name": "CodeActionContext" + }, + "documentation": "Context carrying additional information." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "The parameters of a {@link CodeActionRequest}." + }, + { + "name": "Command", + "properties": [ + { + "name": "title", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "Title of the command, like `save`." + }, + { + "name": "command", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The identifier of the actual command handler." + }, + { + "name": "arguments", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "LSPAny" + } + }, + "optional": true, + "documentation": "Arguments that the command handler should be\ninvoked with." + } + ], + "documentation": "Represents a reference to a command. Provides a title which\nwill be used to represent a command in the UI and, optionally,\nan array of arguments which will be passed to the command handler\nfunction when invoked." + }, + { + "name": "CodeAction", + "properties": [ + { + "name": "title", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A short, human-readable, title for this code action." + }, + { + "name": "kind", + "type": { + "kind": "reference", + "name": "CodeActionKind" + }, + "optional": true, + "documentation": "The kind of the code action.\n\nUsed to filter code actions." + }, + { + "name": "diagnostics", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "Diagnostic" + } + }, + "optional": true, + "documentation": "The diagnostics that this code action resolves." + }, + { + "name": "isPreferred", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Marks this as a preferred action. Preferred actions are used by the `auto fix` command and can be targeted\nby keybindings.\n\nA quick fix should be marked preferred if it properly addresses the underlying error.\nA refactoring should be marked preferred if it is the most reasonable choice of actions to take.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "disabled", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "reason", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "Human readable description of why the code action is currently disabled.\n\nThis is displayed in the code actions UI." + } + ] + } + }, + "optional": true, + "documentation": "Marks that the code action cannot currently be applied.\n\nClients should follow the following guidelines regarding disabled code actions:\n\n - Disabled code actions are not shown in automatic [lightbulbs](https://code.visualstudio.com/docs/editor/editingevolved#_code-action)\n code action menus.\n\n - Disabled actions are shown as faded out in the code action menu when the user requests a more specific type\n of code action, such as refactorings.\n\n - If the user has a [keybinding](https://code.visualstudio.com/docs/editor/refactoring#_keybindings-for-code-actions)\n that auto applies a code action and only disabled code actions are returned, the client should show the user an\n error message with `reason` in the editor.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "edit", + "type": { + "kind": "reference", + "name": "WorkspaceEdit" + }, + "optional": true, + "documentation": "The workspace edit this code action performs." + }, + { + "name": "command", + "type": { + "kind": "reference", + "name": "Command" + }, + "optional": true, + "documentation": "A command this code action executes. If a code action\nprovides an edit and a command, first the edit is\nexecuted and then the command." + }, + { + "name": "data", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "A data entry field that is preserved on a code action between\na `textDocument/codeAction` and a `codeAction/resolve` request.\n\n@since 3.16.0", + "since": "3.16.0" + } + ], + "documentation": "A code action represents a change that can be performed in code, e.g. to fix a problem or\nto refactor code.\n\nA CodeAction must set either `edit` and/or a `command`. If both are supplied, the `edit` is applied first, then the `command` is executed." + }, + { + "name": "CodeActionRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "CodeActionOptions" + } + ], + "documentation": "Registration options for a {@link CodeActionRequest}." + }, + { + "name": "WorkspaceSymbolParams", + "properties": [ + { + "name": "query", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A query string to filter symbols by. Clients may send an empty\nstring here to request all symbols." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "The parameters of a {@link WorkspaceSymbolRequest}." + }, + { + "name": "WorkspaceSymbol", + "properties": [ + { + "name": "location", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Location" + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + } + } + ] + } + } + ] + }, + "documentation": "The location of the symbol. Whether a server is allowed to\nreturn a location without a range depends on the client\ncapability `workspace.symbol.resolveSupport`.\n\nSee SymbolInformation#location for more details." + }, + { + "name": "data", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "A data entry field that is preserved on a workspace symbol between a\nworkspace symbol request and a workspace symbol resolve request." + } + ], + "extends": [ + { + "kind": "reference", + "name": "BaseSymbolInformation" + } + ], + "documentation": "A special workspace symbol that supports locations without a range.\n\nSee also SymbolInformation.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "WorkspaceSymbolRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "WorkspaceSymbolOptions" + } + ], + "documentation": "Registration options for a {@link WorkspaceSymbolRequest}." + }, + { + "name": "CodeLensParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The document to request code lens for." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "The parameters of a {@link CodeLensRequest}." + }, + { + "name": "CodeLens", + "properties": [ + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range in which this code lens is valid. Should only span a single line." + }, + { + "name": "command", + "type": { + "kind": "reference", + "name": "Command" + }, + "optional": true, + "documentation": "The command this code lens represents." + }, + { + "name": "data", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "A data entry field that is preserved on a code lens item between\na {@link CodeLensRequest} and a [CodeLensResolveRequest]\n(#CodeLensResolveRequest)" + } + ], + "documentation": "A code lens represents a {@link Command command} that should be shown along with\nsource text, like the number of references, a way to run tests, etc.\n\nA code lens is _unresolved_ when no command is associated to it. For performance\nreasons the creation of a code lens and resolving should be done in two stages." + }, + { + "name": "CodeLensRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "CodeLensOptions" + } + ], + "documentation": "Registration options for a {@link CodeLensRequest}." + }, + { + "name": "DocumentLinkParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The document to provide document links for." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + }, + { + "kind": "reference", + "name": "PartialResultParams" + } + ], + "documentation": "The parameters of a {@link DocumentLinkRequest}." + }, + { + "name": "DocumentLink", + "properties": [ + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range this link applies to." + }, + { + "name": "target", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The uri this link points to. If missing a resolve request is sent later." + }, + { + "name": "tooltip", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The tooltip text when you hover over this link.\n\nIf a tooltip is provided, is will be displayed in a string that includes instructions on how to\ntrigger the link, such as `{0} (ctrl + click)`. The specific instructions vary depending on OS,\nuser settings, and localization.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "data", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "A data entry field that is preserved on a document link between a\nDocumentLinkRequest and a DocumentLinkResolveRequest." + } + ], + "documentation": "A document link is a range in a text document that links to an internal or external resource, like another\ntext document or a web site." + }, + { + "name": "DocumentLinkRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "DocumentLinkOptions" + } + ], + "documentation": "Registration options for a {@link DocumentLinkRequest}." + }, + { + "name": "DocumentFormattingParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The document to format." + }, + { + "name": "options", + "type": { + "kind": "reference", + "name": "FormattingOptions" + }, + "documentation": "The format options." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ], + "documentation": "The parameters of a {@link DocumentFormattingRequest}." + }, + { + "name": "DocumentFormattingRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "DocumentFormattingOptions" + } + ], + "documentation": "Registration options for a {@link DocumentFormattingRequest}." + }, + { + "name": "DocumentRangeFormattingParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The document to format." + }, + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range to format" + }, + { + "name": "options", + "type": { + "kind": "reference", + "name": "FormattingOptions" + }, + "documentation": "The format options" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ], + "documentation": "The parameters of a {@link DocumentRangeFormattingRequest}." + }, + { + "name": "DocumentRangeFormattingRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "DocumentRangeFormattingOptions" + } + ], + "documentation": "Registration options for a {@link DocumentRangeFormattingRequest}." + }, + { + "name": "DocumentOnTypeFormattingParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The document to format." + }, + { + "name": "position", + "type": { + "kind": "reference", + "name": "Position" + }, + "documentation": "The position around which the on type formatting should happen.\nThis is not necessarily the exact position where the character denoted\nby the property `ch` got typed." + }, + { + "name": "ch", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The character that has been typed that triggered the formatting\non type request. That is not necessarily the last character that\ngot inserted into the document since the client could auto insert\ncharacters as well (e.g. like automatic brace completion)." + }, + { + "name": "options", + "type": { + "kind": "reference", + "name": "FormattingOptions" + }, + "documentation": "The formatting options." + } + ], + "documentation": "The parameters of a {@link DocumentOnTypeFormattingRequest}." + }, + { + "name": "DocumentOnTypeFormattingRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "DocumentOnTypeFormattingOptions" + } + ], + "documentation": "Registration options for a {@link DocumentOnTypeFormattingRequest}." + }, + { + "name": "RenameParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The document to rename." + }, + { + "name": "position", + "type": { + "kind": "reference", + "name": "Position" + }, + "documentation": "The position at which this request was sent." + }, + { + "name": "newName", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The new name of the symbol. If the given name is not valid the\nrequest must return a {@link ResponseError} with an\nappropriate message set." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ], + "documentation": "The parameters of a {@link RenameRequest}." + }, + { + "name": "RenameRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentRegistrationOptions" + }, + { + "kind": "reference", + "name": "RenameOptions" + } + ], + "documentation": "Registration options for a {@link RenameRequest}." + }, + { + "name": "PrepareRenameParams", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentPositionParams" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ] + }, + { + "name": "ExecuteCommandParams", + "properties": [ + { + "name": "command", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The identifier of the actual command handler." + }, + { + "name": "arguments", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "LSPAny" + } + }, + "optional": true, + "documentation": "Arguments that the command should be invoked with." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ], + "documentation": "The parameters of a {@link ExecuteCommandRequest}." + }, + { + "name": "ExecuteCommandRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "ExecuteCommandOptions" + } + ], + "documentation": "Registration options for a {@link ExecuteCommandRequest}." + }, + { + "name": "ApplyWorkspaceEditParams", + "properties": [ + { + "name": "label", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "An optional label of the workspace edit. This label is\npresented in the user interface for example on an undo\nstack to undo the workspace edit." + }, + { + "name": "edit", + "type": { + "kind": "reference", + "name": "WorkspaceEdit" + }, + "documentation": "The edits to apply." + } + ], + "documentation": "The parameters passed via a apply workspace edit request." + }, + { + "name": "ApplyWorkspaceEditResult", + "properties": [ + { + "name": "applied", + "type": { + "kind": "base", + "name": "boolean" + }, + "documentation": "Indicates whether the edit was applied or not." + }, + { + "name": "failureReason", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "An optional textual description for why the edit was not applied.\nThis may be used by the server for diagnostic logging or to provide\na suitable error for a request that triggered the edit." + }, + { + "name": "failedChange", + "type": { + "kind": "base", + "name": "uinteger" + }, + "optional": true, + "documentation": "Depending on the client's failure handling strategy `failedChange` might\ncontain the index of the change that failed. This property is only available\nif the client signals a `failureHandlingStrategy` in its client capabilities." + } + ], + "documentation": "The result returned from the apply workspace edit request.\n\n@since 3.17 renamed from ApplyWorkspaceEditResponse", + "since": "3.17 renamed from ApplyWorkspaceEditResponse" + }, + { + "name": "WorkDoneProgressBegin", + "properties": [ + { + "name": "kind", + "type": { + "kind": "stringLiteral", + "value": "begin" + } + }, + { + "name": "title", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "Mandatory title of the progress operation. Used to briefly inform about\nthe kind of operation being performed.\n\nExamples: \"Indexing\" or \"Linking dependencies\"." + }, + { + "name": "cancellable", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Controls if a cancel button should show to allow the user to cancel the\nlong running operation. Clients that don't support cancellation are allowed\nto ignore the setting." + }, + { + "name": "message", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "Optional, more detailed associated progress message. Contains\ncomplementary information to the `title`.\n\nExamples: \"3/25 files\", \"project/src/module2\", \"node_modules/some_dep\".\nIf unset, the previous progress message (if any) is still valid." + }, + { + "name": "percentage", + "type": { + "kind": "base", + "name": "uinteger" + }, + "optional": true, + "documentation": "Optional progress percentage to display (value 100 is considered 100%).\nIf not provided infinite progress is assumed and clients are allowed\nto ignore the `percentage` value in subsequent in report notifications.\n\nThe value should be steadily rising. Clients are free to ignore values\nthat are not following this rule. The value range is [0, 100]." + } + ] + }, + { + "name": "WorkDoneProgressReport", + "properties": [ + { + "name": "kind", + "type": { + "kind": "stringLiteral", + "value": "report" + } + }, + { + "name": "cancellable", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Controls enablement state of a cancel button.\n\nClients that don't support cancellation or don't support controlling the button's\nenablement state are allowed to ignore the property." + }, + { + "name": "message", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "Optional, more detailed associated progress message. Contains\ncomplementary information to the `title`.\n\nExamples: \"3/25 files\", \"project/src/module2\", \"node_modules/some_dep\".\nIf unset, the previous progress message (if any) is still valid." + }, + { + "name": "percentage", + "type": { + "kind": "base", + "name": "uinteger" + }, + "optional": true, + "documentation": "Optional progress percentage to display (value 100 is considered 100%).\nIf not provided infinite progress is assumed and clients are allowed\nto ignore the `percentage` value in subsequent in report notifications.\n\nThe value should be steadily rising. Clients are free to ignore values\nthat are not following this rule. The value range is [0, 100]" + } + ] + }, + { + "name": "WorkDoneProgressEnd", + "properties": [ + { + "name": "kind", + "type": { + "kind": "stringLiteral", + "value": "end" + } + }, + { + "name": "message", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "Optional, a final message indicating to for example indicate the outcome\nof the operation." + } + ] + }, + { + "name": "SetTraceParams", + "properties": [ + { + "name": "value", + "type": { + "kind": "reference", + "name": "TraceValues" + } + } + ] + }, + { + "name": "LogTraceParams", + "properties": [ + { + "name": "message", + "type": { + "kind": "base", + "name": "string" + } + }, + { + "name": "verbose", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true + } + ] + }, + { + "name": "CancelParams", + "properties": [ + { + "name": "id", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "integer" + }, + { + "kind": "base", + "name": "string" + } + ] + }, + "documentation": "The request id to cancel." + } + ] + }, + { + "name": "ProgressParams", + "properties": [ + { + "name": "token", + "type": { + "kind": "reference", + "name": "ProgressToken" + }, + "documentation": "The progress token provided by the client or server." + }, + { + "name": "value", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "documentation": "The progress data." + } + ] + }, + { + "name": "TextDocumentPositionParams", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentIdentifier" + }, + "documentation": "The text document." + }, + { + "name": "position", + "type": { + "kind": "reference", + "name": "Position" + }, + "documentation": "The position inside the text document." + } + ], + "documentation": "A parameter literal used in requests to pass a text document and a position inside that\ndocument." + }, + { + "name": "WorkDoneProgressParams", + "properties": [ + { + "name": "workDoneToken", + "type": { + "kind": "reference", + "name": "ProgressToken" + }, + "optional": true, + "documentation": "An optional token that a server can use to report work done progress." + } + ] + }, + { + "name": "PartialResultParams", + "properties": [ + { + "name": "partialResultToken", + "type": { + "kind": "reference", + "name": "ProgressToken" + }, + "optional": true, + "documentation": "An optional token that a server can use to report partial results (e.g. streaming) to\nthe client." + } + ] + }, + { + "name": "LocationLink", + "properties": [ + { + "name": "originSelectionRange", + "type": { + "kind": "reference", + "name": "Range" + }, + "optional": true, + "documentation": "Span of the origin of this link.\n\nUsed as the underlined span for mouse interaction. Defaults to the word range at\nthe definition position." + }, + { + "name": "targetUri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The target resource identifier of this link." + }, + { + "name": "targetRange", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The full target range of this link. If the target for example is a symbol then target range is the\nrange enclosing this symbol not including leading/trailing whitespace but everything else\nlike comments. This information is typically used to highlight the range in the editor." + }, + { + "name": "targetSelectionRange", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range that should be selected and revealed when this link is being followed, e.g the name of a function.\nMust be contained by the `targetRange`. See also `DocumentSymbol#range`" + } + ], + "documentation": "Represents the connection of two locations. Provides additional metadata over normal {@link Location locations},\nincluding an origin range." + }, + { + "name": "Range", + "properties": [ + { + "name": "start", + "type": { + "kind": "reference", + "name": "Position" + }, + "documentation": "The range's start position." + }, + { + "name": "end", + "type": { + "kind": "reference", + "name": "Position" + }, + "documentation": "The range's end position." + } + ], + "documentation": "A range in a text document expressed as (zero-based) start and end positions.\n\nIf you want to specify a range that contains a line including the line ending\ncharacter(s) then use an end position denoting the start of the next line.\nFor example:\n```ts\n{\n start: { line: 5, character: 23 }\n end : { line 6, character : 0 }\n}\n```" + }, + { + "name": "ImplementationOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ] + }, + { + "name": "StaticRegistrationOptions", + "properties": [ + { + "name": "id", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The id used to register the request. The id can be used to deregister\nthe request again. See also Registration#id." + } + ], + "documentation": "Static registration options to be returned in the initialize\nrequest." + }, + { + "name": "TypeDefinitionOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ] + }, + { + "name": "WorkspaceFoldersChangeEvent", + "properties": [ + { + "name": "added", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "WorkspaceFolder" + } + }, + "documentation": "The array of added workspace folders" + }, + { + "name": "removed", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "WorkspaceFolder" + } + }, + "documentation": "The array of the removed workspace folders" + } + ], + "documentation": "The workspace folder change event." + }, + { + "name": "ConfigurationItem", + "properties": [ + { + "name": "scopeUri", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The scope to get the configuration section for." + }, + { + "name": "section", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The configuration section asked for." + } + ] + }, + { + "name": "TextDocumentIdentifier", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The text document's uri." + } + ], + "documentation": "A literal to identify a text document in the client." + }, + { + "name": "Color", + "properties": [ + { + "name": "red", + "type": { + "kind": "base", + "name": "decimal" + }, + "documentation": "The red component of this color in the range [0-1]." + }, + { + "name": "green", + "type": { + "kind": "base", + "name": "decimal" + }, + "documentation": "The green component of this color in the range [0-1]." + }, + { + "name": "blue", + "type": { + "kind": "base", + "name": "decimal" + }, + "documentation": "The blue component of this color in the range [0-1]." + }, + { + "name": "alpha", + "type": { + "kind": "base", + "name": "decimal" + }, + "documentation": "The alpha component of this color in the range [0-1]." + } + ], + "documentation": "Represents a color in RGBA space." + }, + { + "name": "DocumentColorOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ] + }, + { + "name": "FoldingRangeOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ] + }, + { + "name": "DeclarationOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ] + }, + { + "name": "Position", + "properties": [ + { + "name": "line", + "type": { + "kind": "base", + "name": "uinteger" + }, + "documentation": "Line position in a document (zero-based).\n\nIf a line number is greater than the number of lines in a document, it defaults back to the number of lines in the document.\nIf a line number is negative, it defaults to 0." + }, + { + "name": "character", + "type": { + "kind": "base", + "name": "uinteger" + }, + "documentation": "Character offset on a line in a document (zero-based).\n\nThe meaning of this offset is determined by the negotiated\n`PositionEncodingKind`.\n\nIf the character value is greater than the line length it defaults back to the\nline length." + } + ], + "documentation": "Position in a text document expressed as zero-based line and character\noffset. Prior to 3.17 the offsets were always based on a UTF-16 string\nrepresentation. So a string of the form `a𐐀b` the character offset of the\ncharacter `a` is 0, the character offset of `𐐀` is 1 and the character\noffset of b is 3 since `𐐀` is represented using two code units in UTF-16.\nSince 3.17 clients and servers can agree on a different string encoding\nrepresentation (e.g. UTF-8). The client announces it's supported encoding\nvia the client capability [`general.positionEncodings`](#clientCapabilities).\nThe value is an array of position encodings the client supports, with\ndecreasing preference (e.g. the encoding at index `0` is the most preferred\none). To stay backwards compatible the only mandatory encoding is UTF-16\nrepresented via the string `utf-16`. The server can pick one of the\nencodings offered by the client and signals that encoding back to the\nclient via the initialize result's property\n[`capabilities.positionEncoding`](#serverCapabilities). If the string value\n`utf-16` is missing from the client's capability `general.positionEncodings`\nservers can safely assume that the client supports UTF-16. If the server\nomits the position encoding in its initialize result the encoding defaults\nto the string value `utf-16`. Implementation considerations: since the\nconversion from one encoding into another requires the content of the\nfile / line the conversion is best done where the file is read which is\nusually on the server side.\n\nPositions are line end character agnostic. So you can not specify a position\nthat denotes `\\r|\\n` or `\\n|` where `|` represents the character offset.\n\n@since 3.17.0 - support for negotiated position encoding.", + "since": "3.17.0 - support for negotiated position encoding." + }, + { + "name": "SelectionRangeOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ] + }, + { + "name": "CallHierarchyOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Call hierarchy options used during static registration.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "SemanticTokensOptions", + "properties": [ + { + "name": "legend", + "type": { + "kind": "reference", + "name": "SemanticTokensLegend" + }, + "documentation": "The legend used by the server" + }, + { + "name": "range", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "literal", + "value": { + "properties": [] + } + } + ] + }, + "optional": true, + "documentation": "Server supports providing semantic tokens for a specific range\nof a document." + }, + { + "name": "full", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "delta", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The server supports deltas for full documents." + } + ] + } + } + ] + }, + "optional": true, + "documentation": "Server supports providing semantic tokens for a full document." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "SemanticTokensEdit", + "properties": [ + { + "name": "start", + "type": { + "kind": "base", + "name": "uinteger" + }, + "documentation": "The start offset of the edit." + }, + { + "name": "deleteCount", + "type": { + "kind": "base", + "name": "uinteger" + }, + "documentation": "The count of elements to remove." + }, + { + "name": "data", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "uinteger" + } + }, + "optional": true, + "documentation": "The elements to insert." + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "LinkedEditingRangeOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ] + }, + { + "name": "FileCreate", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A file:// URI for the location of the file/folder being created." + } + ], + "documentation": "Represents information on a file/folder create.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "TextDocumentEdit", + "properties": [ + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "OptionalVersionedTextDocumentIdentifier" + }, + "documentation": "The text document to change." + }, + { + "name": "edits", + "type": { + "kind": "array", + "element": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "TextEdit" + }, + { + "kind": "reference", + "name": "AnnotatedTextEdit" + } + ] + } + }, + "documentation": "The edits to be applied.\n\n@since 3.16.0 - support for AnnotatedTextEdit. This is guarded using a\nclient capability.", + "since": "3.16.0 - support for AnnotatedTextEdit. This is guarded using a\nclient capability." + } + ], + "documentation": "Describes textual changes on a text document. A TextDocumentEdit describes all changes\non a document version Si and after they are applied move the document to version Si+1.\nSo the creator of a TextDocumentEdit doesn't need to sort the array of edits or do any\nkind of ordering. However the edits must be non overlapping." + }, + { + "name": "CreateFile", + "properties": [ + { + "name": "kind", + "type": { + "kind": "stringLiteral", + "value": "create" + }, + "documentation": "A create" + }, + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The resource to create." + }, + { + "name": "options", + "type": { + "kind": "reference", + "name": "CreateFileOptions" + }, + "optional": true, + "documentation": "Additional options" + } + ], + "extends": [ + { + "kind": "reference", + "name": "ResourceOperation" + } + ], + "documentation": "Create file operation." + }, + { + "name": "RenameFile", + "properties": [ + { + "name": "kind", + "type": { + "kind": "stringLiteral", + "value": "rename" + }, + "documentation": "A rename" + }, + { + "name": "oldUri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The old (existing) location." + }, + { + "name": "newUri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The new location." + }, + { + "name": "options", + "type": { + "kind": "reference", + "name": "RenameFileOptions" + }, + "optional": true, + "documentation": "Rename options." + } + ], + "extends": [ + { + "kind": "reference", + "name": "ResourceOperation" + } + ], + "documentation": "Rename file operation" + }, + { + "name": "DeleteFile", + "properties": [ + { + "name": "kind", + "type": { + "kind": "stringLiteral", + "value": "delete" + }, + "documentation": "A delete" + }, + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The file to delete." + }, + { + "name": "options", + "type": { + "kind": "reference", + "name": "DeleteFileOptions" + }, + "optional": true, + "documentation": "Delete options." + } + ], + "extends": [ + { + "kind": "reference", + "name": "ResourceOperation" + } + ], + "documentation": "Delete file operation" + }, + { + "name": "ChangeAnnotation", + "properties": [ + { + "name": "label", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A human-readable string describing the actual change. The string\nis rendered prominent in the user interface." + }, + { + "name": "needsConfirmation", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "A flag which indicates that user confirmation is needed\nbefore applying the change." + }, + { + "name": "description", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A human-readable string which is rendered less prominent in\nthe user interface." + } + ], + "documentation": "Additional information that describes document changes.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "FileOperationFilter", + "properties": [ + { + "name": "scheme", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A Uri scheme like `file` or `untitled`." + }, + { + "name": "pattern", + "type": { + "kind": "reference", + "name": "FileOperationPattern" + }, + "documentation": "The actual file operation pattern." + } + ], + "documentation": "A filter to describe in which file operation requests or notifications\nthe server is interested in receiving.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "FileRename", + "properties": [ + { + "name": "oldUri", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A file:// URI for the original location of the file/folder being renamed." + }, + { + "name": "newUri", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A file:// URI for the new location of the file/folder being renamed." + } + ], + "documentation": "Represents information on a file/folder rename.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "FileDelete", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A file:// URI for the location of the file/folder being deleted." + } + ], + "documentation": "Represents information on a file/folder delete.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "MonikerOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ] + }, + { + "name": "TypeHierarchyOptions", + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "properties": [], + "documentation": "Type hierarchy options used during static registration.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlineValueContext", + "properties": [ + { + "name": "frameId", + "type": { + "kind": "base", + "name": "integer" + }, + "documentation": "The stack frame (as a DAP Id) where the execution has stopped." + }, + { + "name": "stoppedLocation", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The document range where execution has stopped.\nTypically the end position of the range denotes the line where the inline values are shown." + } + ], + "documentation": "@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlineValueText", + "properties": [ + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The document range for which the inline value applies." + }, + { + "name": "text", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The text of the inline value." + } + ], + "documentation": "Provide inline value as text.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlineValueVariableLookup", + "properties": [ + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The document range for which the inline value applies.\nThe range is used to extract the variable name from the underlying document." + }, + { + "name": "variableName", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "If specified the name of the variable to look up." + }, + { + "name": "caseSensitiveLookup", + "type": { + "kind": "base", + "name": "boolean" + }, + "documentation": "How to perform the lookup." + } + ], + "documentation": "Provide inline value through a variable lookup.\nIf only a range is specified, the variable name will be extracted from the underlying document.\nAn optional variable name can be used to override the extracted name.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlineValueEvaluatableExpression", + "properties": [ + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The document range for which the inline value applies.\nThe range is used to extract the evaluatable expression from the underlying document." + }, + { + "name": "expression", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "If specified the expression overrides the extracted expression." + } + ], + "documentation": "Provide an inline value through an expression evaluation.\nIf only a range is specified, the expression will be extracted from the underlying document.\nAn optional expression can be used to override the extracted expression.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlineValueOptions", + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "properties": [], + "documentation": "Inline value options used during static registration.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlayHintLabelPart", + "properties": [ + { + "name": "value", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The value of this label part." + }, + { + "name": "tooltip", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "reference", + "name": "MarkupContent" + } + ] + }, + "optional": true, + "documentation": "The tooltip text when you hover over this label part. Depending on\nthe client capability `inlayHint.resolveSupport` clients might resolve\nthis property late using the resolve request." + }, + { + "name": "location", + "type": { + "kind": "reference", + "name": "Location" + }, + "optional": true, + "documentation": "An optional source code location that represents this\nlabel part.\n\nThe editor will use this location for the hover and for code navigation\nfeatures: This part will become a clickable link that resolves to the\ndefinition of the symbol at the given location (not necessarily the\nlocation itself), it shows the hover that shows at the given location,\nand it shows a context menu with further code navigation commands.\n\nDepending on the client capability `inlayHint.resolveSupport` clients\nmight resolve this property late using the resolve request." + }, + { + "name": "command", + "type": { + "kind": "reference", + "name": "Command" + }, + "optional": true, + "documentation": "An optional command for this label part.\n\nDepending on the client capability `inlayHint.resolveSupport` clients\nmight resolve this property late using the resolve request." + } + ], + "documentation": "An inlay hint label part allows for interactive and composite labels\nof inlay hints.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "MarkupContent", + "properties": [ + { + "name": "kind", + "type": { + "kind": "reference", + "name": "MarkupKind" + }, + "documentation": "The type of the Markup" + }, + { + "name": "value", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The content itself" + } + ], + "documentation": "A `MarkupContent` literal represents a string value which content is interpreted base on its\nkind flag. Currently the protocol supports `plaintext` and `markdown` as markup kinds.\n\nIf the kind is `markdown` then the value can contain fenced code blocks like in GitHub issues.\nSee https://help.github.com/articles/creating-and-highlighting-code-blocks/#syntax-highlighting\n\nHere is an example how such a string can be constructed using JavaScript / TypeScript:\n```ts\nlet markdown: MarkdownContent = {\n kind: MarkupKind.Markdown,\n value: [\n '# Header',\n 'Some text',\n '```typescript',\n 'someCode();',\n '```'\n ].join('\\n')\n};\n```\n\n*Please Note* that clients might sanitize the return markdown. A client could decide to\nremove HTML from the markdown to avoid script execution." + }, + { + "name": "InlayHintOptions", + "properties": [ + { + "name": "resolveProvider", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The server provides support to resolve additional\ninformation for an inlay hint item." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Inlay hint options used during static registration.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "RelatedFullDocumentDiagnosticReport", + "properties": [ + { + "name": "relatedDocuments", + "type": { + "kind": "map", + "key": { + "kind": "base", + "name": "DocumentUri" + }, + "value": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "FullDocumentDiagnosticReport" + }, + { + "kind": "reference", + "name": "UnchangedDocumentDiagnosticReport" + } + ] + } + }, + "optional": true, + "documentation": "Diagnostics of related documents. This information is useful\nin programming languages where code in a file A can generate\ndiagnostics in a file B which A depends on. An example of\nsuch a language is C/C++ where marco definitions in a file\na.cpp and result in errors in a header file b.hpp.\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "extends": [ + { + "kind": "reference", + "name": "FullDocumentDiagnosticReport" + } + ], + "documentation": "A full diagnostic report with a set of related documents.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "RelatedUnchangedDocumentDiagnosticReport", + "properties": [ + { + "name": "relatedDocuments", + "type": { + "kind": "map", + "key": { + "kind": "base", + "name": "DocumentUri" + }, + "value": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "FullDocumentDiagnosticReport" + }, + { + "kind": "reference", + "name": "UnchangedDocumentDiagnosticReport" + } + ] + } + }, + "optional": true, + "documentation": "Diagnostics of related documents. This information is useful\nin programming languages where code in a file A can generate\ndiagnostics in a file B which A depends on. An example of\nsuch a language is C/C++ where marco definitions in a file\na.cpp and result in errors in a header file b.hpp.\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "extends": [ + { + "kind": "reference", + "name": "UnchangedDocumentDiagnosticReport" + } + ], + "documentation": "An unchanged diagnostic report with a set of related documents.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "FullDocumentDiagnosticReport", + "properties": [ + { + "name": "kind", + "type": { + "kind": "stringLiteral", + "value": "full" + }, + "documentation": "A full document diagnostic report." + }, + { + "name": "resultId", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "An optional result id. If provided it will\nbe sent on the next diagnostic request for the\nsame document." + }, + { + "name": "items", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "Diagnostic" + } + }, + "documentation": "The actual items." + } + ], + "documentation": "A diagnostic report with a full set of problems.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "UnchangedDocumentDiagnosticReport", + "properties": [ + { + "name": "kind", + "type": { + "kind": "stringLiteral", + "value": "unchanged" + }, + "documentation": "A document diagnostic report indicating\nno changes to the last result. A server can\nonly return `unchanged` if result ids are\nprovided." + }, + { + "name": "resultId", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A result id which will be sent on the next\ndiagnostic request for the same document." + } + ], + "documentation": "A diagnostic report indicating that the last returned\nreport is still accurate.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "DiagnosticOptions", + "properties": [ + { + "name": "identifier", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "An optional identifier under which the diagnostics are\nmanaged by the client." + }, + { + "name": "interFileDependencies", + "type": { + "kind": "base", + "name": "boolean" + }, + "documentation": "Whether the language has inter file dependencies meaning that\nediting code in one file can result in a different diagnostic\nset in another file. Inter file dependencies are common for\nmost programming languages and typically uncommon for linters." + }, + { + "name": "workspaceDiagnostics", + "type": { + "kind": "base", + "name": "boolean" + }, + "documentation": "The server provides support for workspace diagnostics as well." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Diagnostic options.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "PreviousResultId", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The URI for which the client knowns a\nresult id." + }, + { + "name": "value", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The value of the previous result id." + } + ], + "documentation": "A previous result id in a workspace pull request.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "NotebookDocument", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "URI" + }, + "documentation": "The notebook document's uri." + }, + { + "name": "notebookType", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The type of the notebook." + }, + { + "name": "version", + "type": { + "kind": "base", + "name": "integer" + }, + "documentation": "The version number of this document (it will increase after each\nchange, including undo/redo)." + }, + { + "name": "metadata", + "type": { + "kind": "reference", + "name": "LSPObject" + }, + "optional": true, + "documentation": "Additional metadata stored with the notebook\ndocument.\n\nNote: should always be an object literal (e.g. LSPObject)" + }, + { + "name": "cells", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "NotebookCell" + } + }, + "documentation": "The cells of a notebook." + } + ], + "documentation": "A notebook document.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "TextDocumentItem", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The text document's uri." + }, + { + "name": "languageId", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The text document's language identifier." + }, + { + "name": "version", + "type": { + "kind": "base", + "name": "integer" + }, + "documentation": "The version number of this document (it will increase after each\nchange, including undo/redo)." + }, + { + "name": "text", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The content of the opened text document." + } + ], + "documentation": "An item to transfer a text document from the client to the\nserver." + }, + { + "name": "VersionedNotebookDocumentIdentifier", + "properties": [ + { + "name": "version", + "type": { + "kind": "base", + "name": "integer" + }, + "documentation": "The version number of this notebook document." + }, + { + "name": "uri", + "type": { + "kind": "base", + "name": "URI" + }, + "documentation": "The notebook document's uri." + } + ], + "documentation": "A versioned notebook document identifier.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "NotebookDocumentChangeEvent", + "properties": [ + { + "name": "metadata", + "type": { + "kind": "reference", + "name": "LSPObject" + }, + "optional": true, + "documentation": "The changed meta data if any.\n\nNote: should always be an object literal (e.g. LSPObject)" + }, + { + "name": "cells", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "structure", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "array", + "type": { + "kind": "reference", + "name": "NotebookCellArrayChange" + }, + "documentation": "The change to the cell array." + }, + { + "name": "didOpen", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextDocumentItem" + } + }, + "optional": true, + "documentation": "Additional opened cell text documents." + }, + { + "name": "didClose", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextDocumentIdentifier" + } + }, + "optional": true, + "documentation": "Additional closed cell text documents." + } + ] + } + }, + "optional": true, + "documentation": "Changes to the cell structure to add or\nremove cells." + }, + { + "name": "data", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "NotebookCell" + } + }, + "optional": true, + "documentation": "Changes to notebook cells properties like its\nkind, execution summary or metadata." + }, + { + "name": "textContent", + "type": { + "kind": "array", + "element": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "document", + "type": { + "kind": "reference", + "name": "VersionedTextDocumentIdentifier" + } + }, + { + "name": "changes", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TextDocumentContentChangeEvent" + } + } + } + ] + } + } + }, + "optional": true, + "documentation": "Changes to the text content of notebook cells." + } + ] + } + }, + "optional": true, + "documentation": "Changes to cells" + } + ], + "documentation": "A change event for a notebook document.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "NotebookDocumentIdentifier", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "URI" + }, + "documentation": "The notebook document's uri." + } + ], + "documentation": "A literal to identify a notebook document in the client.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "Registration", + "properties": [ + { + "name": "id", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The id used to register the request. The id can be used to deregister\nthe request again." + }, + { + "name": "method", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The method / capability to register for." + }, + { + "name": "registerOptions", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "Options necessary for the registration." + } + ], + "documentation": "General parameters to to register for an notification or to register a provider." + }, + { + "name": "Unregistration", + "properties": [ + { + "name": "id", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The id used to unregister the request or notification. Usually an id\nprovided during the register request." + }, + { + "name": "method", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The method to unregister for." + } + ], + "documentation": "General parameters to unregister a request or notification." + }, + { + "name": "_InitializeParams", + "properties": [ + { + "name": "processId", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "integer" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "documentation": "The process Id of the parent process that started\nthe server.\n\nIs `null` if the process has not been started by another process.\nIf the parent process is not alive then the server should exit." + }, + { + "name": "clientInfo", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "name", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The name of the client as defined by the client." + }, + { + "name": "version", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The client's version as defined by the client." + } + ] + } + }, + "optional": true, + "documentation": "Information about the client\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "locale", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The locale the client is currently showing the user interface\nin. This must not necessarily be the locale of the operating\nsystem.\n\nUses IETF language tags as the value's syntax\n(See https://en.wikipedia.org/wiki/IETF_language_tag)\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "rootPath", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "optional": true, + "documentation": "The rootPath of the workspace. Is null\nif no folder is open.\n\n@deprecated in favour of rootUri.", + "deprecated": "in favour of rootUri." + }, + { + "name": "rootUri", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "DocumentUri" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "documentation": "The rootUri of the workspace. Is null if no\nfolder is open. If both `rootPath` and `rootUri` are set\n`rootUri` wins.\n\n@deprecated in favour of workspaceFolders.", + "deprecated": "in favour of workspaceFolders." + }, + { + "name": "capabilities", + "type": { + "kind": "reference", + "name": "ClientCapabilities" + }, + "documentation": "The capabilities provided by the client (editor or tool)" + }, + { + "name": "initializationOptions", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "User provided initialization options." + }, + { + "name": "trace", + "type": { + "kind": "reference", + "name": "TraceValues" + }, + "optional": true, + "documentation": "The initial trace setting. If omitted trace is disabled ('off')." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressParams" + } + ], + "documentation": "The initialize parameters" + }, + { + "name": "WorkspaceFoldersInitializeParams", + "properties": [ + { + "name": "workspaceFolders", + "type": { + "kind": "or", + "items": [ + { + "kind": "array", + "element": { + "kind": "reference", + "name": "WorkspaceFolder" + } + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "optional": true, + "documentation": "The workspace folders configured in the client when the server starts.\n\nThis property is only available if the client supports workspace folders.\nIt can be `null` if the client supports workspace folders but none are\nconfigured.\n\n@since 3.6.0", + "since": "3.6.0" + } + ] + }, + { + "name": "ServerCapabilities", + "properties": [ + { + "name": "positionEncoding", + "type": { + "kind": "reference", + "name": "PositionEncodingKind" + }, + "optional": true, + "documentation": "The position encoding the server picked from the encodings offered\nby the client via the client capability `general.positionEncodings`.\n\nIf the client didn't provide any position encodings the only valid\nvalue that a server can return is 'utf-16'.\n\nIf omitted it defaults to 'utf-16'.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "textDocumentSync", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "TextDocumentSyncOptions" + }, + { + "kind": "reference", + "name": "TextDocumentSyncKind" + } + ] + }, + "optional": true, + "documentation": "Defines how text documents are synced. Is either a detailed structure\ndefining each notification or for backwards compatibility the\nTextDocumentSyncKind number." + }, + { + "name": "notebookDocumentSync", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "NotebookDocumentSyncOptions" + }, + { + "kind": "reference", + "name": "NotebookDocumentSyncRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "Defines how notebook documents are synced.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "completionProvider", + "type": { + "kind": "reference", + "name": "CompletionOptions" + }, + "optional": true, + "documentation": "The server provides completion support." + }, + { + "name": "hoverProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "HoverOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides hover support." + }, + { + "name": "signatureHelpProvider", + "type": { + "kind": "reference", + "name": "SignatureHelpOptions" + }, + "optional": true, + "documentation": "The server provides signature help support." + }, + { + "name": "declarationProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "DeclarationOptions" + }, + { + "kind": "reference", + "name": "DeclarationRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides Goto Declaration support." + }, + { + "name": "definitionProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "DefinitionOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides goto definition support." + }, + { + "name": "typeDefinitionProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "TypeDefinitionOptions" + }, + { + "kind": "reference", + "name": "TypeDefinitionRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides Goto Type Definition support." + }, + { + "name": "implementationProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "ImplementationOptions" + }, + { + "kind": "reference", + "name": "ImplementationRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides Goto Implementation support." + }, + { + "name": "referencesProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "ReferenceOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides find references support." + }, + { + "name": "documentHighlightProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "DocumentHighlightOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides document highlight support." + }, + { + "name": "documentSymbolProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "DocumentSymbolOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides document symbol support." + }, + { + "name": "codeActionProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "CodeActionOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides code actions. CodeActionOptions may only be\nspecified if the client states that it supports\n`codeActionLiteralSupport` in its initial `initialize` request." + }, + { + "name": "codeLensProvider", + "type": { + "kind": "reference", + "name": "CodeLensOptions" + }, + "optional": true, + "documentation": "The server provides code lens." + }, + { + "name": "documentLinkProvider", + "type": { + "kind": "reference", + "name": "DocumentLinkOptions" + }, + "optional": true, + "documentation": "The server provides document link support." + }, + { + "name": "colorProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "DocumentColorOptions" + }, + { + "kind": "reference", + "name": "DocumentColorRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides color provider support." + }, + { + "name": "workspaceSymbolProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "WorkspaceSymbolOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides workspace symbol support." + }, + { + "name": "documentFormattingProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "DocumentFormattingOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides document formatting." + }, + { + "name": "documentRangeFormattingProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "DocumentRangeFormattingOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides document range formatting." + }, + { + "name": "documentOnTypeFormattingProvider", + "type": { + "kind": "reference", + "name": "DocumentOnTypeFormattingOptions" + }, + "optional": true, + "documentation": "The server provides document formatting on typing." + }, + { + "name": "renameProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "RenameOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides rename support. RenameOptions may only be\nspecified if the client states that it supports\n`prepareSupport` in its initial `initialize` request." + }, + { + "name": "foldingRangeProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "FoldingRangeOptions" + }, + { + "kind": "reference", + "name": "FoldingRangeRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides folding provider support." + }, + { + "name": "selectionRangeProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "SelectionRangeOptions" + }, + { + "kind": "reference", + "name": "SelectionRangeRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides selection range support." + }, + { + "name": "executeCommandProvider", + "type": { + "kind": "reference", + "name": "ExecuteCommandOptions" + }, + "optional": true, + "documentation": "The server provides execute command support." + }, + { + "name": "callHierarchyProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "CallHierarchyOptions" + }, + { + "kind": "reference", + "name": "CallHierarchyRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides call hierarchy support.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "linkedEditingRangeProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "LinkedEditingRangeOptions" + }, + { + "kind": "reference", + "name": "LinkedEditingRangeRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides linked editing range support.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "semanticTokensProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "SemanticTokensOptions" + }, + { + "kind": "reference", + "name": "SemanticTokensRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides semantic tokens support.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "monikerProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "MonikerOptions" + }, + { + "kind": "reference", + "name": "MonikerRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides moniker support.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "typeHierarchyProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "TypeHierarchyOptions" + }, + { + "kind": "reference", + "name": "TypeHierarchyRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides type hierarchy support.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "inlineValueProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "InlineValueOptions" + }, + { + "kind": "reference", + "name": "InlineValueRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides inline values.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "inlayHintProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "InlayHintOptions" + }, + { + "kind": "reference", + "name": "InlayHintRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server provides inlay hints.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "diagnosticProvider", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "DiagnosticOptions" + }, + { + "kind": "reference", + "name": "DiagnosticRegistrationOptions" + } + ] + }, + "optional": true, + "documentation": "The server has support for pull model diagnostics.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "workspace", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "workspaceFolders", + "type": { + "kind": "reference", + "name": "WorkspaceFoldersServerCapabilities" + }, + "optional": true, + "documentation": "The server supports workspace folder.\n\n@since 3.6.0", + "since": "3.6.0" + }, + { + "name": "fileOperations", + "type": { + "kind": "reference", + "name": "FileOperationOptions" + }, + "optional": true, + "documentation": "The server is interested in notifications/requests for operations on files.\n\n@since 3.16.0", + "since": "3.16.0" + } + ] + } + }, + "optional": true, + "documentation": "Workspace specific server capabilities." + }, + { + "name": "experimental", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "Experimental server capabilities." + } + ], + "documentation": "Defines the capabilities provided by a language\nserver." + }, + { + "name": "VersionedTextDocumentIdentifier", + "properties": [ + { + "name": "version", + "type": { + "kind": "base", + "name": "integer" + }, + "documentation": "The version number of this document." + } + ], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentIdentifier" + } + ], + "documentation": "A text document identifier to denote a specific version of a text document." + }, + { + "name": "SaveOptions", + "properties": [ + { + "name": "includeText", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client is supposed to include the content on save." + } + ], + "documentation": "Save options." + }, + { + "name": "FileEvent", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The file's uri." + }, + { + "name": "type", + "type": { + "kind": "reference", + "name": "FileChangeType" + }, + "documentation": "The change type." + } + ], + "documentation": "An event describing a file change." + }, + { + "name": "FileSystemWatcher", + "properties": [ + { + "name": "globPattern", + "type": { + "kind": "reference", + "name": "GlobPattern" + }, + "documentation": "The glob pattern to watch. See {@link GlobPattern glob pattern} for more detail.\n\n@since 3.17.0 support for relative patterns.", + "since": "3.17.0 support for relative patterns." + }, + { + "name": "kind", + "type": { + "kind": "reference", + "name": "WatchKind" + }, + "optional": true, + "documentation": "The kind of events of interest. If omitted it defaults\nto WatchKind.Create | WatchKind.Change | WatchKind.Delete\nwhich is 7." + } + ] + }, + { + "name": "Diagnostic", + "properties": [ + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range at which the message applies" + }, + { + "name": "severity", + "type": { + "kind": "reference", + "name": "DiagnosticSeverity" + }, + "optional": true, + "documentation": "The diagnostic's severity. Can be omitted. If omitted it is up to the\nclient to interpret diagnostics as error, warning, info or hint." + }, + { + "name": "code", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "integer" + }, + { + "kind": "base", + "name": "string" + } + ] + }, + "optional": true, + "documentation": "The diagnostic's code, which usually appear in the user interface." + }, + { + "name": "codeDescription", + "type": { + "kind": "reference", + "name": "CodeDescription" + }, + "optional": true, + "documentation": "An optional property to describe the error code.\nRequires the code field (above) to be present/not null.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "source", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A human-readable string describing the source of this\ndiagnostic, e.g. 'typescript' or 'super lint'. It usually\nappears in the user interface." + }, + { + "name": "message", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The diagnostic's message. It usually appears in the user interface" + }, + { + "name": "tags", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "DiagnosticTag" + } + }, + "optional": true, + "documentation": "Additional metadata about the diagnostic.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "relatedInformation", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "DiagnosticRelatedInformation" + } + }, + "optional": true, + "documentation": "An array of related diagnostic information, e.g. when symbol-names within\na scope collide all definitions can be marked via this property." + }, + { + "name": "data", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "A data entry field that is preserved between a `textDocument/publishDiagnostics`\nnotification and `textDocument/codeAction` request.\n\n@since 3.16.0", + "since": "3.16.0" + } + ], + "documentation": "Represents a diagnostic, such as a compiler error or warning. Diagnostic objects\nare only valid in the scope of a resource." + }, + { + "name": "CompletionContext", + "properties": [ + { + "name": "triggerKind", + "type": { + "kind": "reference", + "name": "CompletionTriggerKind" + }, + "documentation": "How the completion was triggered." + }, + { + "name": "triggerCharacter", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The trigger character (a single character) that has trigger code complete.\nIs undefined if `triggerKind !== CompletionTriggerKind.TriggerCharacter`" + } + ], + "documentation": "Contains additional information about the context in which a completion request is triggered." + }, + { + "name": "CompletionItemLabelDetails", + "properties": [ + { + "name": "detail", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "An optional string which is rendered less prominently directly after {@link CompletionItem.label label},\nwithout any spacing. Should be used for function signatures and type annotations." + }, + { + "name": "description", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "An optional string which is rendered less prominently after {@link CompletionItem.detail}. Should be used\nfor fully qualified names and file paths." + } + ], + "documentation": "Additional details for a completion item label.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InsertReplaceEdit", + "properties": [ + { + "name": "newText", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The string to be inserted." + }, + { + "name": "insert", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range if the insert is requested" + }, + { + "name": "replace", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range if the replace is requested." + } + ], + "documentation": "A special text edit to provide an insert and a replace operation.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "CompletionOptions", + "properties": [ + { + "name": "triggerCharacters", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "optional": true, + "documentation": "Most tools trigger completion request automatically without explicitly requesting\nit using a keyboard shortcut (e.g. Ctrl+Space). Typically they do so when the user\nstarts to type an identifier. For example if the user types `c` in a JavaScript file\ncode complete will automatically pop up present `console` besides others as a\ncompletion item. Characters that make up identifiers don't need to be listed here.\n\nIf code complete should automatically be trigger on characters not being valid inside\nan identifier (for example `.` in JavaScript) list them in `triggerCharacters`." + }, + { + "name": "allCommitCharacters", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "optional": true, + "documentation": "The list of all possible characters that commit a completion. This field can be used\nif clients don't support individual commit characters per completion item. See\n`ClientCapabilities.textDocument.completion.completionItem.commitCharactersSupport`\n\nIf a server provides both `allCommitCharacters` and commit characters on an individual\ncompletion item the ones on the completion item win.\n\n@since 3.2.0", + "since": "3.2.0" + }, + { + "name": "resolveProvider", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The server provides support to resolve additional\ninformation for a completion item." + }, + { + "name": "completionItem", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "labelDetailsSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The server has support for completion item label\ndetails (see also `CompletionItemLabelDetails`) when\nreceiving a completion item in a resolve call.\n\n@since 3.17.0", + "since": "3.17.0" + } + ] + } + }, + "optional": true, + "documentation": "The server supports the following `CompletionItem` specific\ncapabilities.\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Completion options." + }, + { + "name": "HoverOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Hover options." + }, + { + "name": "SignatureHelpContext", + "properties": [ + { + "name": "triggerKind", + "type": { + "kind": "reference", + "name": "SignatureHelpTriggerKind" + }, + "documentation": "Action that caused signature help to be triggered." + }, + { + "name": "triggerCharacter", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "Character that caused signature help to be triggered.\n\nThis is undefined when `triggerKind !== SignatureHelpTriggerKind.TriggerCharacter`" + }, + { + "name": "isRetrigger", + "type": { + "kind": "base", + "name": "boolean" + }, + "documentation": "`true` if signature help was already showing when it was triggered.\n\nRetriggers occurs when the signature help is already active and can be caused by actions such as\ntyping a trigger character, a cursor move, or document content changes." + }, + { + "name": "activeSignatureHelp", + "type": { + "kind": "reference", + "name": "SignatureHelp" + }, + "optional": true, + "documentation": "The currently active `SignatureHelp`.\n\nThe `activeSignatureHelp` has its `SignatureHelp.activeSignature` field updated based on\nthe user navigating through available signatures." + } + ], + "documentation": "Additional information about the context in which a signature help request was triggered.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "SignatureInformation", + "properties": [ + { + "name": "label", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The label of this signature. Will be shown in\nthe UI." + }, + { + "name": "documentation", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "reference", + "name": "MarkupContent" + } + ] + }, + "optional": true, + "documentation": "The human-readable doc-comment of this signature. Will be shown\nin the UI but can be omitted." + }, + { + "name": "parameters", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "ParameterInformation" + } + }, + "optional": true, + "documentation": "The parameters of this signature." + }, + { + "name": "activeParameter", + "type": { + "kind": "base", + "name": "uinteger" + }, + "optional": true, + "documentation": "The index of the active parameter.\n\nIf provided, this is used in place of `SignatureHelp.activeParameter`.\n\n@since 3.16.0", + "since": "3.16.0" + } + ], + "documentation": "Represents the signature of something callable. A signature\ncan have a label, like a function-name, a doc-comment, and\na set of parameters." + }, + { + "name": "SignatureHelpOptions", + "properties": [ + { + "name": "triggerCharacters", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "optional": true, + "documentation": "List of characters that trigger signature help automatically." + }, + { + "name": "retriggerCharacters", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "optional": true, + "documentation": "List of characters that re-trigger signature help.\n\nThese trigger characters are only active when signature help is already showing. All trigger characters\nare also counted as re-trigger characters.\n\n@since 3.15.0", + "since": "3.15.0" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Server Capabilities for a {@link SignatureHelpRequest}." + }, + { + "name": "DefinitionOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Server Capabilities for a {@link DefinitionRequest}." + }, + { + "name": "ReferenceContext", + "properties": [ + { + "name": "includeDeclaration", + "type": { + "kind": "base", + "name": "boolean" + }, + "documentation": "Include the declaration of the current symbol." + } + ], + "documentation": "Value-object that contains additional information when\nrequesting references." + }, + { + "name": "ReferenceOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Reference options." + }, + { + "name": "DocumentHighlightOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Provider options for a {@link DocumentHighlightRequest}." + }, + { + "name": "BaseSymbolInformation", + "properties": [ + { + "name": "name", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The name of this symbol." + }, + { + "name": "kind", + "type": { + "kind": "reference", + "name": "SymbolKind" + }, + "documentation": "The kind of this symbol." + }, + { + "name": "tags", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "SymbolTag" + } + }, + "optional": true, + "documentation": "Tags for this symbol.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "containerName", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The name of the symbol containing this symbol. This information is for\nuser interface purposes (e.g. to render a qualifier in the user interface\nif necessary). It can't be used to re-infer a hierarchy for the document\nsymbols." + } + ], + "documentation": "A base for all symbol information." + }, + { + "name": "DocumentSymbolOptions", + "properties": [ + { + "name": "label", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A human-readable string that is shown when multiple outlines trees\nare shown for the same document.\n\n@since 3.16.0", + "since": "3.16.0" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Provider options for a {@link DocumentSymbolRequest}." + }, + { + "name": "CodeActionContext", + "properties": [ + { + "name": "diagnostics", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "Diagnostic" + } + }, + "documentation": "An array of diagnostics known on the client side overlapping the range provided to the\n`textDocument/codeAction` request. They are provided so that the server knows which\nerrors are currently presented to the user for the given range. There is no guarantee\nthat these accurately reflect the error state of the resource. The primary parameter\nto compute code actions is the provided range." + }, + { + "name": "only", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "CodeActionKind" + } + }, + "optional": true, + "documentation": "Requested kind of actions to return.\n\nActions not of this kind are filtered out by the client before being shown. So servers\ncan omit computing them." + }, + { + "name": "triggerKind", + "type": { + "kind": "reference", + "name": "CodeActionTriggerKind" + }, + "optional": true, + "documentation": "The reason why code actions were requested.\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "documentation": "Contains additional diagnostic information about the context in which\na {@link CodeActionProvider.provideCodeActions code action} is run." + }, + { + "name": "CodeActionOptions", + "properties": [ + { + "name": "codeActionKinds", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "CodeActionKind" + } + }, + "optional": true, + "documentation": "CodeActionKinds that this server may return.\n\nThe list of kinds may be generic, such as `CodeActionKind.Refactor`, or the server\nmay list out every specific kind they provide." + }, + { + "name": "resolveProvider", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The server provides support to resolve additional\ninformation for a code action.\n\n@since 3.16.0", + "since": "3.16.0" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Provider options for a {@link CodeActionRequest}." + }, + { + "name": "WorkspaceSymbolOptions", + "properties": [ + { + "name": "resolveProvider", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The server provides support to resolve additional\ninformation for a workspace symbol.\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Server capabilities for a {@link WorkspaceSymbolRequest}." + }, + { + "name": "CodeLensOptions", + "properties": [ + { + "name": "resolveProvider", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Code lens has a resolve provider as well." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Code Lens provider options of a {@link CodeLensRequest}." + }, + { + "name": "DocumentLinkOptions", + "properties": [ + { + "name": "resolveProvider", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Document links have a resolve provider as well." + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Provider options for a {@link DocumentLinkRequest}." + }, + { + "name": "FormattingOptions", + "properties": [ + { + "name": "tabSize", + "type": { + "kind": "base", + "name": "uinteger" + }, + "documentation": "Size of a tab in spaces." + }, + { + "name": "insertSpaces", + "type": { + "kind": "base", + "name": "boolean" + }, + "documentation": "Prefer spaces over tabs." + }, + { + "name": "trimTrailingWhitespace", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Trim trailing whitespace on a line.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "insertFinalNewline", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Insert a newline character at the end of the file if one does not exist.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "trimFinalNewlines", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Trim all newlines after the final newline at the end of the file.\n\n@since 3.15.0", + "since": "3.15.0" + } + ], + "documentation": "Value-object describing what options formatting should use." + }, + { + "name": "DocumentFormattingOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Provider options for a {@link DocumentFormattingRequest}." + }, + { + "name": "DocumentRangeFormattingOptions", + "properties": [], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Provider options for a {@link DocumentRangeFormattingRequest}." + }, + { + "name": "DocumentOnTypeFormattingOptions", + "properties": [ + { + "name": "firstTriggerCharacter", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A character on which formatting should be triggered, like `{`." + }, + { + "name": "moreTriggerCharacter", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "optional": true, + "documentation": "More trigger characters." + } + ], + "documentation": "Provider options for a {@link DocumentOnTypeFormattingRequest}." + }, + { + "name": "RenameOptions", + "properties": [ + { + "name": "prepareProvider", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Renames should be checked and tested before being executed.\n\n@since version 3.12.0", + "since": "version 3.12.0" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "Provider options for a {@link RenameRequest}." + }, + { + "name": "ExecuteCommandOptions", + "properties": [ + { + "name": "commands", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "documentation": "The commands to be executed on the server" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "WorkDoneProgressOptions" + } + ], + "documentation": "The server capabilities of a {@link ExecuteCommandRequest}." + }, + { + "name": "SemanticTokensLegend", + "properties": [ + { + "name": "tokenTypes", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "documentation": "The token types a server uses." + }, + { + "name": "tokenModifiers", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "documentation": "The token modifiers a server uses." + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "OptionalVersionedTextDocumentIdentifier", + "properties": [ + { + "name": "version", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "integer" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "documentation": "The version number of this document. If a versioned text document identifier\nis sent from the server to the client and the file is not open in the editor\n(the server has not received an open notification before) the server can send\n`null` to indicate that the version is unknown and the content on disk is the\ntruth (as specified with document content ownership)." + } + ], + "extends": [ + { + "kind": "reference", + "name": "TextDocumentIdentifier" + } + ], + "documentation": "A text document identifier to optionally denote a specific version of a text document." + }, + { + "name": "AnnotatedTextEdit", + "properties": [ + { + "name": "annotationId", + "type": { + "kind": "reference", + "name": "ChangeAnnotationIdentifier" + }, + "documentation": "The actual identifier of the change annotation" + } + ], + "extends": [ + { + "kind": "reference", + "name": "TextEdit" + } + ], + "documentation": "A special text edit with an additional change annotation.\n\n@since 3.16.0.", + "since": "3.16.0." + }, + { + "name": "ResourceOperation", + "properties": [ + { + "name": "kind", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The resource operation kind." + }, + { + "name": "annotationId", + "type": { + "kind": "reference", + "name": "ChangeAnnotationIdentifier" + }, + "optional": true, + "documentation": "An optional annotation identifier describing the operation.\n\n@since 3.16.0", + "since": "3.16.0" + } + ], + "documentation": "A generic resource operation." + }, + { + "name": "CreateFileOptions", + "properties": [ + { + "name": "overwrite", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Overwrite existing file. Overwrite wins over `ignoreIfExists`" + }, + { + "name": "ignoreIfExists", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Ignore if exists." + } + ], + "documentation": "Options to create a file." + }, + { + "name": "RenameFileOptions", + "properties": [ + { + "name": "overwrite", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Overwrite target if existing. Overwrite wins over `ignoreIfExists`" + }, + { + "name": "ignoreIfExists", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Ignores if target exists." + } + ], + "documentation": "Rename file options" + }, + { + "name": "DeleteFileOptions", + "properties": [ + { + "name": "recursive", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Delete the content recursively if a folder is denoted." + }, + { + "name": "ignoreIfNotExists", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Ignore the operation if the file doesn't exist." + } + ], + "documentation": "Delete file options" + }, + { + "name": "FileOperationPattern", + "properties": [ + { + "name": "glob", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The glob pattern to match. Glob patterns can have the following syntax:\n- `*` to match one or more characters in a path segment\n- `?` to match on one character in a path segment\n- `**` to match any number of path segments, including none\n- `{}` to group sub patterns into an OR expression. (e.g. `**​/*.{ts,js}` matches all TypeScript and JavaScript files)\n- `[]` to declare a range of characters to match in a path segment (e.g., `example.[0-9]` to match on `example.0`, `example.1`, …)\n- `[!...]` to negate a range of characters to match in a path segment (e.g., `example.[!0-9]` to match on `example.a`, `example.b`, but not `example.0`)" + }, + { + "name": "matches", + "type": { + "kind": "reference", + "name": "FileOperationPatternKind" + }, + "optional": true, + "documentation": "Whether to match files or folders with this pattern.\n\nMatches both if undefined." + }, + { + "name": "options", + "type": { + "kind": "reference", + "name": "FileOperationPatternOptions" + }, + "optional": true, + "documentation": "Additional options used during matching." + } + ], + "documentation": "A pattern to describe in which file operation requests or notifications\nthe server is interested in receiving.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "WorkspaceFullDocumentDiagnosticReport", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The URI for which diagnostic information is reported." + }, + { + "name": "version", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "integer" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "documentation": "The version number for which the diagnostics are reported.\nIf the document is not marked as open `null` can be provided." + } + ], + "extends": [ + { + "kind": "reference", + "name": "FullDocumentDiagnosticReport" + } + ], + "documentation": "A full document diagnostic report for a workspace diagnostic result.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "WorkspaceUnchangedDocumentDiagnosticReport", + "properties": [ + { + "name": "uri", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The URI for which diagnostic information is reported." + }, + { + "name": "version", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "integer" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "documentation": "The version number for which the diagnostics are reported.\nIf the document is not marked as open `null` can be provided." + } + ], + "extends": [ + { + "kind": "reference", + "name": "UnchangedDocumentDiagnosticReport" + } + ], + "documentation": "An unchanged document diagnostic report for a workspace diagnostic result.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "NotebookCell", + "properties": [ + { + "name": "kind", + "type": { + "kind": "reference", + "name": "NotebookCellKind" + }, + "documentation": "The cell's kind" + }, + { + "name": "document", + "type": { + "kind": "base", + "name": "DocumentUri" + }, + "documentation": "The URI of the cell's text document\ncontent." + }, + { + "name": "metadata", + "type": { + "kind": "reference", + "name": "LSPObject" + }, + "optional": true, + "documentation": "Additional metadata stored with the cell.\n\nNote: should always be an object literal (e.g. LSPObject)" + }, + { + "name": "executionSummary", + "type": { + "kind": "reference", + "name": "ExecutionSummary" + }, + "optional": true, + "documentation": "Additional execution summary information\nif supported by the client." + } + ], + "documentation": "A notebook cell.\n\nA cell's document URI must be unique across ALL notebook\ncells and can therefore be used to uniquely identify a\nnotebook cell or the cell's text document.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "NotebookCellArrayChange", + "properties": [ + { + "name": "start", + "type": { + "kind": "base", + "name": "uinteger" + }, + "documentation": "The start oftest of the cell that changed." + }, + { + "name": "deleteCount", + "type": { + "kind": "base", + "name": "uinteger" + }, + "documentation": "The deleted cells" + }, + { + "name": "cells", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "NotebookCell" + } + }, + "optional": true, + "documentation": "The new cells, if any" + } + ], + "documentation": "A change describing how to move a `NotebookCell`\narray from state S to S'.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "ClientCapabilities", + "properties": [ + { + "name": "workspace", + "type": { + "kind": "reference", + "name": "WorkspaceClientCapabilities" + }, + "optional": true, + "documentation": "Workspace specific client capabilities." + }, + { + "name": "textDocument", + "type": { + "kind": "reference", + "name": "TextDocumentClientCapabilities" + }, + "optional": true, + "documentation": "Text document specific client capabilities." + }, + { + "name": "notebookDocument", + "type": { + "kind": "reference", + "name": "NotebookDocumentClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the notebook document support.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "window", + "type": { + "kind": "reference", + "name": "WindowClientCapabilities" + }, + "optional": true, + "documentation": "Window specific client capabilities." + }, + { + "name": "general", + "type": { + "kind": "reference", + "name": "GeneralClientCapabilities" + }, + "optional": true, + "documentation": "General client capabilities.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "experimental", + "type": { + "kind": "reference", + "name": "LSPAny" + }, + "optional": true, + "documentation": "Experimental client capabilities." + } + ], + "documentation": "Defines the capabilities provided by the client." + }, + { + "name": "TextDocumentSyncOptions", + "properties": [ + { + "name": "openClose", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Open and close notifications are sent to the server. If omitted open close notification should not\nbe sent." + }, + { + "name": "change", + "type": { + "kind": "reference", + "name": "TextDocumentSyncKind" + }, + "optional": true, + "documentation": "Change notifications are sent to the server. See TextDocumentSyncKind.None, TextDocumentSyncKind.Full\nand TextDocumentSyncKind.Incremental. If omitted it defaults to TextDocumentSyncKind.None." + }, + { + "name": "willSave", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "If present will save notifications are sent to the server. If omitted the notification should not be\nsent." + }, + { + "name": "willSaveWaitUntil", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "If present will save wait until requests are sent to the server. If omitted the request should not be\nsent." + }, + { + "name": "save", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "reference", + "name": "SaveOptions" + } + ] + }, + "optional": true, + "documentation": "If present save notifications are sent to the server. If omitted the notification should not be\nsent." + } + ] + }, + { + "name": "NotebookDocumentSyncOptions", + "properties": [ + { + "name": "notebookSelector", + "type": { + "kind": "array", + "element": { + "kind": "or", + "items": [ + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "notebook", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "reference", + "name": "NotebookDocumentFilter" + } + ] + }, + "documentation": "The notebook to be synced If a string\nvalue is provided it matches against the\nnotebook type. '*' matches every notebook." + }, + { + "name": "cells", + "type": { + "kind": "array", + "element": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "language", + "type": { + "kind": "base", + "name": "string" + } + } + ] + } + } + }, + "optional": true, + "documentation": "The cells of the matching notebook to be synced." + } + ] + } + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "notebook", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "reference", + "name": "NotebookDocumentFilter" + } + ] + }, + "optional": true, + "documentation": "The notebook to be synced If a string\nvalue is provided it matches against the\nnotebook type. '*' matches every notebook." + }, + { + "name": "cells", + "type": { + "kind": "array", + "element": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "language", + "type": { + "kind": "base", + "name": "string" + } + } + ] + } + } + }, + "documentation": "The cells of the matching notebook to be synced." + } + ] + } + } + ] + } + }, + "documentation": "The notebooks to be synced" + }, + { + "name": "save", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether save notification should be forwarded to\nthe server. Will only be honored if mode === `notebook`." + } + ], + "documentation": "Options specific to a notebook plus its cells\nto be synced to the server.\n\nIf a selector provides a notebook document\nfilter but no cell selector all cells of a\nmatching notebook document will be synced.\n\nIf a selector provides no notebook document\nfilter but only a cell selector all notebook\ndocument that contain at least one matching\ncell will be synced.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "NotebookDocumentSyncRegistrationOptions", + "properties": [], + "extends": [ + { + "kind": "reference", + "name": "NotebookDocumentSyncOptions" + } + ], + "mixins": [ + { + "kind": "reference", + "name": "StaticRegistrationOptions" + } + ], + "documentation": "Registration options specific to a notebook.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "WorkspaceFoldersServerCapabilities", + "properties": [ + { + "name": "supported", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The server has support for workspace folders" + }, + { + "name": "changeNotifications", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "base", + "name": "boolean" + } + ] + }, + "optional": true, + "documentation": "Whether the server wants to receive workspace folder\nchange notifications.\n\nIf a string is provided the string is treated as an ID\nunder which the notification is registered on the client\nside. The ID can be used to unregister for these events\nusing the `client/unregisterCapability` request." + } + ] + }, + { + "name": "FileOperationOptions", + "properties": [ + { + "name": "didCreate", + "type": { + "kind": "reference", + "name": "FileOperationRegistrationOptions" + }, + "optional": true, + "documentation": "The server is interested in receiving didCreateFiles notifications." + }, + { + "name": "willCreate", + "type": { + "kind": "reference", + "name": "FileOperationRegistrationOptions" + }, + "optional": true, + "documentation": "The server is interested in receiving willCreateFiles requests." + }, + { + "name": "didRename", + "type": { + "kind": "reference", + "name": "FileOperationRegistrationOptions" + }, + "optional": true, + "documentation": "The server is interested in receiving didRenameFiles notifications." + }, + { + "name": "willRename", + "type": { + "kind": "reference", + "name": "FileOperationRegistrationOptions" + }, + "optional": true, + "documentation": "The server is interested in receiving willRenameFiles requests." + }, + { + "name": "didDelete", + "type": { + "kind": "reference", + "name": "FileOperationRegistrationOptions" + }, + "optional": true, + "documentation": "The server is interested in receiving didDeleteFiles file notifications." + }, + { + "name": "willDelete", + "type": { + "kind": "reference", + "name": "FileOperationRegistrationOptions" + }, + "optional": true, + "documentation": "The server is interested in receiving willDeleteFiles file requests." + } + ], + "documentation": "Options for notifications/requests for user operations on files.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "CodeDescription", + "properties": [ + { + "name": "href", + "type": { + "kind": "base", + "name": "URI" + }, + "documentation": "An URI to open with more information about the diagnostic error." + } + ], + "documentation": "Structure to capture a description for an error code.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "DiagnosticRelatedInformation", + "properties": [ + { + "name": "location", + "type": { + "kind": "reference", + "name": "Location" + }, + "documentation": "The location of this related diagnostic information." + }, + { + "name": "message", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The message of this related diagnostic information." + } + ], + "documentation": "Represents a related message and source code location for a diagnostic. This should be\nused to point to code locations that cause or related to a diagnostics, e.g when duplicating\na symbol in a scope." + }, + { + "name": "ParameterInformation", + "properties": [ + { + "name": "label", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "tuple", + "items": [ + { + "kind": "base", + "name": "uinteger" + }, + { + "kind": "base", + "name": "uinteger" + } + ] + } + ] + }, + "documentation": "The label of this parameter information.\n\nEither a string or an inclusive start and exclusive end offsets within its containing\nsignature label. (see SignatureInformation.label). The offsets are based on a UTF-16\nstring representation as `Position` and `Range` does.\n\n*Note*: a label of type string should be a substring of its containing signature label.\nIts intended use case is to highlight the parameter label part in the `SignatureInformation.label`." + }, + { + "name": "documentation", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "reference", + "name": "MarkupContent" + } + ] + }, + "optional": true, + "documentation": "The human-readable doc-comment of this parameter. Will be shown\nin the UI but can be omitted." + } + ], + "documentation": "Represents a parameter of a callable-signature. A parameter can\nhave a label and a doc-comment." + }, + { + "name": "NotebookCellTextDocumentFilter", + "properties": [ + { + "name": "notebook", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "reference", + "name": "NotebookDocumentFilter" + } + ] + }, + "documentation": "A filter that matches against the notebook\ncontaining the notebook cell. If a string\nvalue is provided it matches against the\nnotebook type. '*' matches every notebook." + }, + { + "name": "language", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A language id like `python`.\n\nWill be matched against the language id of the\nnotebook cell document. '*' matches every language." + } + ], + "documentation": "A notebook cell text document filter denotes a cell text\ndocument by different properties.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "FileOperationPatternOptions", + "properties": [ + { + "name": "ignoreCase", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The pattern should be matched ignoring casing." + } + ], + "documentation": "Matching options for the file operation pattern.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "ExecutionSummary", + "properties": [ + { + "name": "executionOrder", + "type": { + "kind": "base", + "name": "uinteger" + }, + "documentation": "A strict monotonically increasing value\nindicating the execution order of a cell\ninside a notebook." + }, + { + "name": "success", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the execution was successful or\nnot if known by the client." + } + ] + }, + { + "name": "WorkspaceClientCapabilities", + "properties": [ + { + "name": "applyEdit", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports applying batch edits\nto the workspace by supporting the request\n'workspace/applyEdit'" + }, + { + "name": "workspaceEdit", + "type": { + "kind": "reference", + "name": "WorkspaceEditClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to `WorkspaceEdit`s." + }, + { + "name": "didChangeConfiguration", + "type": { + "kind": "reference", + "name": "DidChangeConfigurationClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `workspace/didChangeConfiguration` notification." + }, + { + "name": "didChangeWatchedFiles", + "type": { + "kind": "reference", + "name": "DidChangeWatchedFilesClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `workspace/didChangeWatchedFiles` notification." + }, + { + "name": "symbol", + "type": { + "kind": "reference", + "name": "WorkspaceSymbolClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `workspace/symbol` request." + }, + { + "name": "executeCommand", + "type": { + "kind": "reference", + "name": "ExecuteCommandClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `workspace/executeCommand` request." + }, + { + "name": "workspaceFolders", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client has support for workspace folders.\n\n@since 3.6.0", + "since": "3.6.0" + }, + { + "name": "configuration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports `workspace/configuration` requests.\n\n@since 3.6.0", + "since": "3.6.0" + }, + { + "name": "semanticTokens", + "type": { + "kind": "reference", + "name": "SemanticTokensWorkspaceClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the semantic token requests scoped to the\nworkspace.\n\n@since 3.16.0.", + "since": "3.16.0." + }, + { + "name": "codeLens", + "type": { + "kind": "reference", + "name": "CodeLensWorkspaceClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the code lens requests scoped to the\nworkspace.\n\n@since 3.16.0.", + "since": "3.16.0." + }, + { + "name": "fileOperations", + "type": { + "kind": "reference", + "name": "FileOperationClientCapabilities" + }, + "optional": true, + "documentation": "The client has support for file notifications/requests for user operations on files.\n\nSince 3.16.0" + }, + { + "name": "inlineValue", + "type": { + "kind": "reference", + "name": "InlineValueWorkspaceClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the inline values requests scoped to the\nworkspace.\n\n@since 3.17.0.", + "since": "3.17.0." + }, + { + "name": "inlayHint", + "type": { + "kind": "reference", + "name": "InlayHintWorkspaceClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the inlay hint requests scoped to the\nworkspace.\n\n@since 3.17.0.", + "since": "3.17.0." + }, + { + "name": "diagnostics", + "type": { + "kind": "reference", + "name": "DiagnosticWorkspaceClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the diagnostic requests scoped to the\nworkspace.\n\n@since 3.17.0.", + "since": "3.17.0." + } + ], + "documentation": "Workspace specific client capabilities." + }, + { + "name": "TextDocumentClientCapabilities", + "properties": [ + { + "name": "synchronization", + "type": { + "kind": "reference", + "name": "TextDocumentSyncClientCapabilities" + }, + "optional": true, + "documentation": "Defines which synchronization capabilities the client supports." + }, + { + "name": "completion", + "type": { + "kind": "reference", + "name": "CompletionClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/completion` request." + }, + { + "name": "hover", + "type": { + "kind": "reference", + "name": "HoverClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/hover` request." + }, + { + "name": "signatureHelp", + "type": { + "kind": "reference", + "name": "SignatureHelpClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/signatureHelp` request." + }, + { + "name": "declaration", + "type": { + "kind": "reference", + "name": "DeclarationClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/declaration` request.\n\n@since 3.14.0", + "since": "3.14.0" + }, + { + "name": "definition", + "type": { + "kind": "reference", + "name": "DefinitionClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/definition` request." + }, + { + "name": "typeDefinition", + "type": { + "kind": "reference", + "name": "TypeDefinitionClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/typeDefinition` request.\n\n@since 3.6.0", + "since": "3.6.0" + }, + { + "name": "implementation", + "type": { + "kind": "reference", + "name": "ImplementationClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/implementation` request.\n\n@since 3.6.0", + "since": "3.6.0" + }, + { + "name": "references", + "type": { + "kind": "reference", + "name": "ReferenceClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/references` request." + }, + { + "name": "documentHighlight", + "type": { + "kind": "reference", + "name": "DocumentHighlightClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/documentHighlight` request." + }, + { + "name": "documentSymbol", + "type": { + "kind": "reference", + "name": "DocumentSymbolClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/documentSymbol` request." + }, + { + "name": "codeAction", + "type": { + "kind": "reference", + "name": "CodeActionClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/codeAction` request." + }, + { + "name": "codeLens", + "type": { + "kind": "reference", + "name": "CodeLensClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/codeLens` request." + }, + { + "name": "documentLink", + "type": { + "kind": "reference", + "name": "DocumentLinkClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/documentLink` request." + }, + { + "name": "colorProvider", + "type": { + "kind": "reference", + "name": "DocumentColorClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/documentColor` and the\n`textDocument/colorPresentation` request.\n\n@since 3.6.0", + "since": "3.6.0" + }, + { + "name": "formatting", + "type": { + "kind": "reference", + "name": "DocumentFormattingClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/formatting` request." + }, + { + "name": "rangeFormatting", + "type": { + "kind": "reference", + "name": "DocumentRangeFormattingClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/rangeFormatting` request." + }, + { + "name": "onTypeFormatting", + "type": { + "kind": "reference", + "name": "DocumentOnTypeFormattingClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/onTypeFormatting` request." + }, + { + "name": "rename", + "type": { + "kind": "reference", + "name": "RenameClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/rename` request." + }, + { + "name": "foldingRange", + "type": { + "kind": "reference", + "name": "FoldingRangeClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/foldingRange` request.\n\n@since 3.10.0", + "since": "3.10.0" + }, + { + "name": "selectionRange", + "type": { + "kind": "reference", + "name": "SelectionRangeClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/selectionRange` request.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "publishDiagnostics", + "type": { + "kind": "reference", + "name": "PublishDiagnosticsClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/publishDiagnostics` notification." + }, + { + "name": "callHierarchy", + "type": { + "kind": "reference", + "name": "CallHierarchyClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the various call hierarchy requests.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "semanticTokens", + "type": { + "kind": "reference", + "name": "SemanticTokensClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the various semantic token request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "linkedEditingRange", + "type": { + "kind": "reference", + "name": "LinkedEditingRangeClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/linkedEditingRange` request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "moniker", + "type": { + "kind": "reference", + "name": "MonikerClientCapabilities" + }, + "optional": true, + "documentation": "Client capabilities specific to the `textDocument/moniker` request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "typeHierarchy", + "type": { + "kind": "reference", + "name": "TypeHierarchyClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the various type hierarchy requests.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "inlineValue", + "type": { + "kind": "reference", + "name": "InlineValueClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/inlineValue` request.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "inlayHint", + "type": { + "kind": "reference", + "name": "InlayHintClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the `textDocument/inlayHint` request.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "diagnostic", + "type": { + "kind": "reference", + "name": "DiagnosticClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the diagnostic pull model.\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "documentation": "Text document specific client capabilities." + }, + { + "name": "NotebookDocumentClientCapabilities", + "properties": [ + { + "name": "synchronization", + "type": { + "kind": "reference", + "name": "NotebookDocumentSyncClientCapabilities" + }, + "documentation": "Capabilities specific to notebook document synchronization\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "documentation": "Capabilities specific to the notebook document support.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "WindowClientCapabilities", + "properties": [ + { + "name": "workDoneProgress", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "It indicates whether the client supports server initiated\nprogress using the `window/workDoneProgress/create` request.\n\nThe capability also controls Whether client supports handling\nof progress notifications. If set servers are allowed to report a\n`workDoneProgress` property in the request specific server\ncapabilities.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "showMessage", + "type": { + "kind": "reference", + "name": "ShowMessageRequestClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the showMessage request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "showDocument", + "type": { + "kind": "reference", + "name": "ShowDocumentClientCapabilities" + }, + "optional": true, + "documentation": "Capabilities specific to the showDocument request.\n\n@since 3.16.0", + "since": "3.16.0" + } + ] + }, + { + "name": "GeneralClientCapabilities", + "properties": [ + { + "name": "staleRequestSupport", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "cancel", + "type": { + "kind": "base", + "name": "boolean" + }, + "documentation": "The client will actively cancel the request." + }, + { + "name": "retryOnContentModified", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "documentation": "The list of requests for which the client\nwill retry the request if it receives a\nresponse with error code `ContentModified`" + } + ] + } + }, + "optional": true, + "documentation": "Client capability that signals how the client\nhandles stale requests (e.g. a request\nfor which the client will not process the response\nanymore since the information is outdated).\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "regularExpressions", + "type": { + "kind": "reference", + "name": "RegularExpressionsClientCapabilities" + }, + "optional": true, + "documentation": "Client capabilities specific to regular expressions.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "markdown", + "type": { + "kind": "reference", + "name": "MarkdownClientCapabilities" + }, + "optional": true, + "documentation": "Client capabilities specific to the client's markdown parser.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "positionEncodings", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "PositionEncodingKind" + } + }, + "optional": true, + "documentation": "The position encodings supported by the client. Client and server\nhave to agree on the same position encoding to ensure that offsets\n(e.g. character position in a line) are interpreted the same on both\nsides.\n\nTo keep the protocol backwards compatible the following applies: if\nthe value 'utf-16' is missing from the array of position encodings\nservers can assume that the client supports UTF-16. UTF-16 is\ntherefore a mandatory encoding.\n\nIf omitted it defaults to ['utf-16'].\n\nImplementation considerations: since the conversion from one encoding\ninto another requires the content of the file / line the conversion\nis best done where the file is read which is usually on the server\nside.\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "documentation": "General client capabilities.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "RelativePattern", + "properties": [ + { + "name": "baseUri", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "WorkspaceFolder" + }, + { + "kind": "base", + "name": "URI" + } + ] + }, + "documentation": "A workspace folder or a base URI to which this pattern will be matched\nagainst relatively." + }, + { + "name": "pattern", + "type": { + "kind": "reference", + "name": "Pattern" + }, + "documentation": "The actual glob pattern;" + } + ], + "documentation": "A relative pattern is a helper to construct glob patterns that are matched\nrelatively to a base URI. The common value for a `baseUri` is a workspace\nfolder root, but it can be another absolute URI as well.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "WorkspaceEditClientCapabilities", + "properties": [ + { + "name": "documentChanges", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports versioned document changes in `WorkspaceEdit`s" + }, + { + "name": "resourceOperations", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "ResourceOperationKind" + } + }, + "optional": true, + "documentation": "The resource operations the client supports. Clients should at least\nsupport 'create', 'rename' and 'delete' files and folders.\n\n@since 3.13.0", + "since": "3.13.0" + }, + { + "name": "failureHandling", + "type": { + "kind": "reference", + "name": "FailureHandlingKind" + }, + "optional": true, + "documentation": "The failure handling strategy of a client if applying the workspace edit\nfails.\n\n@since 3.13.0", + "since": "3.13.0" + }, + { + "name": "normalizesLineEndings", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client normalizes line endings to the client specific\nsetting.\nIf set to `true` the client will normalize line ending characters\nin a workspace edit to the client-specified new line\ncharacter.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "changeAnnotationSupport", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "groupsOnLabel", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client groups edits with equal labels into tree nodes,\nfor instance all edits labelled with \"Changes in Strings\" would\nbe a tree node." + } + ] + } + }, + "optional": true, + "documentation": "Whether the client in general supports change annotations on text edits,\ncreate file, rename file and delete file changes.\n\n@since 3.16.0", + "since": "3.16.0" + } + ] + }, + { + "name": "DidChangeConfigurationClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Did change configuration notification supports dynamic registration." + } + ] + }, + { + "name": "DidChangeWatchedFilesClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Did change watched files notification supports dynamic registration. Please note\nthat the current protocol doesn't support static configuration for file changes\nfrom the server side." + }, + { + "name": "relativePatternSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client has support for {@link RelativePattern relative pattern}\nor not.\n\n@since 3.17.0", + "since": "3.17.0" + } + ] + }, + { + "name": "WorkspaceSymbolClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Symbol request supports dynamic registration." + }, + { + "name": "symbolKind", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "valueSet", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "SymbolKind" + } + }, + "optional": true, + "documentation": "The symbol kind values the client supports. When this\nproperty exists the client also guarantees that it will\nhandle values outside its set gracefully and falls back\nto a default value when unknown.\n\nIf this property is not present the client only supports\nthe symbol kinds from `File` to `Array` as defined in\nthe initial version of the protocol." + } + ] + } + }, + "optional": true, + "documentation": "Specific capabilities for the `SymbolKind` in the `workspace/symbol` request." + }, + { + "name": "tagSupport", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "valueSet", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "SymbolTag" + } + }, + "documentation": "The tags supported by the client." + } + ] + } + }, + "optional": true, + "documentation": "The client supports tags on `SymbolInformation`.\nClients supporting tags have to handle unknown tags gracefully.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "resolveSupport", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "properties", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "documentation": "The properties that a client can resolve lazily. Usually\n`location.range`" + } + ] + } + }, + "optional": true, + "documentation": "The client support partial workspace symbols. The client will send the\nrequest `workspaceSymbol/resolve` to the server to resolve additional\nproperties.\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "documentation": "Client capabilities for a {@link WorkspaceSymbolRequest}." + }, + { + "name": "ExecuteCommandClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Execute command supports dynamic registration." + } + ], + "documentation": "The client capabilities of a {@link ExecuteCommandRequest}." + }, + { + "name": "SemanticTokensWorkspaceClientCapabilities", + "properties": [ + { + "name": "refreshSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client implementation supports a refresh request sent from\nthe server to the client.\n\nNote that this event is global and will force the client to refresh all\nsemantic tokens currently shown. It should be used with absolute care\nand is useful for situation where a server for example detects a project\nwide change that requires such a calculation." + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "CodeLensWorkspaceClientCapabilities", + "properties": [ + { + "name": "refreshSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client implementation supports a refresh request sent from the\nserver to the client.\n\nNote that this event is global and will force the client to refresh all\ncode lenses currently shown. It should be used with absolute care and is\nuseful for situation where a server for example detect a project wide\nchange that requires such a calculation." + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "FileOperationClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client supports dynamic registration for file requests/notifications." + }, + { + "name": "didCreate", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client has support for sending didCreateFiles notifications." + }, + { + "name": "willCreate", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client has support for sending willCreateFiles requests." + }, + { + "name": "didRename", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client has support for sending didRenameFiles notifications." + }, + { + "name": "willRename", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client has support for sending willRenameFiles requests." + }, + { + "name": "didDelete", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client has support for sending didDeleteFiles notifications." + }, + { + "name": "willDelete", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client has support for sending willDeleteFiles requests." + } + ], + "documentation": "Capabilities relating to events from file operations by the user in the client.\n\nThese events do not come from the file system, they come from user operations\nlike renaming a file in the UI.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "InlineValueWorkspaceClientCapabilities", + "properties": [ + { + "name": "refreshSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client implementation supports a refresh request sent from the\nserver to the client.\n\nNote that this event is global and will force the client to refresh all\ninline values currently shown. It should be used with absolute care and is\nuseful for situation where a server for example detects a project wide\nchange that requires such a calculation." + } + ], + "documentation": "Client workspace capabilities specific to inline values.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlayHintWorkspaceClientCapabilities", + "properties": [ + { + "name": "refreshSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client implementation supports a refresh request sent from\nthe server to the client.\n\nNote that this event is global and will force the client to refresh all\ninlay hints currently shown. It should be used with absolute care and\nis useful for situation where a server for example detects a project wide\nchange that requires such a calculation." + } + ], + "documentation": "Client workspace capabilities specific to inlay hints.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "DiagnosticWorkspaceClientCapabilities", + "properties": [ + { + "name": "refreshSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client implementation supports a refresh request sent from\nthe server to the client.\n\nNote that this event is global and will force the client to refresh all\npulled diagnostics currently shown. It should be used with absolute care and\nis useful for situation where a server for example detects a project wide\nchange that requires such a calculation." + } + ], + "documentation": "Workspace client capabilities specific to diagnostic pull requests.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "TextDocumentSyncClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether text document synchronization supports dynamic registration." + }, + { + "name": "willSave", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports sending will save notifications." + }, + { + "name": "willSaveWaitUntil", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports sending a will save request and\nwaits for a response providing text edits which will\nbe applied to the document before it is saved." + }, + { + "name": "didSave", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports did save notifications." + } + ] + }, + { + "name": "CompletionClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether completion supports dynamic registration." + }, + { + "name": "completionItem", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "snippetSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Client supports snippets as insert text.\n\nA snippet can define tab stops and placeholders with `$1`, `$2`\nand `${3:foo}`. `$0` defines the final tab stop, it defaults to\nthe end of the snippet. Placeholders with equal identifiers are linked,\nthat is typing in one will update others too." + }, + { + "name": "commitCharactersSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Client supports commit characters on a completion item." + }, + { + "name": "documentationFormat", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "MarkupKind" + } + }, + "optional": true, + "documentation": "Client supports the following content formats for the documentation\nproperty. The order describes the preferred format of the client." + }, + { + "name": "deprecatedSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Client supports the deprecated property on a completion item." + }, + { + "name": "preselectSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Client supports the preselect property on a completion item." + }, + { + "name": "tagSupport", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "valueSet", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "CompletionItemTag" + } + }, + "documentation": "The tags supported by the client." + } + ] + } + }, + "optional": true, + "documentation": "Client supports the tag property on a completion item. Clients supporting\ntags have to handle unknown tags gracefully. Clients especially need to\npreserve unknown tags when sending a completion item back to the server in\na resolve call.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "insertReplaceSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Client support insert replace edit to control different behavior if a\ncompletion item is inserted in the text or should replace text.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "resolveSupport", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "properties", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "documentation": "The properties that a client can resolve lazily." + } + ] + } + }, + "optional": true, + "documentation": "Indicates which properties a client can resolve lazily on a completion\nitem. Before version 3.16.0 only the predefined properties `documentation`\nand `details` could be resolved lazily.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "insertTextModeSupport", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "valueSet", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "InsertTextMode" + } + } + } + ] + } + }, + "optional": true, + "documentation": "The client supports the `insertTextMode` property on\na completion item to override the whitespace handling mode\nas defined by the client (see `insertTextMode`).\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "labelDetailsSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client has support for completion item label\ndetails (see also `CompletionItemLabelDetails`).\n\n@since 3.17.0", + "since": "3.17.0" + } + ] + } + }, + "optional": true, + "documentation": "The client supports the following `CompletionItem` specific\ncapabilities." + }, + { + "name": "completionItemKind", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "valueSet", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "CompletionItemKind" + } + }, + "optional": true, + "documentation": "The completion item kind values the client supports. When this\nproperty exists the client also guarantees that it will\nhandle values outside its set gracefully and falls back\nto a default value when unknown.\n\nIf this property is not present the client only supports\nthe completion items kinds from `Text` to `Reference` as defined in\nthe initial version of the protocol." + } + ] + } + }, + "optional": true + }, + { + "name": "insertTextMode", + "type": { + "kind": "reference", + "name": "InsertTextMode" + }, + "optional": true, + "documentation": "Defines how the client handles whitespace and indentation\nwhen accepting a completion item that uses multi line\ntext in either `insertText` or `textEdit`.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "contextSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports to send additional context information for a\n`textDocument/completion` request." + }, + { + "name": "completionList", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "itemDefaults", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "optional": true, + "documentation": "The client supports the following itemDefaults on\na completion list.\n\nThe value lists the supported property names of the\n`CompletionList.itemDefaults` object. If omitted\nno properties are supported.\n\n@since 3.17.0", + "since": "3.17.0" + } + ] + } + }, + "optional": true, + "documentation": "The client supports the following `CompletionList` specific\ncapabilities.\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "documentation": "Completion client capabilities" + }, + { + "name": "HoverClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether hover supports dynamic registration." + }, + { + "name": "contentFormat", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "MarkupKind" + } + }, + "optional": true, + "documentation": "Client supports the following content formats for the content\nproperty. The order describes the preferred format of the client." + } + ] + }, + { + "name": "SignatureHelpClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether signature help supports dynamic registration." + }, + { + "name": "signatureInformation", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "documentationFormat", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "MarkupKind" + } + }, + "optional": true, + "documentation": "Client supports the following content formats for the documentation\nproperty. The order describes the preferred format of the client." + }, + { + "name": "parameterInformation", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "labelOffsetSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports processing label offsets instead of a\nsimple label string.\n\n@since 3.14.0", + "since": "3.14.0" + } + ] + } + }, + "optional": true, + "documentation": "Client capabilities specific to parameter information." + }, + { + "name": "activeParameterSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports the `activeParameter` property on `SignatureInformation`\nliteral.\n\n@since 3.16.0", + "since": "3.16.0" + } + ] + } + }, + "optional": true, + "documentation": "The client supports the following `SignatureInformation`\nspecific properties." + }, + { + "name": "contextSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports to send additional context information for a\n`textDocument/signatureHelp` request. A client that opts into\ncontextSupport will also support the `retriggerCharacters` on\n`SignatureHelpOptions`.\n\n@since 3.15.0", + "since": "3.15.0" + } + ], + "documentation": "Client Capabilities for a {@link SignatureHelpRequest}." + }, + { + "name": "DeclarationClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether declaration supports dynamic registration. If this is set to `true`\nthe client supports the new `DeclarationRegistrationOptions` return value\nfor the corresponding server capability as well." + }, + { + "name": "linkSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports additional metadata in the form of declaration links." + } + ], + "documentation": "@since 3.14.0", + "since": "3.14.0" + }, + { + "name": "DefinitionClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether definition supports dynamic registration." + }, + { + "name": "linkSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports additional metadata in the form of definition links.\n\n@since 3.14.0", + "since": "3.14.0" + } + ], + "documentation": "Client Capabilities for a {@link DefinitionRequest}." + }, + { + "name": "TypeDefinitionClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether implementation supports dynamic registration. If this is set to `true`\nthe client supports the new `TypeDefinitionRegistrationOptions` return value\nfor the corresponding server capability as well." + }, + { + "name": "linkSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports additional metadata in the form of definition links.\n\nSince 3.14.0" + } + ], + "documentation": "Since 3.6.0" + }, + { + "name": "ImplementationClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether implementation supports dynamic registration. If this is set to `true`\nthe client supports the new `ImplementationRegistrationOptions` return value\nfor the corresponding server capability as well." + }, + { + "name": "linkSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports additional metadata in the form of definition links.\n\n@since 3.14.0", + "since": "3.14.0" + } + ], + "documentation": "@since 3.6.0", + "since": "3.6.0" + }, + { + "name": "ReferenceClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether references supports dynamic registration." + } + ], + "documentation": "Client Capabilities for a {@link ReferencesRequest}." + }, + { + "name": "DocumentHighlightClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether document highlight supports dynamic registration." + } + ], + "documentation": "Client Capabilities for a {@link DocumentHighlightRequest}." + }, + { + "name": "DocumentSymbolClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether document symbol supports dynamic registration." + }, + { + "name": "symbolKind", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "valueSet", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "SymbolKind" + } + }, + "optional": true, + "documentation": "The symbol kind values the client supports. When this\nproperty exists the client also guarantees that it will\nhandle values outside its set gracefully and falls back\nto a default value when unknown.\n\nIf this property is not present the client only supports\nthe symbol kinds from `File` to `Array` as defined in\nthe initial version of the protocol." + } + ] + } + }, + "optional": true, + "documentation": "Specific capabilities for the `SymbolKind` in the\n`textDocument/documentSymbol` request." + }, + { + "name": "hierarchicalDocumentSymbolSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports hierarchical document symbols." + }, + { + "name": "tagSupport", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "valueSet", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "SymbolTag" + } + }, + "documentation": "The tags supported by the client." + } + ] + } + }, + "optional": true, + "documentation": "The client supports tags on `SymbolInformation`. Tags are supported on\n`DocumentSymbol` if `hierarchicalDocumentSymbolSupport` is set to true.\nClients supporting tags have to handle unknown tags gracefully.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "labelSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports an additional label presented in the UI when\nregistering a document symbol provider.\n\n@since 3.16.0", + "since": "3.16.0" + } + ], + "documentation": "Client Capabilities for a {@link DocumentSymbolRequest}." + }, + { + "name": "CodeActionClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether code action supports dynamic registration." + }, + { + "name": "codeActionLiteralSupport", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "codeActionKind", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "valueSet", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "CodeActionKind" + } + }, + "documentation": "The code action kind values the client supports. When this\nproperty exists the client also guarantees that it will\nhandle values outside its set gracefully and falls back\nto a default value when unknown." + } + ] + } + }, + "documentation": "The code action kind is support with the following value\nset." + } + ] + } + }, + "optional": true, + "documentation": "The client support code action literals of type `CodeAction` as a valid\nresponse of the `textDocument/codeAction` request. If the property is not\nset the request can only return `Command` literals.\n\n@since 3.8.0", + "since": "3.8.0" + }, + { + "name": "isPreferredSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether code action supports the `isPreferred` property.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "disabledSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether code action supports the `disabled` property.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "dataSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether code action supports the `data` property which is\npreserved between a `textDocument/codeAction` and a\n`codeAction/resolve` request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "resolveSupport", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "properties", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "documentation": "The properties that a client can resolve lazily." + } + ] + } + }, + "optional": true, + "documentation": "Whether the client supports resolving additional code action\nproperties via a separate `codeAction/resolve` request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "honorsChangeAnnotations", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client honors the change annotations in\ntext edits and resource operations returned via the\n`CodeAction#edit` property by for example presenting\nthe workspace edit in the user interface and asking\nfor confirmation.\n\n@since 3.16.0", + "since": "3.16.0" + } + ], + "documentation": "The Client Capabilities of a {@link CodeActionRequest}." + }, + { + "name": "CodeLensClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether code lens supports dynamic registration." + } + ], + "documentation": "The client capabilities of a {@link CodeLensRequest}." + }, + { + "name": "DocumentLinkClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether document link supports dynamic registration." + }, + { + "name": "tooltipSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client supports the `tooltip` property on `DocumentLink`.\n\n@since 3.15.0", + "since": "3.15.0" + } + ], + "documentation": "The client capabilities of a {@link DocumentLinkRequest}." + }, + { + "name": "DocumentColorClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether implementation supports dynamic registration. If this is set to `true`\nthe client supports the new `DocumentColorRegistrationOptions` return value\nfor the corresponding server capability as well." + } + ] + }, + { + "name": "DocumentFormattingClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether formatting supports dynamic registration." + } + ], + "documentation": "Client capabilities of a {@link DocumentFormattingRequest}." + }, + { + "name": "DocumentRangeFormattingClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether range formatting supports dynamic registration." + } + ], + "documentation": "Client capabilities of a {@link DocumentRangeFormattingRequest}." + }, + { + "name": "DocumentOnTypeFormattingClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether on type formatting supports dynamic registration." + } + ], + "documentation": "Client capabilities of a {@link DocumentOnTypeFormattingRequest}." + }, + { + "name": "RenameClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether rename supports dynamic registration." + }, + { + "name": "prepareSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Client supports testing for validity of rename operations\nbefore execution.\n\n@since 3.12.0", + "since": "3.12.0" + }, + { + "name": "prepareSupportDefaultBehavior", + "type": { + "kind": "reference", + "name": "PrepareSupportDefaultBehavior" + }, + "optional": true, + "documentation": "Client supports the default behavior result.\n\nThe value indicates the default behavior used by the\nclient.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "honorsChangeAnnotations", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client honors the change annotations in\ntext edits and resource operations returned via the\nrename request's workspace edit by for example presenting\nthe workspace edit in the user interface and asking\nfor confirmation.\n\n@since 3.16.0", + "since": "3.16.0" + } + ] + }, + { + "name": "FoldingRangeClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether implementation supports dynamic registration for folding range\nproviders. If this is set to `true` the client supports the new\n`FoldingRangeRegistrationOptions` return value for the corresponding\nserver capability as well." + }, + { + "name": "rangeLimit", + "type": { + "kind": "base", + "name": "uinteger" + }, + "optional": true, + "documentation": "The maximum number of folding ranges that the client prefers to receive\nper document. The value serves as a hint, servers are free to follow the\nlimit." + }, + { + "name": "lineFoldingOnly", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "If set, the client signals that it only supports folding complete lines.\nIf set, client will ignore specified `startCharacter` and `endCharacter`\nproperties in a FoldingRange." + }, + { + "name": "foldingRangeKind", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "valueSet", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "FoldingRangeKind" + } + }, + "optional": true, + "documentation": "The folding range kind values the client supports. When this\nproperty exists the client also guarantees that it will\nhandle values outside its set gracefully and falls back\nto a default value when unknown." + } + ] + } + }, + "optional": true, + "documentation": "Specific options for the folding range kind.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "foldingRange", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "collapsedText", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "If set, the client signals that it supports setting collapsedText on\nfolding ranges to display custom labels instead of the default text.\n\n@since 3.17.0", + "since": "3.17.0" + } + ] + } + }, + "optional": true, + "documentation": "Specific options for the folding range.\n\n@since 3.17.0", + "since": "3.17.0" + } + ] + }, + { + "name": "SelectionRangeClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether implementation supports dynamic registration for selection range providers. If this is set to `true`\nthe client supports the new `SelectionRangeRegistrationOptions` return value for the corresponding server\ncapability as well." + } + ] + }, + { + "name": "PublishDiagnosticsClientCapabilities", + "properties": [ + { + "name": "relatedInformation", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the clients accepts diagnostics with related information." + }, + { + "name": "tagSupport", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "valueSet", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "DiagnosticTag" + } + }, + "documentation": "The tags supported by the client." + } + ] + } + }, + "optional": true, + "documentation": "Client supports the tag property to provide meta data about a diagnostic.\nClients supporting tags have to handle unknown tags gracefully.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "versionSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client interprets the version property of the\n`textDocument/publishDiagnostics` notification's parameter.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "codeDescriptionSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Client supports a codeDescription property\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "dataSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether code action supports the `data` property which is\npreserved between a `textDocument/publishDiagnostics` and\n`textDocument/codeAction` request.\n\n@since 3.16.0", + "since": "3.16.0" + } + ], + "documentation": "The publish diagnostic client capabilities." + }, + { + "name": "CallHierarchyClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether implementation supports dynamic registration. If this is set to `true`\nthe client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)`\nreturn value for the corresponding server capability as well." + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "SemanticTokensClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether implementation supports dynamic registration. If this is set to `true`\nthe client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)`\nreturn value for the corresponding server capability as well." + }, + { + "name": "requests", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "range", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "literal", + "value": { + "properties": [] + } + } + ] + }, + "optional": true, + "documentation": "The client will send the `textDocument/semanticTokens/range` request if\nthe server provides a corresponding handler." + }, + { + "name": "full", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "delta", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client will send the `textDocument/semanticTokens/full/delta` request if\nthe server provides a corresponding handler." + } + ] + } + } + ] + }, + "optional": true, + "documentation": "The client will send the `textDocument/semanticTokens/full` request if\nthe server provides a corresponding handler." + } + ] + } + }, + "documentation": "Which requests the client supports and might send to the server\ndepending on the server's capability. Please note that clients might not\nshow semantic tokens or degrade some of the user experience if a range\nor full request is advertised by the client but not provided by the\nserver. If for example the client capability `requests.full` and\n`request.range` are both set to true but the server only provides a\nrange provider the client might not render a minimap correctly or might\neven decide to not show any semantic tokens at all." + }, + { + "name": "tokenTypes", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "documentation": "The token types that the client supports." + }, + { + "name": "tokenModifiers", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "documentation": "The token modifiers that the client supports." + }, + { + "name": "formats", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "TokenFormat" + } + }, + "documentation": "The token formats the clients supports." + }, + { + "name": "overlappingTokenSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client supports tokens that can overlap each other." + }, + { + "name": "multilineTokenSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client supports tokens that can span multiple lines." + }, + { + "name": "serverCancelSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client allows the server to actively cancel a\nsemantic token request, e.g. supports returning\nLSPErrorCodes.ServerCancelled. If a server does the client\nneeds to retrigger the request.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "augmentsSyntaxTokens", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client uses semantic tokens to augment existing\nsyntax tokens. If set to `true` client side created syntax\ntokens and semantic tokens are both used for colorization. If\nset to `false` the client only uses the returned semantic tokens\nfor colorization.\n\nIf the value is `undefined` then the client behavior is not\nspecified.\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "documentation": "@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "LinkedEditingRangeClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether implementation supports dynamic registration. If this is set to `true`\nthe client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)`\nreturn value for the corresponding server capability as well." + } + ], + "documentation": "Client capabilities for the linked editing range request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "MonikerClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether moniker supports dynamic registration. If this is set to `true`\nthe client supports the new `MonikerRegistrationOptions` return value\nfor the corresponding server capability as well." + } + ], + "documentation": "Client capabilities specific to the moniker request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "TypeHierarchyClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether implementation supports dynamic registration. If this is set to `true`\nthe client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)`\nreturn value for the corresponding server capability as well." + } + ], + "documentation": "@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlineValueClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether implementation supports dynamic registration for inline value providers." + } + ], + "documentation": "Client capabilities specific to inline values.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "InlayHintClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether inlay hints support dynamic registration." + }, + { + "name": "resolveSupport", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "properties", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "documentation": "The properties that a client can resolve lazily." + } + ] + } + }, + "optional": true, + "documentation": "Indicates which properties a client can resolve lazily on an inlay\nhint." + } + ], + "documentation": "Inlay hint client capabilities.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "DiagnosticClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether implementation supports dynamic registration. If this is set to `true`\nthe client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)`\nreturn value for the corresponding server capability as well." + }, + { + "name": "relatedDocumentSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the clients supports related documents for document diagnostic pulls." + } + ], + "documentation": "Client capabilities specific to diagnostic pull requests.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "NotebookDocumentSyncClientCapabilities", + "properties": [ + { + "name": "dynamicRegistration", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether implementation supports dynamic registration. If this is\nset to `true` the client supports the new\n`(TextDocumentRegistrationOptions & StaticRegistrationOptions)`\nreturn value for the corresponding server capability as well." + }, + { + "name": "executionSummarySupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "The client supports sending execution summary data per cell." + } + ], + "documentation": "Notebook specific client capabilities.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "ShowMessageRequestClientCapabilities", + "properties": [ + { + "name": "messageActionItem", + "type": { + "kind": "literal", + "value": { + "properties": [ + { + "name": "additionalPropertiesSupport", + "type": { + "kind": "base", + "name": "boolean" + }, + "optional": true, + "documentation": "Whether the client supports additional attributes which\nare preserved and send back to the server in the\nrequest's response." + } + ] + } + }, + "optional": true, + "documentation": "Capabilities specific to the `MessageActionItem` type." + } + ], + "documentation": "Show message request client capabilities" + }, + { + "name": "ShowDocumentClientCapabilities", + "properties": [ + { + "name": "support", + "type": { + "kind": "base", + "name": "boolean" + }, + "documentation": "The client has support for the showDocument\nrequest." + } + ], + "documentation": "Client capabilities for the showDocument request.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "RegularExpressionsClientCapabilities", + "properties": [ + { + "name": "engine", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The engine's name." + }, + { + "name": "version", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The engine's version." + } + ], + "documentation": "Client capabilities specific to regular expressions.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "MarkdownClientCapabilities", + "properties": [ + { + "name": "parser", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The name of the parser." + }, + { + "name": "version", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The version of the parser." + }, + { + "name": "allowedTags", + "type": { + "kind": "array", + "element": { + "kind": "base", + "name": "string" + } + }, + "optional": true, + "documentation": "A list of HTML tags that the client allows / supports in\nMarkdown.\n\n@since 3.17.0", + "since": "3.17.0" + } + ], + "documentation": "Client capabilities specific to the used markdown parser.\n\n@since 3.16.0", + "since": "3.16.0" + } + ], + "enumerations": [ + { + "name": "SemanticTokenTypes", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "namespace", + "value": "namespace" + }, + { + "name": "type", + "value": "type", + "documentation": "Represents a generic type. Acts as a fallback for types which can't be mapped to\na specific type like class or enum." + }, + { + "name": "class", + "value": "class" + }, + { + "name": "enum", + "value": "enum" + }, + { + "name": "interface", + "value": "interface" + }, + { + "name": "struct", + "value": "struct" + }, + { + "name": "typeParameter", + "value": "typeParameter" + }, + { + "name": "parameter", + "value": "parameter" + }, + { + "name": "variable", + "value": "variable" + }, + { + "name": "property", + "value": "property" + }, + { + "name": "enumMember", + "value": "enumMember" + }, + { + "name": "event", + "value": "event" + }, + { + "name": "function", + "value": "function" + }, + { + "name": "method", + "value": "method" + }, + { + "name": "macro", + "value": "macro" + }, + { + "name": "keyword", + "value": "keyword" + }, + { + "name": "modifier", + "value": "modifier" + }, + { + "name": "comment", + "value": "comment" + }, + { + "name": "string", + "value": "string" + }, + { + "name": "number", + "value": "number" + }, + { + "name": "regexp", + "value": "regexp" + }, + { + "name": "operator", + "value": "operator" + }, + { + "name": "decorator", + "value": "decorator", + "documentation": "@since 3.17.0", + "since": "3.17.0" + } + ], + "supportsCustomValues": true, + "documentation": "A set of predefined token types. This set is not fixed\nan clients can specify additional token types via the\ncorresponding client capabilities.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "SemanticTokenModifiers", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "declaration", + "value": "declaration" + }, + { + "name": "definition", + "value": "definition" + }, + { + "name": "readonly", + "value": "readonly" + }, + { + "name": "static", + "value": "static" + }, + { + "name": "deprecated", + "value": "deprecated" + }, + { + "name": "abstract", + "value": "abstract" + }, + { + "name": "async", + "value": "async" + }, + { + "name": "modification", + "value": "modification" + }, + { + "name": "documentation", + "value": "documentation" + }, + { + "name": "defaultLibrary", + "value": "defaultLibrary" + } + ], + "supportsCustomValues": true, + "documentation": "A set of predefined token modifiers. This set is not fixed\nan clients can specify additional token types via the\ncorresponding client capabilities.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "DocumentDiagnosticReportKind", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "Full", + "value": "full", + "documentation": "A diagnostic report with a full\nset of problems." + }, + { + "name": "Unchanged", + "value": "unchanged", + "documentation": "A report indicating that the last\nreturned report is still accurate." + } + ], + "documentation": "The document diagnostic report kinds.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "ErrorCodes", + "type": { + "kind": "base", + "name": "integer" + }, + "values": [ + { + "name": "ParseError", + "value": -32700 + }, + { + "name": "InvalidRequest", + "value": -32600 + }, + { + "name": "MethodNotFound", + "value": -32601 + }, + { + "name": "InvalidParams", + "value": -32602 + }, + { + "name": "InternalError", + "value": -32603 + }, + { + "name": "ServerNotInitialized", + "value": -32002, + "documentation": "Error code indicating that a server received a notification or\nrequest before the server has received the `initialize` request." + }, + { + "name": "UnknownErrorCode", + "value": -32001 + } + ], + "supportsCustomValues": true, + "documentation": "Predefined error codes." + }, + { + "name": "LSPErrorCodes", + "type": { + "kind": "base", + "name": "integer" + }, + "values": [ + { + "name": "RequestFailed", + "value": -32803, + "documentation": "A request failed but it was syntactically correct, e.g the\nmethod name was known and the parameters were valid. The error\nmessage should contain human readable information about why\nthe request failed.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "ServerCancelled", + "value": -32802, + "documentation": "The server cancelled the request. This error code should\nonly be used for requests that explicitly support being\nserver cancellable.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "ContentModified", + "value": -32801, + "documentation": "The server detected that the content of a document got\nmodified outside normal conditions. A server should\nNOT send this error code if it detects a content change\nin it unprocessed messages. The result even computed\non an older state might still be useful for the client.\n\nIf a client decides that a result is not of any use anymore\nthe client should cancel the request." + }, + { + "name": "RequestCancelled", + "value": -32800, + "documentation": "The client has canceled a request and a server as detected\nthe cancel." + } + ], + "supportsCustomValues": true + }, + { + "name": "FoldingRangeKind", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "Comment", + "value": "comment", + "documentation": "Folding range for a comment" + }, + { + "name": "Imports", + "value": "imports", + "documentation": "Folding range for an import or include" + }, + { + "name": "Region", + "value": "region", + "documentation": "Folding range for a region (e.g. `#region`)" + } + ], + "supportsCustomValues": true, + "documentation": "A set of predefined range kinds." + }, + { + "name": "SymbolKind", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "File", + "value": 1 + }, + { + "name": "Module", + "value": 2 + }, + { + "name": "Namespace", + "value": 3 + }, + { + "name": "Package", + "value": 4 + }, + { + "name": "Class", + "value": 5 + }, + { + "name": "Method", + "value": 6 + }, + { + "name": "Property", + "value": 7 + }, + { + "name": "Field", + "value": 8 + }, + { + "name": "Constructor", + "value": 9 + }, + { + "name": "Enum", + "value": 10 + }, + { + "name": "Interface", + "value": 11 + }, + { + "name": "Function", + "value": 12 + }, + { + "name": "Variable", + "value": 13 + }, + { + "name": "Constant", + "value": 14 + }, + { + "name": "String", + "value": 15 + }, + { + "name": "Number", + "value": 16 + }, + { + "name": "Boolean", + "value": 17 + }, + { + "name": "Array", + "value": 18 + }, + { + "name": "Object", + "value": 19 + }, + { + "name": "Key", + "value": 20 + }, + { + "name": "Null", + "value": 21 + }, + { + "name": "EnumMember", + "value": 22 + }, + { + "name": "Struct", + "value": 23 + }, + { + "name": "Event", + "value": 24 + }, + { + "name": "Operator", + "value": 25 + }, + { + "name": "TypeParameter", + "value": 26 + } + ], + "documentation": "A symbol kind." + }, + { + "name": "SymbolTag", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Deprecated", + "value": 1, + "documentation": "Render a symbol as obsolete, usually using a strike-out." + } + ], + "documentation": "Symbol tags are extra annotations that tweak the rendering of a symbol.\n\n@since 3.16", + "since": "3.16" + }, + { + "name": "UniquenessLevel", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "document", + "value": "document", + "documentation": "The moniker is only unique inside a document" + }, + { + "name": "project", + "value": "project", + "documentation": "The moniker is unique inside a project for which a dump got created" + }, + { + "name": "group", + "value": "group", + "documentation": "The moniker is unique inside the group to which a project belongs" + }, + { + "name": "scheme", + "value": "scheme", + "documentation": "The moniker is unique inside the moniker scheme." + }, + { + "name": "global", + "value": "global", + "documentation": "The moniker is globally unique" + } + ], + "documentation": "Moniker uniqueness level to define scope of the moniker.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "MonikerKind", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "import", + "value": "import", + "documentation": "The moniker represent a symbol that is imported into a project" + }, + { + "name": "export", + "value": "export", + "documentation": "The moniker represents a symbol that is exported from a project" + }, + { + "name": "local", + "value": "local", + "documentation": "The moniker represents a symbol that is local to a project (e.g. a local\nvariable of a function, a class not visible outside the project, ...)" + } + ], + "documentation": "The moniker kind.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "InlayHintKind", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Type", + "value": 1, + "documentation": "An inlay hint that for a type annotation." + }, + { + "name": "Parameter", + "value": 2, + "documentation": "An inlay hint that is for a parameter." + } + ], + "documentation": "Inlay hint kinds.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "MessageType", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Error", + "value": 1, + "documentation": "An error message." + }, + { + "name": "Warning", + "value": 2, + "documentation": "A warning message." + }, + { + "name": "Info", + "value": 3, + "documentation": "An information message." + }, + { + "name": "Log", + "value": 4, + "documentation": "A log message." + } + ], + "documentation": "The message type" + }, + { + "name": "TextDocumentSyncKind", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "None", + "value": 0, + "documentation": "Documents should not be synced at all." + }, + { + "name": "Full", + "value": 1, + "documentation": "Documents are synced by always sending the full content\nof the document." + }, + { + "name": "Incremental", + "value": 2, + "documentation": "Documents are synced by sending the full content on open.\nAfter that only incremental updates to the document are\nsend." + } + ], + "documentation": "Defines how the host (editor) should sync\ndocument changes to the language server." + }, + { + "name": "TextDocumentSaveReason", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Manual", + "value": 1, + "documentation": "Manually triggered, e.g. by the user pressing save, by starting debugging,\nor by an API call." + }, + { + "name": "AfterDelay", + "value": 2, + "documentation": "Automatic after a delay." + }, + { + "name": "FocusOut", + "value": 3, + "documentation": "When the editor lost focus." + } + ], + "documentation": "Represents reasons why a text document is saved." + }, + { + "name": "CompletionItemKind", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Text", + "value": 1 + }, + { + "name": "Method", + "value": 2 + }, + { + "name": "Function", + "value": 3 + }, + { + "name": "Constructor", + "value": 4 + }, + { + "name": "Field", + "value": 5 + }, + { + "name": "Variable", + "value": 6 + }, + { + "name": "Class", + "value": 7 + }, + { + "name": "Interface", + "value": 8 + }, + { + "name": "Module", + "value": 9 + }, + { + "name": "Property", + "value": 10 + }, + { + "name": "Unit", + "value": 11 + }, + { + "name": "Value", + "value": 12 + }, + { + "name": "Enum", + "value": 13 + }, + { + "name": "Keyword", + "value": 14 + }, + { + "name": "Snippet", + "value": 15 + }, + { + "name": "Color", + "value": 16 + }, + { + "name": "File", + "value": 17 + }, + { + "name": "Reference", + "value": 18 + }, + { + "name": "Folder", + "value": 19 + }, + { + "name": "EnumMember", + "value": 20 + }, + { + "name": "Constant", + "value": 21 + }, + { + "name": "Struct", + "value": 22 + }, + { + "name": "Event", + "value": 23 + }, + { + "name": "Operator", + "value": 24 + }, + { + "name": "TypeParameter", + "value": 25 + } + ], + "documentation": "The kind of a completion entry." + }, + { + "name": "CompletionItemTag", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Deprecated", + "value": 1, + "documentation": "Render a completion as obsolete, usually using a strike-out." + } + ], + "documentation": "Completion item tags are extra annotations that tweak the rendering of a completion\nitem.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "InsertTextFormat", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "PlainText", + "value": 1, + "documentation": "The primary text to be inserted is treated as a plain string." + }, + { + "name": "Snippet", + "value": 2, + "documentation": "The primary text to be inserted is treated as a snippet.\n\nA snippet can define tab stops and placeholders with `$1`, `$2`\nand `${3:foo}`. `$0` defines the final tab stop, it defaults to\nthe end of the snippet. Placeholders with equal identifiers are linked,\nthat is typing in one will update others too.\n\nSee also: https://microsoft.github.io/language-server-protocol/specifications/specification-current/#snippet_syntax" + } + ], + "documentation": "Defines whether the insert text in a completion item should be interpreted as\nplain text or a snippet." + }, + { + "name": "InsertTextMode", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "asIs", + "value": 1, + "documentation": "The insertion or replace strings is taken as it is. If the\nvalue is multi line the lines below the cursor will be\ninserted using the indentation defined in the string value.\nThe client will not apply any kind of adjustments to the\nstring." + }, + { + "name": "adjustIndentation", + "value": 2, + "documentation": "The editor adjusts leading whitespace of new lines so that\nthey match the indentation up to the cursor of the line for\nwhich the item is accepted.\n\nConsider a line like this: <2tabs><3tabs>foo. Accepting a\nmulti line completion item is indented using 2 tabs and all\nfollowing lines inserted will be indented using 2 tabs as well." + } + ], + "documentation": "How whitespace and indentation is handled during completion\nitem insertion.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "DocumentHighlightKind", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Text", + "value": 1, + "documentation": "A textual occurrence." + }, + { + "name": "Read", + "value": 2, + "documentation": "Read-access of a symbol, like reading a variable." + }, + { + "name": "Write", + "value": 3, + "documentation": "Write-access of a symbol, like writing to a variable." + } + ], + "documentation": "A document highlight kind." + }, + { + "name": "CodeActionKind", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "Empty", + "value": "", + "documentation": "Empty kind." + }, + { + "name": "QuickFix", + "value": "quickfix", + "documentation": "Base kind for quickfix actions: 'quickfix'" + }, + { + "name": "Refactor", + "value": "refactor", + "documentation": "Base kind for refactoring actions: 'refactor'" + }, + { + "name": "RefactorExtract", + "value": "refactor.extract", + "documentation": "Base kind for refactoring extraction actions: 'refactor.extract'\n\nExample extract actions:\n\n- Extract method\n- Extract function\n- Extract variable\n- Extract interface from class\n- ..." + }, + { + "name": "RefactorInline", + "value": "refactor.inline", + "documentation": "Base kind for refactoring inline actions: 'refactor.inline'\n\nExample inline actions:\n\n- Inline function\n- Inline variable\n- Inline constant\n- ..." + }, + { + "name": "RefactorRewrite", + "value": "refactor.rewrite", + "documentation": "Base kind for refactoring rewrite actions: 'refactor.rewrite'\n\nExample rewrite actions:\n\n- Convert JavaScript function to class\n- Add or remove parameter\n- Encapsulate field\n- Make method static\n- Move method to base class\n- ..." + }, + { + "name": "Source", + "value": "source", + "documentation": "Base kind for source actions: `source`\n\nSource code actions apply to the entire file." + }, + { + "name": "SourceOrganizeImports", + "value": "source.organizeImports", + "documentation": "Base kind for an organize imports source action: `source.organizeImports`" + }, + { + "name": "SourceFixAll", + "value": "source.fixAll", + "documentation": "Base kind for auto-fix source actions: `source.fixAll`.\n\nFix all actions automatically fix errors that have a clear fix that do not require user input.\nThey should not suppress errors or perform unsafe fixes such as generating new types or classes.\n\n@since 3.15.0", + "since": "3.15.0" + } + ], + "supportsCustomValues": true, + "documentation": "A set of predefined code action kinds" + }, + { + "name": "TraceValues", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "Off", + "value": "off", + "documentation": "Turn tracing off." + }, + { + "name": "Messages", + "value": "messages", + "documentation": "Trace messages only." + }, + { + "name": "Verbose", + "value": "verbose", + "documentation": "Verbose message tracing." + } + ] + }, + { + "name": "MarkupKind", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "PlainText", + "value": "plaintext", + "documentation": "Plain text is supported as a content format" + }, + { + "name": "Markdown", + "value": "markdown", + "documentation": "Markdown is supported as a content format" + } + ], + "documentation": "Describes the content type that a client supports in various\nresult literals like `Hover`, `ParameterInfo` or `CompletionItem`.\n\nPlease note that `MarkupKinds` must not start with a `$`. This kinds\nare reserved for internal usage." + }, + { + "name": "PositionEncodingKind", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "UTF8", + "value": "utf-8", + "documentation": "Character offsets count UTF-8 code units." + }, + { + "name": "UTF16", + "value": "utf-16", + "documentation": "Character offsets count UTF-16 code units.\n\nThis is the default and must always be supported\nby servers" + }, + { + "name": "UTF32", + "value": "utf-32", + "documentation": "Character offsets count UTF-32 code units.\n\nImplementation note: these are the same as Unicode code points,\nso this `PositionEncodingKind` may also be used for an\nencoding-agnostic representation of character offsets." + } + ], + "supportsCustomValues": true, + "documentation": "A set of predefined position encoding kinds.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "FileChangeType", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Created", + "value": 1, + "documentation": "The file got created." + }, + { + "name": "Changed", + "value": 2, + "documentation": "The file got changed." + }, + { + "name": "Deleted", + "value": 3, + "documentation": "The file got deleted." + } + ], + "documentation": "The file event type" + }, + { + "name": "WatchKind", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Create", + "value": 1, + "documentation": "Interested in create events." + }, + { + "name": "Change", + "value": 2, + "documentation": "Interested in change events" + }, + { + "name": "Delete", + "value": 4, + "documentation": "Interested in delete events" + } + ], + "supportsCustomValues": true + }, + { + "name": "DiagnosticSeverity", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Error", + "value": 1, + "documentation": "Reports an error." + }, + { + "name": "Warning", + "value": 2, + "documentation": "Reports a warning." + }, + { + "name": "Information", + "value": 3, + "documentation": "Reports an information." + }, + { + "name": "Hint", + "value": 4, + "documentation": "Reports a hint." + } + ], + "documentation": "The diagnostic's severity." + }, + { + "name": "DiagnosticTag", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Unnecessary", + "value": 1, + "documentation": "Unused or unnecessary code.\n\nClients are allowed to render diagnostics with this tag faded out instead of having\nan error squiggle." + }, + { + "name": "Deprecated", + "value": 2, + "documentation": "Deprecated or obsolete code.\n\nClients are allowed to rendered diagnostics with this tag strike through." + } + ], + "documentation": "The diagnostic tags.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "CompletionTriggerKind", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Invoked", + "value": 1, + "documentation": "Completion was triggered by typing an identifier (24x7 code\ncomplete), manual invocation (e.g Ctrl+Space) or via API." + }, + { + "name": "TriggerCharacter", + "value": 2, + "documentation": "Completion was triggered by a trigger character specified by\nthe `triggerCharacters` properties of the `CompletionRegistrationOptions`." + }, + { + "name": "TriggerForIncompleteCompletions", + "value": 3, + "documentation": "Completion was re-triggered as current completion list is incomplete" + } + ], + "documentation": "How a completion was triggered" + }, + { + "name": "SignatureHelpTriggerKind", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Invoked", + "value": 1, + "documentation": "Signature help was invoked manually by the user or by a command." + }, + { + "name": "TriggerCharacter", + "value": 2, + "documentation": "Signature help was triggered by a trigger character." + }, + { + "name": "ContentChange", + "value": 3, + "documentation": "Signature help was triggered by the cursor moving or by the document content changing." + } + ], + "documentation": "How a signature help was triggered.\n\n@since 3.15.0", + "since": "3.15.0" + }, + { + "name": "CodeActionTriggerKind", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Invoked", + "value": 1, + "documentation": "Code actions were explicitly requested by the user or by an extension." + }, + { + "name": "Automatic", + "value": 2, + "documentation": "Code actions were requested automatically.\n\nThis typically happens when current selection in a file changes, but can\nalso be triggered when file content changes." + } + ], + "documentation": "The reason why code actions were requested.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "FileOperationPatternKind", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "file", + "value": "file", + "documentation": "The pattern matches a file only." + }, + { + "name": "folder", + "value": "folder", + "documentation": "The pattern matches a folder only." + } + ], + "documentation": "A pattern kind describing if a glob pattern matches a file a folder or\nboth.\n\n@since 3.16.0", + "since": "3.16.0" + }, + { + "name": "NotebookCellKind", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Markup", + "value": 1, + "documentation": "A markup-cell is formatted source that is used for display." + }, + { + "name": "Code", + "value": 2, + "documentation": "A code-cell is source code." + } + ], + "documentation": "A notebook cell kind.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "ResourceOperationKind", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "Create", + "value": "create", + "documentation": "Supports creating new files and folders." + }, + { + "name": "Rename", + "value": "rename", + "documentation": "Supports renaming existing files and folders." + }, + { + "name": "Delete", + "value": "delete", + "documentation": "Supports deleting existing files and folders." + } + ] + }, + { + "name": "FailureHandlingKind", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "Abort", + "value": "abort", + "documentation": "Applying the workspace change is simply aborted if one of the changes provided\nfails. All operations executed before the failing operation stay executed." + }, + { + "name": "Transactional", + "value": "transactional", + "documentation": "All operations are executed transactional. That means they either all\nsucceed or no changes at all are applied to the workspace." + }, + { + "name": "TextOnlyTransactional", + "value": "textOnlyTransactional", + "documentation": "If the workspace edit contains only textual file changes they are executed transactional.\nIf resource changes (create, rename or delete file) are part of the change the failure\nhandling strategy is abort." + }, + { + "name": "Undo", + "value": "undo", + "documentation": "The client tries to undo the operations already executed. But there is no\nguarantee that this is succeeding." + } + ] + }, + { + "name": "PrepareSupportDefaultBehavior", + "type": { + "kind": "base", + "name": "uinteger" + }, + "values": [ + { + "name": "Identifier", + "value": 1, + "documentation": "The client's default behavior is to select the identifier\naccording the to language's syntax rule." + } + ] + }, + { + "name": "TokenFormat", + "type": { + "kind": "base", + "name": "string" + }, + "values": [ + { + "name": "Relative", + "value": "relative" + } + ] + } + ], + "typeAliases": [ + { + "name": "Definition", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Location" + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "Location" + } + } + ] + }, + "documentation": "The definition of a symbol represented as one or many {@link Location locations}.\nFor most programming languages there is only one location at which a symbol is\ndefined.\n\nServers should prefer returning `DefinitionLink` over `Definition` if supported\nby the client." + }, + { + "name": "DefinitionLink", + "type": { + "kind": "reference", + "name": "LocationLink" + }, + "documentation": "Information about where a symbol is defined.\n\nProvides additional metadata over normal {@link Location location} definitions, including the range of\nthe defining symbol" + }, + { + "name": "LSPArray", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "LSPAny" + } + }, + "documentation": "LSP arrays.\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "LSPAny", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "LSPObject" + }, + { + "kind": "reference", + "name": "LSPArray" + }, + { + "kind": "base", + "name": "string" + }, + { + "kind": "base", + "name": "integer" + }, + { + "kind": "base", + "name": "uinteger" + }, + { + "kind": "base", + "name": "decimal" + }, + { + "kind": "base", + "name": "boolean" + }, + { + "kind": "base", + "name": "null" + } + ] + }, + "documentation": "The LSP any type.\nPlease note that strictly speaking a property with the value `undefined`\ncan't be converted into JSON preserving the property name. However for\nconvenience it is allowed and assumed that all these properties are\noptional as well.\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "Declaration", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Location" + }, + { + "kind": "array", + "element": { + "kind": "reference", + "name": "Location" + } + } + ] + }, + "documentation": "The declaration of a symbol representation as one or many {@link Location locations}." + }, + { + "name": "DeclarationLink", + "type": { + "kind": "reference", + "name": "LocationLink" + }, + "documentation": "Information about where a symbol is declared.\n\nProvides additional metadata over normal {@link Location location} declarations, including the range of\nthe declaring symbol.\n\nServers should prefer returning `DeclarationLink` over `Declaration` if supported\nby the client." + }, + { + "name": "InlineValue", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "InlineValueText" + }, + { + "kind": "reference", + "name": "InlineValueVariableLookup" + }, + { + "kind": "reference", + "name": "InlineValueEvaluatableExpression" + } + ] + }, + "documentation": "Inline value information can be provided by different means:\n- directly as a text value (class InlineValueText).\n- as a name to use for a variable lookup (class InlineValueVariableLookup)\n- as an evaluatable expression (class InlineValueEvaluatableExpression)\nThe InlineValue types combines all inline value types into one type.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "DocumentDiagnosticReport", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "RelatedFullDocumentDiagnosticReport" + }, + { + "kind": "reference", + "name": "RelatedUnchangedDocumentDiagnosticReport" + } + ] + }, + "documentation": "The result of a document diagnostic pull request. A report can\neither be a full report containing all diagnostics for the\nrequested document or an unchanged report indicating that nothing\nhas changed in terms of diagnostics in comparison to the last\npull request.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "PrepareRenameResult", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Range" + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + } + }, + { + "name": "placeholder", + "type": { + "kind": "base", + "name": "string" + } + } + ] + } + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "defaultBehavior", + "type": { + "kind": "base", + "name": "boolean" + } + } + ] + } + } + ] + } + }, + { + "name": "DocumentSelector", + "type": { + "kind": "array", + "element": { + "kind": "reference", + "name": "DocumentFilter" + } + }, + "documentation": "A document selector is the combination of one or many document filters.\n\n@sample `let sel:DocumentSelector = [{ language: 'typescript' }, { language: 'json', pattern: '**∕tsconfig.json' }]`;\n\nThe use of a string as a document filter is deprecated @since 3.16.0.", + "since": "3.16.0." + }, + { + "name": "ProgressToken", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "integer" + }, + { + "kind": "base", + "name": "string" + } + ] + } + }, + { + "name": "ChangeAnnotationIdentifier", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "An identifier to refer to a change annotation stored with a workspace edit." + }, + { + "name": "WorkspaceDocumentDiagnosticReport", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "WorkspaceFullDocumentDiagnosticReport" + }, + { + "kind": "reference", + "name": "WorkspaceUnchangedDocumentDiagnosticReport" + } + ] + }, + "documentation": "A workspace diagnostic document report.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "TextDocumentContentChangeEvent", + "type": { + "kind": "or", + "items": [ + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "range", + "type": { + "kind": "reference", + "name": "Range" + }, + "documentation": "The range of the document that changed." + }, + { + "name": "rangeLength", + "type": { + "kind": "base", + "name": "uinteger" + }, + "optional": true, + "documentation": "The optional length of the range that got replaced.\n\n@deprecated use range instead." + }, + { + "name": "text", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The new text for the provided range." + } + ] + } + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "text", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The new text of the whole document." + } + ] + } + } + ] + }, + "documentation": "An event describing a change to a text document. If only a text is provided\nit is considered to be the full content of the document." + }, + { + "name": "MarkedString", + "type": { + "kind": "or", + "items": [ + { + "kind": "base", + "name": "string" + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "language", + "type": { + "kind": "base", + "name": "string" + } + }, + { + "name": "value", + "type": { + "kind": "base", + "name": "string" + } + } + ] + } + } + ] + }, + "documentation": "MarkedString can be used to render human readable text. It is either a markdown string\nor a code-block that provides a language and a code snippet. The language identifier\nis semantically equal to the optional language identifier in fenced code blocks in GitHub\nissues. See https://help.github.com/articles/creating-and-highlighting-code-blocks/#syntax-highlighting\n\nThe pair of a language and a value is an equivalent to markdown:\n```${language}\n${value}\n```\n\nNote that markdown strings will be sanitized - that means html will be escaped.\n@deprecated use MarkupContent instead.", + "deprecated": "use MarkupContent instead." + }, + { + "name": "DocumentFilter", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "TextDocumentFilter" + }, + { + "kind": "reference", + "name": "NotebookCellTextDocumentFilter" + } + ] + }, + "documentation": "A document filter describes a top level text document or\na notebook cell document.\n\n@since 3.17.0 - proposed support for NotebookCellTextDocumentFilter.", + "since": "3.17.0 - proposed support for NotebookCellTextDocumentFilter." + }, + { + "name": "LSPObject", + "type": { + "kind": "map", + "key": { + "kind": "base", + "name": "string" + }, + "value": { + "kind": "reference", + "name": "LSPAny" + } + }, + "documentation": "LSP object definition.\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "GlobPattern", + "type": { + "kind": "or", + "items": [ + { + "kind": "reference", + "name": "Pattern" + }, + { + "kind": "reference", + "name": "RelativePattern" + } + ] + }, + "documentation": "The glob pattern. Either a string pattern or a relative pattern.\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "TextDocumentFilter", + "type": { + "kind": "or", + "items": [ + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "language", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A language id, like `typescript`." + }, + { + "name": "scheme", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A Uri {@link Uri.scheme scheme}, like `file` or `untitled`." + }, + { + "name": "pattern", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A glob pattern, like `*.{ts,js}`." + } + ] + } + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "language", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A language id, like `typescript`." + }, + { + "name": "scheme", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A Uri {@link Uri.scheme scheme}, like `file` or `untitled`." + }, + { + "name": "pattern", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A glob pattern, like `*.{ts,js}`." + } + ] + } + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "language", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A language id, like `typescript`." + }, + { + "name": "scheme", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A Uri {@link Uri.scheme scheme}, like `file` or `untitled`." + }, + { + "name": "pattern", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A glob pattern, like `*.{ts,js}`." + } + ] + } + } + ] + }, + "documentation": "A document filter denotes a document by different properties like\nthe {@link TextDocument.languageId language}, the {@link Uri.scheme scheme} of\nits resource, or a glob-pattern that is applied to the {@link TextDocument.fileName path}.\n\nGlob patterns can have the following syntax:\n- `*` to match one or more characters in a path segment\n- `?` to match on one character in a path segment\n- `**` to match any number of path segments, including none\n- `{}` to group sub patterns into an OR expression. (e.g. `**​/*.{ts,js}` matches all TypeScript and JavaScript files)\n- `[]` to declare a range of characters to match in a path segment (e.g., `example.[0-9]` to match on `example.0`, `example.1`, …)\n- `[!...]` to negate a range of characters to match in a path segment (e.g., `example.[!0-9]` to match on `example.a`, `example.b`, but not `example.0`)\n\n@sample A language filter that applies to typescript files on disk: `{ language: 'typescript', scheme: 'file' }`\n@sample A language filter that applies to all package.json paths: `{ language: 'json', pattern: '**package.json' }`\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "NotebookDocumentFilter", + "type": { + "kind": "or", + "items": [ + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "notebookType", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The type of the enclosing notebook." + }, + { + "name": "scheme", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A Uri {@link Uri.scheme scheme}, like `file` or `untitled`." + }, + { + "name": "pattern", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A glob pattern." + } + ] + } + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "notebookType", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The type of the enclosing notebook." + }, + { + "name": "scheme", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A Uri {@link Uri.scheme scheme}, like `file` or `untitled`." + }, + { + "name": "pattern", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A glob pattern." + } + ] + } + }, + { + "kind": "literal", + "value": { + "properties": [ + { + "name": "notebookType", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "The type of the enclosing notebook." + }, + { + "name": "scheme", + "type": { + "kind": "base", + "name": "string" + }, + "optional": true, + "documentation": "A Uri {@link Uri.scheme scheme}, like `file` or `untitled`." + }, + { + "name": "pattern", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "A glob pattern." + } + ] + } + } + ] + }, + "documentation": "A notebook document filter denotes a notebook document by\ndifferent properties. The properties will be match\nagainst the notebook's URI (same as with documents)\n\n@since 3.17.0", + "since": "3.17.0" + }, + { + "name": "Pattern", + "type": { + "kind": "base", + "name": "string" + }, + "documentation": "The glob pattern to watch relative to the base path. Glob patterns can have the following syntax:\n- `*` to match one or more characters in a path segment\n- `?` to match on one character in a path segment\n- `**` to match any number of path segments, including none\n- `{}` to group conditions (e.g. `**​/*.{ts,js}` matches all TypeScript and JavaScript files)\n- `[]` to declare a range of characters to match in a path segment (e.g., `example.[0-9]` to match on `example.0`, `example.1`, …)\n- `[!...]` to negate a range of characters to match in a path segment (e.g., `example.[!0-9]` to match on `example.a`, `example.b`, but not `example.0`)\n\n@since 3.17.0", + "since": "3.17.0" + } + ] +} diff --git a/lsp-types/metamodel/Language/LSP/MetaModel.hs b/lsp-types/metamodel/Language/LSP/MetaModel.hs new file mode 100644 index 000000000..cf92b5507 --- /dev/null +++ b/lsp-types/metamodel/Language/LSP/MetaModel.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Language.LSP.MetaModel (module Export, metaModel) where + +import Language.LSP.MetaModel.Types as Export + +import Data.FileEmbed (makeRelativeToProject) +import qualified Language.Haskell.TH as TH + +-- | The metamodel used to generate the LSP types in this package. +metaModel :: MetaModel +metaModel = $(loadMetaModelFromFile =<< makeRelativeToProject "metaModel.json") diff --git a/lsp-types/metamodel/Language/LSP/MetaModel/Types.hs b/lsp-types/metamodel/Language/LSP/MetaModel/Types.hs new file mode 100644 index 000000000..0cd3f2f70 --- /dev/null +++ b/lsp-types/metamodel/Language/LSP/MetaModel/Types.hs @@ -0,0 +1,259 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-| +This defines the types of the LSP "metamodel", which is a machine-readable format specifying the +types used in the LSP protocol. + +The type system is quite typescript-y, which isn't surprising given that the whole protocol is +very typescript-y. + +A typescript version of the metamodel types can be found here, which is useful for constructing +this Haskell model of them: +https://github.com/microsoft/vscode-languageserver-node/blob/main/tools/src/metaModel.ts +-} +module Language.LSP.MetaModel.Types where + +import Data.Aeson hiding (Null, String) +import qualified Data.Aeson as JSON +import qualified Data.Aeson.TH as JSON +import qualified Data.Char as Char +import Data.Text (Text) + +import Control.Lens +import Control.Monad.IO.Class +import qualified Data.List.NonEmpty as NE + +import Language.Haskell.TH.Syntax (Lift(..), Q, Exp, addDependentFile) + +-- | What direction is this message sent in: server to client, client to server, or both? +data MessageDirection = ServerToClient | ClientToServer | Both + deriving stock (Show, Eq, Ord, Lift) + +instance ToJSON MessageDirection where + toJSON ServerToClient = toJSON @String "serverToClient" + toJSON ClientToServer = toJSON @String "clientToServer" + toJSON Both = toJSON @String "both" + +instance FromJSON MessageDirection where + parseJSON = withText "MessageDirection" $ \case + "serverToClient" -> pure ServerToClient + "clientToServer" -> pure ClientToServer + "both" -> pure Both + t -> fail $ "unknown message direction " ++ show t + +-- | The "base types" in the metamodel. +data BaseTypeName = URI | DocumentUri | Integer | UInteger | Decimal | RegExp | String | Boolean | Null + deriving stock (Show, Eq, Ord, Lift) + +-- | A property of a structure. +data Property = Property + { name :: Text + , type_ :: Type + , optional :: Maybe Bool + , documentation :: Maybe Text + , since :: Maybe Text + , proposed :: Maybe Bool + , deprecated :: Maybe Text + } + deriving stock (Show, Eq, Ord, Lift) + +-- | An anonymous structure type. +data StructureLiteral = StructureLiteral + { properties :: [Property] + , documentation :: Maybe Text + , since :: Maybe Text + , proposed :: Maybe Bool + , deprecated :: Maybe Text + } + deriving stock (Show, Eq, Ord, Lift) + +-- | The various kinds of type in the metamodel. +data Type = + BaseType { btName :: BaseTypeName } + | ReferenceType { rtName :: Text } + | ArrayType { atElement :: Type } + | MapType { mKey :: Type, mValue :: Type } + | AndType { aItems :: NE.NonEmpty Type } + | OrType { oItems :: NE.NonEmpty Type } + | TupleType { tItems :: [Type] } + | StructureLiteralType { stlValue :: StructureLiteral } + | StringLiteralType { slValue :: Text } + | IntegerLiteralType { ilValue :: Integer } + | BooleanLiteralType { blValue :: Bool } + deriving stock (Show, Eq, Ord, Lift) + +-- | A request message. +data Request = Request + { method :: Text + , params :: Maybe Type -- typescript says it can be [Type], but it never is so whatever + , result :: Type + , partialResult :: Maybe Type + , errorData :: Maybe Type + , registrationOptions :: Maybe Type + , messageDirection :: MessageDirection + , documentation :: Maybe Text + , since :: Maybe Text + , proposed :: Maybe Bool + , deprecated :: Maybe Text + } + deriving stock (Show, Eq, Ord, Lift) + +-- | A notification message. +data Notification = Notification + { method :: Text + , params :: Maybe Type + , registrationOptions :: Maybe Type + , messageDirection :: MessageDirection + , documentation :: Maybe Text + , since :: Maybe Text + , proposed :: Maybe Bool + , deprecated :: Maybe Text + } + deriving stock (Show, Eq, Ord, Lift) + +-- | A structure type. +data Structure = Structure + { name :: Text + , extends :: Maybe [Type] + , mixins :: Maybe [Type] + , properties :: [Property] + , documentation :: Maybe Text + , since :: Maybe Text + , proposed :: Maybe Bool + , deprecated :: Maybe Text + } + deriving stock (Show, Eq, Ord, Lift) + +-- | A type alias. +data TypeAlias = TypeAlias + { name :: Text + , type_ :: Type + , documentation :: Maybe Text + , since :: Maybe Text + , proposed :: Maybe Bool + , deprecated :: Maybe Text + } + deriving stock (Show, Eq, Ord, Lift) + +-- | This is just 'string | int' on the typescript side, but +-- it's convenient to have a proper type here. +data TextOrInteger = T Text | I Integer + deriving stock (Show, Eq, Ord, Lift) + +-- | An entry in an enumeration. +data EnumerationEntry = EnumerationEntry + { name :: Text + , value :: TextOrInteger + , documentation :: Maybe Text + , since :: Maybe Text + , proposed :: Maybe Bool + , deprecated :: Maybe Text + } + deriving stock (Show, Eq, Ord, Lift) + +-- | An enumeration type. +data Enumeration = Enumeration + { name :: Text + , type_ :: Type + , values :: [EnumerationEntry] + , supportsCustomValues :: Maybe Bool + , documentation :: Maybe Text + , since :: Maybe Text + , proposed :: Maybe Bool + , deprecated :: Maybe Text + } + deriving stock (Show, Eq, Ord, Lift) + +-- | Metadata about the metamodel iteslf. +data MetaData = MetaData + { version :: Text + } + deriving stock (Show, Eq, Ord, Lift) + +-- | The entire metamodel. +data MetaModel = MetaModel + { metaData :: MetaData + , requests :: [Request] + , notifications :: [Notification] + , structures :: [Structure] + , enumerations :: [Enumeration] + , typeAliases :: [TypeAlias] + } + deriving stock (Show, Eq, Ord, Lift) + +-- We need to do some massaging to make sure that we get the right aeson instances for +-- these types and can actually parse the incoming data! +$( + let + -- "type" is a very common field name, we use "type_" on the Haskell side + defOpts = defaultOptions{fieldLabelModifier = \case { "type_" -> "type"; x -> x; }} + + propertyInst = JSON.deriveJSON defOpts ''Property + slInst = JSON.deriveJSON defOpts ''StructureLiteral + + -- 'BaseType' is a union of strings, so we encode it as an untagged sum with some + -- mangling of the constructor names + baseTyNameToTag :: String -> String + baseTyNameToTag = \case + "Integer" -> "integer" + "UInteger" -> "uinteger" + "Decimal" -> "decimal" + "String" -> "string" + "Boolean" -> "boolean" + "Null" -> "null" + x -> x + baseTyNameInst = JSON.deriveJSON (defOpts{sumEncoding=JSON.UntaggedValue, constructorTagModifier=baseTyNameToTag}) ''BaseTypeName + + -- 'Type' is a *tagged* union, but the tag is a string field (sigh), fortunately + -- aeson can deal with this. Also needs some constructor mangling. + typeToTag :: String -> String + typeToTag = \case + "BaseType" -> "base" + "ReferenceType" -> "reference" + "ArrayType" -> "array" + "MapType" -> "map" + "AndType" -> "and" + "OrType" -> "or" + "TupleType" -> "tuple" + "StructureLiteralType" -> "literal" + "StringLiteralType" -> "stringLiteral" + "IntegerLiteralType" -> "integerLiteral" + "BooleanLiteralType" -> "booleanLiteral" + x -> x + typeOpts = defOpts + { sumEncoding=JSON.defaultTaggedObject{tagFieldName="kind"} + , constructorTagModifier=typeToTag + , fieldLabelModifier= \s -> over _head Char.toLower $ Prelude.dropWhile Char.isLower s + } + typeInst = JSON.deriveJSON typeOpts ''Type + + -- The rest are mostly normal + reqInst = JSON.deriveJSON defOpts ''Request + notInst = JSON.deriveJSON defOpts ''Notification + sInst = JSON.deriveJSON defOpts ''Structure + taInst = JSON.deriveJSON defOpts ''TypeAlias + -- TextOrInteger is also an untagged sum + tiInst = JSON.deriveJSON (defOpts{sumEncoding=UntaggedValue}) ''TextOrInteger + eeInst = JSON.deriveJSON defOpts ''EnumerationEntry + eInst = JSON.deriveJSON defOpts ''Enumeration + mdInst = JSON.deriveJSON defOpts ''MetaData + mmInst = JSON.deriveJSON defOpts ''MetaModel + in mconcat <$> sequence [ propertyInst, slInst, baseTyNameInst, typeInst, reqInst, notInst, sInst, taInst, tiInst, eeInst, eInst, mdInst, mmInst ] + ) + +loadMetaModelFromFile :: FilePath -> Q Exp +loadMetaModelFromFile fp = do + addDependentFile fp + res <- liftIO $ JSON.eitherDecodeFileStrict' fp + case res of + Left e -> fail e + Right (mm :: MetaModel) -> lift mm diff --git a/lsp-types/src/Data/IxMap.hs b/lsp-types/src/Data/IxMap.hs index 760313c68..9d83acc02 100644 --- a/lsp-types/src/Data/IxMap.hs +++ b/lsp-types/src/Data/IxMap.hs @@ -1,16 +1,16 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE BangPatterns #-} module Data.IxMap where +import Data.Kind import qualified Data.Map.Strict as M -import Data.Some -import Data.Kind -import Unsafe.Coerce +import Data.Some +import Unsafe.Coerce -- a `compare` b <=> toBase a `compare` toBase b -- toBase (i :: f a) == toBase (j :: f b) <=> a ~ b @@ -22,7 +22,7 @@ newtype IxMap (k :: a -> Type) (f :: a -> Type) = IxMap { getMap :: M.Map (Base emptyIxMap :: IxMap k f emptyIxMap = IxMap M.empty - + insertIxMap :: IxOrd k => k m -> f m -> IxMap k f -> Maybe (IxMap k f) insertIxMap (toBase -> i) x (IxMap m) | M.notMember i m = Just $ IxMap $ M.insert i (mkSome x) m @@ -32,10 +32,10 @@ lookupIxMap :: IxOrd k => k m -> IxMap k f -> Maybe (f m) lookupIxMap i (IxMap m) = case M.lookup (toBase i) m of Just (Some v) -> Just $ unsafeCoerce v - Nothing -> Nothing + Nothing -> Nothing pickFromIxMap :: IxOrd k => k m -> IxMap k f -> (Maybe (f m), IxMap k f) pickFromIxMap i (IxMap m) = case M.updateLookupWithKey (\_ _ -> Nothing) (toBase i) m of - (Nothing,!m') -> (Nothing,IxMap m') + (Nothing,!m') -> (Nothing,IxMap m') (Just (Some k),!m') -> (Just (unsafeCoerce k),IxMap m') diff --git a/lsp-types/src/Data/Row/Aeson.hs b/lsp-types/src/Data/Row/Aeson.hs new file mode 100644 index 000000000..f300b4016 --- /dev/null +++ b/lsp-types/src/Data/Row/Aeson.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +{-| +This module defines orphan `aeson` instances for `Data.Row`. +They differ from the instances in `row-types-aeson` in one crucial respect: they +serialise `Nothing` fields by *omitting* them in the resulting object, and parse absent fields as `Nothing`. +`aeson` can be configured to have this behviour for instances for datatypes, but we want to do this +for record types generically. + +This is crucial to match what LSP clients expect. +-} +module Data.Row.Aeson where + +import Data.Aeson +import Data.Aeson.KeyMap (singleton) +import Data.Aeson.Types (Parser, typeMismatch) +import Data.List (intercalate) + +import Data.Row +import Data.Row.Internal +import qualified Data.Row.Records as Rec + +import Data.Bifunctor (second) +import Data.Functor.Const +import Data.Functor.Identity +import Data.Proxy +import Data.String + +-- `aeson` does not need such a typeclass because it generates code per-instance +-- that handles this, whereas we want to work generically. + +-- | Serialise a value as an entry in a JSON object. This allows customizing the +-- behaviour in the object context, in order to e.g. omit the field. +class ToJSONEntry a where + toJSONEntry :: Key -> a -> Object + +instance {-# OVERLAPPING #-} ToJSON a => ToJSONEntry (Maybe a) where + -- Omit Nothing fields + toJSONEntry _ Nothing = mempty + toJSONEntry k v = singleton k (toJSON v) + +instance {-# OVERLAPPABLE #-} ToJSON a => ToJSONEntry a where + toJSONEntry k v = singleton k (toJSON v) + +class FromJSONEntry a where + parseJSONEntry :: Object -> Key -> Parser a + +instance {-# OVERLAPPING #-} FromJSON a => FromJSONEntry (Maybe a) where + -- Parse Nothing fields as optional + parseJSONEntry o k = o .:? k + +instance {-# OVERLAPPABLE #-} FromJSON a => FromJSONEntry a where + parseJSONEntry o k = o .: k + +------ + +instance Forall r ToJSONEntry => ToJSON (Rec r) where + -- Sadly, there appears to be no helper we can use that gives us access to the keys, so I just used metamorph directly + -- adapted from 'eraseWithLabels' + toJSON rc = Object $ getConst $ metamorph @_ @r @ToJSONEntry @(,) @Rec @(Const Object) @Identity Proxy doNil doUncons doCons rc + where + doNil :: Rec Empty -> Const Object Empty + doNil _ = Const mempty + doUncons + :: forall l r' + . (KnownSymbol l) + => Label l + -> Rec r' + -> (Rec (r' .- l), Identity (r' .! l)) + doUncons l = second Identity . lazyUncons l + doCons + :: forall l t r' + . (KnownSymbol l, ToJSONEntry t) + => Label l + -> (Const Object r', Identity t) + -> Const Object (Extend l t r') + doCons l (Const c, Identity x) = Const $ toJSONEntry (show' l) x <> c + +instance (AllUniqueLabels r, Forall r FromJSONEntry) => FromJSON (Rec r) where + parseJSON (Object o) = do + r <- Rec.fromLabelsA @FromJSONEntry $ \ l -> do + x <- parseJSONEntry o (fromString $ show l) + x `seq` pure x + r `seq` pure r + + parseJSON v = typeMismatch msg v + where msg = "REC: {" ++ intercalate "," (labels @r @FromJSONEntry) ++ "}" + +--- Copied from the library, as it's private + +lazyUncons :: KnownSymbol l => Label l -> Rec r -> (Rec (r .- l), r .! l) +lazyUncons l r = (Rec.lazyRemove l r, r .! l) diff --git a/lsp-types/src/Language/LSP/Protocol/Capabilities.hs b/lsp-types/src/Language/LSP/Protocol/Capabilities.hs new file mode 100644 index 000000000..9f0b6b2aa --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Capabilities.hs @@ -0,0 +1,308 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +module Language.LSP.Protocol.Capabilities + ( + fullCaps + , LSPVersion(..) + , capsForVersion + ) where + +import Data.Row +import qualified Data.Set as Set +import Language.LSP.Protocol.Types hiding (resourceOperations, general, window) +import Prelude hiding (min) + +{- +TODO: this is out-of-date/needs an audit +TODO: can we generate this? process the 'since' annotations in the metamodel? +-} + +-- | Capabilities for full conformance to the current (v3.15) LSP specification. +fullCaps :: ClientCapabilities +fullCaps = capsForVersion (LSPVersion maxBound maxBound) + +-- | A specific version of the LSP specification. +data LSPVersion = LSPVersion Int Int -- ^ Construct a major.minor version + +-- | Capabilities for full conformance to the LSP specification up until a version. +-- Some important milestones: +-- +-- * 3.12 textDocument/prepareRename request +-- * 3.11 CodeActionOptions provided by the server +-- * 3.10 hierarchical document symbols, folding ranges +-- * 3.9 completion item preselect +-- * 3.8 codeAction literals +-- * 3.7 related information in diagnostics +-- * 3.6 workspace folders, colors, goto type/implementation +-- * 3.4 extended completion item and symbol item kinds +-- * 3.0 dynamic registration +capsForVersion :: LSPVersion -> ClientCapabilities +capsForVersion (LSPVersion maj min) = caps + where + caps = ClientCapabilities { + _workspace=Just w + , _textDocument=Just td + , _window=Just window + , _general=since 3 16 general + , _experimental=Nothing + -- TODO + , _notebookDocument=Nothing + } + w = WorkspaceClientCapabilities { + _applyEdit = Just True + , _workspaceEdit = Just (WorkspaceEditClientCapabilities + (Just True) + (since 3 13 resourceOperations) + Nothing + (since 3 16 True) + (since 3 16 (#groupsOnLabel .== Just True))) + , _didChangeConfiguration = Just (DidChangeConfigurationClientCapabilities dynamicReg) + , _didChangeWatchedFiles = Just (DidChangeWatchedFilesClientCapabilities dynamicReg (Just True)) + , _symbol = Just symbolCapabilities + , _executeCommand = Just (ExecuteCommandClientCapabilities dynamicReg) + , _workspaceFolders = since 3 6 True + , _configuration = since 3 6 True + , _semanticTokens = since 3 16 (SemanticTokensWorkspaceClientCapabilities $ Just True) + -- TODO + , _codeLens = Nothing + , _fileOperations = Nothing + , _inlineValue = Nothing + , _inlayHint = Nothing + , _diagnostics = Nothing + } + + resourceOperations = + [ ResourceOperationKind_Create + , ResourceOperationKind_Delete + , ResourceOperationKind_Rename + ] + + symbolCapabilities = WorkspaceSymbolClientCapabilities + dynamicReg + (since 3 4 (#valueSet .== Just sKs)) + (since 3 16 (#valueSet .== [SymbolTag_Deprecated])) + (since 3 17 (#properties .== [])) + + sKs + | maj >= 3 && min >= 4 = oldSKs ++ newSKs + | otherwise = oldSKs + + oldSKs = [ SymbolKind_File + , SymbolKind_Module + , SymbolKind_Namespace + , SymbolKind_Package + , SymbolKind_Class + , SymbolKind_Method + , SymbolKind_Property + , SymbolKind_Field + , SymbolKind_Constructor + , SymbolKind_Enum + , SymbolKind_Interface + , SymbolKind_Function + , SymbolKind_Variable + , SymbolKind_Constant + , SymbolKind_String + , SymbolKind_Number + , SymbolKind_Boolean + , SymbolKind_Array + ] + + newSKs = [ SymbolKind_Object + , SymbolKind_Key + , SymbolKind_Null + , SymbolKind_EnumMember + , SymbolKind_Struct + , SymbolKind_Event + , SymbolKind_Operator + , SymbolKind_TypeParameter + ] + + -- Only one token format for now, just list it here + tfs = [ TokenFormat_Relative ] + + semanticTokensCapabilities = SemanticTokensClientCapabilities { + _dynamicRegistration=Just True + , _requests= #range .== Just (InL True) .+ #full .== Just (InR (#delta .== Just True)) + , _tokenTypes=toEnumBaseType <$> Set.toList (knownValues @SemanticTokenTypes) + , _tokenModifiers=toEnumBaseType <$> Set.toList (knownValues @SemanticTokenModifiers) + , _formats=tfs + , _overlappingTokenSupport=Just True + , _multilineTokenSupport=Just True + , _serverCancelSupport=Just True + , _augmentsSyntaxTokens=Just True + } + + td = TextDocumentClientCapabilities { + _synchronization=Just sync + , _completion=Just completionCapability + , _hover=Just hoverCapability + , _signatureHelp=Just signatureHelpCapability + , _references=Just (ReferenceClientCapabilities dynamicReg) + , _documentHighlight=Just (DocumentHighlightClientCapabilities dynamicReg) + , _documentSymbol=Just documentSymbolCapability + , _formatting=Just (DocumentFormattingClientCapabilities dynamicReg) + , _rangeFormatting=Just (DocumentRangeFormattingClientCapabilities dynamicReg) + , _onTypeFormatting=Just (DocumentOnTypeFormattingClientCapabilities dynamicReg) + , _declaration=since 3 14 (DeclarationClientCapabilities dynamicReg (Just True)) + , _definition=Just (DefinitionClientCapabilities dynamicReg (since 3 14 True)) + , _typeDefinition=since 3 6 (TypeDefinitionClientCapabilities dynamicReg (since 3 14 True)) + , _implementation=since 3 6 (ImplementationClientCapabilities dynamicReg (since 3 14 True)) + , _codeAction=Just codeActionCapability + , _codeLens=Just (CodeLensClientCapabilities dynamicReg) + , _documentLink=Just (DocumentLinkClientCapabilities dynamicReg (since 3 15 True)) + , _colorProvider=since 3 6 (DocumentColorClientCapabilities dynamicReg) + , _rename=Just (RenameClientCapabilities dynamicReg (since 3 12 True) (since 3 16 PrepareSupportDefaultBehavior_Identifier) (since 3 16 True)) + , _publishDiagnostics=Just publishDiagnosticsCapabilities + , _foldingRange=since 3 10 foldingRangeCapability + , _selectionRange=since 3 5 (SelectionRangeClientCapabilities dynamicReg) + , _callHierarchy=since 3 16 (CallHierarchyClientCapabilities dynamicReg) + , _semanticTokens=since 3 16 semanticTokensCapabilities + -- TODO + , _linkedEditingRange=Nothing + , _moniker=Nothing + , _typeHierarchy=Nothing + , _inlineValue=Nothing + , _inlayHint=Nothing + , _diagnostic=Nothing + } + + sync = + TextDocumentSyncClientCapabilities { + _dynamicRegistration=dynamicReg + , _willSave=Just True + , _willSaveWaitUntil=Just True + , _didSave=Just True + } + + completionCapability = + CompletionClientCapabilities{ + _dynamicRegistration=dynamicReg + , _completionItem=Just completionItemCapabilities + , _completionItemKind=since 3 4 (#valueSet .== Just ciKs) + , _insertTextMode=since 3 17 InsertTextMode_AsIs + , _contextSupport=since 3 3 True + , _completionList=since 3 17 (#itemDefaults .== Just []) + } + + completionItemCapabilities = + #snippetSupport .== Just True + .+ #commitCharactersSupport .== Just True + .+ #documentationFormat .== since 3 3 allMarkups + .+ #deprecatedSupport .== Just True + .+ #preselectSupport .== since 3 9 True + .+ #tagSupport .== since 3 15 (#valueSet .== []) + .+ #insertReplaceSupport .== since 3 16 True + .+ #resolveSupport .== since 3 16 (#properties .== ["documentation", "details"]) + .+ #insertTextModeSupport .== since 3 16 (#valueSet .== []) + .+ #labelDetailsSupport .== since 3 17 True + + ciKs + | maj >= 3 && min >= 4 = oldCiKs ++ newCiKs + | otherwise = oldCiKs + + oldCiKs = [ CompletionItemKind_Text + , CompletionItemKind_Method + , CompletionItemKind_Function + , CompletionItemKind_Constructor + , CompletionItemKind_Field + , CompletionItemKind_Variable + , CompletionItemKind_Class + , CompletionItemKind_Interface + , CompletionItemKind_Module + , CompletionItemKind_Property + , CompletionItemKind_Unit + , CompletionItemKind_Value + , CompletionItemKind_Enum + , CompletionItemKind_Keyword + , CompletionItemKind_Snippet + , CompletionItemKind_Color + , CompletionItemKind_File + , CompletionItemKind_Reference + ] + + newCiKs = [ CompletionItemKind_Folder + , CompletionItemKind_EnumMember + , CompletionItemKind_Constant + , CompletionItemKind_Struct + , CompletionItemKind_Event + , CompletionItemKind_Operator + , CompletionItemKind_TypeParameter + ] + + hoverCapability = + HoverClientCapabilities { + _dynamicRegistration=dynamicReg + , _contentFormat=since 3 3 allMarkups + } + + codeActionCapability + = CodeActionClientCapabilities { + _dynamicRegistration=dynamicReg + , _codeActionLiteralSupport=since 3 8 (#codeActionKind .== (#valueSet .== Set.toList knownValues)) + , _isPreferredSupport=since 3 15 True + , _disabledSupport=since 3 16 True + , _dataSupport=since 3 16 True + , _resolveSupport=since 3 16 (#properties .== []) + , _honorsChangeAnnotations=since 3 16 True + } + + signatureHelpCapability = + SignatureHelpClientCapabilities { + _dynamicRegistration=dynamicReg + , _signatureInformation=Just (#documentationFormat .== Just allMarkups .+ #parameterInformation .== Just (#labelOffsetSupport .== Just True) .+ #activeParameterSupport .== Just True) + , _contextSupport=since 3 16 True + } + + documentSymbolCapability = + DocumentSymbolClientCapabilities { + _dynamicRegistration=dynamicReg + -- same as workspace symbol kinds + , _symbolKind=Just (#valueSet .== Just sKs) + , _hierarchicalDocumentSymbolSupport=since 3 10 True + , _tagSupport=since 3 16 (#valueSet .== [SymbolTag_Deprecated]) + , _labelSupport=since 3 16 True + } + + foldingRangeCapability = + FoldingRangeClientCapabilities { + _dynamicRegistration=dynamicReg + , _rangeLimit=Nothing + , _lineFoldingOnly=Nothing + , _foldingRangeKind=since 3 17 (#valueSet .== Just []) + , _foldingRange=since 3 16 (#collapsedText .== Just True) + } + + publishDiagnosticsCapabilities = + PublishDiagnosticsClientCapabilities { + _relatedInformation=since 3 7 True + , _tagSupport=since 3 15 (#valueSet .== [ DiagnosticTag_Unnecessary, DiagnosticTag_Deprecated ]) + , _versionSupport=since 3 15 True + , _codeDescriptionSupport=since 3 16 True + , _dataSupport=since 3 16 True + } + + dynamicReg + | maj >= 3 = Just True + | otherwise = Nothing + since :: Int -> Int -> a -> Maybe a + since x y a + | maj >= x && min >= y = Just a + | otherwise = Nothing + + window = + WindowClientCapabilities { + _workDoneProgress=since 3 15 True + , _showMessage=since 3 16 $ ShowMessageRequestClientCapabilities Nothing + , _showDocument=since 3 16 $ ShowDocumentClientCapabilities True + } + + general = GeneralClientCapabilities { + _staleRequestSupport=since 3 16 (#cancel .== True .+ #retryOnContentModified .== []) + , _regularExpressions=since 3 16 $ RegularExpressionsClientCapabilities "" Nothing + , _markdown=since 3 16 $ MarkdownClientCapabilities "" Nothing (Just []) + -- TODO + , _positionEncodings=Nothing + } + + allMarkups = [MarkupKind_PlainText, MarkupKind_Markdown] diff --git a/lsp-types/src/Language/LSP/Protocol/Message.hs b/lsp-types/src/Language/LSP/Protocol/Message.hs new file mode 100644 index 000000000..0bb30a9e7 --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Message.hs @@ -0,0 +1,24 @@ +module Language.LSP.Protocol.Message ( + -- * Messages + -- ** LSP protocol message types and metadata + module Message + , module LspId + , module Meta + -- ** Parsing LSP messages + , module Parsing + -- * Methods + -- ** Main LSP method types and functions + , module Generated + -- ** Helpers for working with methods + , module Method + -- * LSP registrations + , module Registration + ) where + +import Language.LSP.Protocol.Internal.Method as Generated +import Language.LSP.Protocol.Message.LspId as LspId +import Language.LSP.Protocol.Message.Meta as Meta +import Language.LSP.Protocol.Message.Method as Method +import Language.LSP.Protocol.Message.Parsing as Parsing +import Language.LSP.Protocol.Message.Registration as Registration +import Language.LSP.Protocol.Message.Types as Message diff --git a/lsp-types/src/Language/LSP/Types/LspId.hs b/lsp-types/src/Language/LSP/Protocol/Message/LspId.hs similarity index 62% rename from lsp-types/src/Language/LSP/Types/LspId.hs rename to lsp-types/src/Language/LSP/Protocol/Message/LspId.hs index d61bf32e1..f8abeeae6 100644 --- a/lsp-types/src/Language/LSP/Types/LspId.hs +++ b/lsp-types/src/Language/LSP/Protocol/Message/LspId.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} -{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -module Language.LSP.Types.LspId where - -import qualified Data.Aeson as A +{-# LANGUAGE TypeInType #-} +module Language.LSP.Protocol.Message.LspId where + +import qualified Data.Aeson as A import Data.Hashable -import Data.Int (Int32) import Data.IxMap -import Data.Text (Text) +import Data.Text (Text) -import Language.LSP.Types.Method +import Language.LSP.Protocol.Types.Common +import Language.LSP.Protocol.Internal.Method +import Language.LSP.Protocol.Message.Meta -- | Id used for a request, Can be either a String or an Int data LspId (m :: Method f Request) = IdInt !Int32 | IdString !Text - deriving (Show,Read,Eq,Ord) + deriving stock (Show,Read,Eq,Ord) instance A.ToJSON (LspId m) where toJSON (IdInt i) = A.toJSON i @@ -32,17 +28,17 @@ instance IxOrd LspId where toBase = SomeLspId instance Hashable (LspId m) where - hashWithSalt n (IdInt i) = hashWithSalt n i + hashWithSalt n (IdInt i) = hashWithSalt n i hashWithSalt n (IdString t) = hashWithSalt n t data SomeLspId where SomeLspId :: !(LspId m) -> SomeLspId -deriving instance Show SomeLspId +deriving stock instance Show SomeLspId instance Eq SomeLspId where - SomeLspId (IdInt a) == SomeLspId (IdInt b) = a == b + SomeLspId (IdInt a) == SomeLspId (IdInt b) = a == b SomeLspId (IdString a) == SomeLspId (IdString b) = a == b - _ == _ = False + _ == _ = False instance Ord SomeLspId where compare (SomeLspId x) (SomeLspId y) = go x y where diff --git a/lsp-types/src/Language/LSP/Protocol/Message/Meta.hs b/lsp-types/src/Language/LSP/Protocol/Message/Meta.hs new file mode 100644 index 000000000..e2628b12c --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Message/Meta.hs @@ -0,0 +1,18 @@ +module Language.LSP.Protocol.Message.Meta where + +-- | Which direction messages are sent in. +data MessageDirection = ServerToClient | ClientToServer +-- | What kind of message is sent. +data MessageKind = Notification | Request + +-- | Singleton type for 'MessageDirection'. +data SMessageDirection (f :: MessageDirection) where + SClientToServer :: SMessageDirection ClientToServer + SServerToClient :: SMessageDirection ServerToClient + SBothDirections :: SMessageDirection f + +-- | Singleton type for 'MessageKind'. +data SMessageKind (f :: MessageKind) where + SNotification :: SMessageKind Notification + SRequest :: SMessageKind Request + SBothTypes :: SMessageKind f diff --git a/lsp-types/src/Language/LSP/Protocol/Message/Method.hs b/lsp-types/src/Language/LSP/Protocol/Message/Method.hs new file mode 100644 index 000000000..cd5d16ab7 --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Message/Method.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +{-# OPTIONS_GHC -Wno-orphans #-} +module Language.LSP.Protocol.Message.Method where + +import Data.Aeson.Types +import Data.Function (on) +import Data.GADT.Compare +import Data.Proxy +import Data.Type.Equality +import GHC.Exts (Int (..), dataToTag#) +import GHC.TypeLits (KnownSymbol, sameSymbol, + symbolVal) +import Language.LSP.Protocol.Internal.Method +import Language.LSP.Protocol.Message.Meta +import Language.LSP.Protocol.Utils.Misc +import Unsafe.Coerce + +--------------- +-- SomeMethod +--------------- + +deriving stock instance Show SomeMethod +instance Eq SomeMethod where + (==) = (==) `on` someMethodToMethodString +instance Ord SomeMethod where + compare = compare `on` someMethodToMethodString + +instance ToJSON SomeMethod where + toJSON sm = toJSON $ someMethodToMethodString sm + +instance FromJSON SomeMethod where + parseJSON v = do + s <- parseJSON v + pure $ methodStringToSomeMethod s + +--------------- +-- SMethod +--------------- + +-- This instance is written manually rather than derived to avoid a dependency +-- on 'dependent-sum-template'. +instance GEq SMethod where + geq x y = case gcompare x y of + GLT -> Nothing + GEQ -> Just Refl + GGT -> Nothing + +-- This instance is written manually rather than derived to avoid a dependency +-- on 'dependent-sum-template'. +instance GCompare SMethod where + gcompare (SMethod_CustomMethod x) (SMethod_CustomMethod y) = case symbolVal x `compare` symbolVal y of + LT -> GLT + EQ -> unsafeCoerce GEQ + GT -> GGT + -- This is much more compact than matching on every pair of constructors, which + -- is what we would need to do for GHC to 'see' that this is correct. Nonetheless + -- it is safe: since there is only one constructor of 'SMethod' for each 'Method', + -- the argument types can only be equal if the constructor tag is equal. + gcompare x y = case I# (dataToTag# x) `compare` I# (dataToTag# y) of + LT -> GLT + EQ -> unsafeCoerce GEQ + GT -> GGT + +instance Eq (SMethod m) where + -- This defers to 'GEq', ensuring that this version is compatible. + (==) = defaultEq + +instance Ord (SMethod m) where + -- This defers to 'GCompare', ensuring that this version is compatible. + compare = defaultCompare + +deriving stock instance Show (SMethod m) + +instance ToJSON (SMethod m) where + toJSON m = toJSON (SomeMethod m) + +instance KnownSymbol s => FromJSON (SMethod ('Method_CustomMethod s :: Method f t)) where + parseJSON v = do + sm <- parseJSON v + case sm of + SomeMethod (SMethod_CustomMethod x) -> case sameSymbol x (Proxy :: Proxy s) of + Just Refl -> pure $ SMethod_CustomMethod x + Nothing -> mempty + _ -> mempty + +-- TODO: generate these with everything else? +-- Generates lots of instances like this in terms of the FromJSON SomeMethod instance +-- instance FromJSON (SMethod Method_X) +makeSingletonFromJSON 'SomeMethod ''SMethod ['SMethod_CustomMethod] + +--------------- +-- Extras +--------------- + +-- Some useful type synonyms +type SClientMethod (m :: Method ClientToServer t) = SMethod m +type SServerMethod (m :: Method ServerToClient t) = SMethod m + +data SomeClientMethod = forall t (m :: Method ClientToServer t). SomeClientMethod (SMethod m) +deriving stock instance Show SomeClientMethod + +data SomeServerMethod = forall t (m :: Method ServerToClient t). SomeServerMethod (SMethod m) +deriving stock instance Show SomeServerMethod + +someClientMethod :: SMethod m -> Maybe SomeClientMethod +someClientMethod s = case messageDirection s of + SClientToServer -> Just $ SomeClientMethod s + SServerToClient -> Nothing + -- See Note [Parsing methods that go both ways] + SBothDirections -> Just $ SomeClientMethod $ unsafeCoerce s + +someServerMethod :: SMethod m -> Maybe SomeServerMethod +someServerMethod s = case messageDirection s of + SServerToClient-> Just $ SomeServerMethod s + SClientToServer -> Nothing + -- See Note [Parsing methods that go both ways] + SBothDirections -> Just $ SomeServerMethod $ unsafeCoerce s + +instance FromJSON SomeClientMethod where + parseJSON v = do + (SomeMethod sm) <- parseJSON v + case someClientMethod sm of + Just scm -> pure scm + Nothing -> mempty + +instance ToJSON SomeClientMethod where + toJSON (SomeClientMethod sm) = toJSON $ someMethodToMethodString $ SomeMethod sm + +instance FromJSON SomeServerMethod where + parseJSON v = do + (SomeMethod sm) <- parseJSON v + case someServerMethod sm of + Just scm -> pure scm + Nothing -> mempty + +instance ToJSON SomeServerMethod where + toJSON (SomeServerMethod sm) = toJSON $ someMethodToMethodString $ SomeMethod sm + +{- Note [Parsing methods that go both ways] + +In order to parse a method as a client or server method, we use 'messageDirection' +to get a proof that the message direction is what we say it is. But this just doesn't +work for the both directions case: because we are awkwardly representing "both directions" +as "the type variable is free". So the types don't line up and we use an awful hack. + +A better solution might be to move away from using an unconstrained type parameter to +mean "both directions". +-} diff --git a/lsp-types/src/Language/LSP/Protocol/Message/Parsing.hs b/lsp-types/src/Language/LSP/Protocol/Message/Parsing.hs new file mode 100644 index 000000000..c1e61900b --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Message/Parsing.hs @@ -0,0 +1,361 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeInType #-} + +module Language.LSP.Protocol.Message.Parsing where + +import Language.LSP.Protocol.Message.LspId +import Language.LSP.Protocol.Message.Types +import Language.LSP.Protocol.Message.Meta +import Language.LSP.Protocol.Message.Method +import Language.LSP.Protocol.Internal.Method + +import Data.Aeson +import Data.Aeson.Types +import Data.Function (on) +import Data.GADT.Compare +import Data.Kind +import Data.Proxy +import Data.Type.Equality +import GHC.TypeLits (sameSymbol) + +-- --------------------------------------------------------------------- +-- Working with arbitrary messages +-- --------------------------------------------------------------------- + +data FromServerMessage' a where + FromServerMess :: forall t (m :: Method ServerToClient t) a. SMethod m -> TMessage m -> FromServerMessage' a + FromServerRsp :: forall (m :: Method ClientToServer Request) a. a m -> TResponseMessage m -> FromServerMessage' a + +type FromServerMessage = FromServerMessage' SMethod + +instance Eq FromServerMessage where + (==) = (==) `on` toJSON +instance Show FromServerMessage where + show = show . toJSON + +instance ToJSON FromServerMessage where + toJSON (FromServerMess m p) = serverMethodJSON m (toJSON p) + toJSON (FromServerRsp m p) = clientResponseJSON m (toJSON p) + +fromServerNot :: forall (m :: Method ServerToClient Notification). + TMessage m ~ TNotificationMessage m => TNotificationMessage m -> FromServerMessage +fromServerNot m@TNotificationMessage{_method=meth} = FromServerMess meth m + +fromServerReq :: forall (m :: Method ServerToClient Request). + TMessage m ~ TRequestMessage m => TRequestMessage m -> FromServerMessage +fromServerReq m@TRequestMessage{_method=meth} = FromServerMess meth m + +data FromClientMessage' a where + FromClientMess :: forall t (m :: Method ClientToServer t) a . SMethod m -> TMessage m -> FromClientMessage' a + FromClientRsp :: forall (m :: Method ServerToClient Request) a . a m -> TResponseMessage m -> FromClientMessage' a + +type FromClientMessage = FromClientMessage' SMethod + +instance ToJSON FromClientMessage where + toJSON (FromClientMess m p) = clientMethodJSON m (toJSON p) + toJSON (FromClientRsp m p) = serverResponseJSON m (toJSON p) + +fromClientNot :: forall (m :: Method ClientToServer Notification). + TMessage m ~ TNotificationMessage m => TNotificationMessage m -> FromClientMessage +fromClientNot m@TNotificationMessage{_method=meth} = FromClientMess meth m + +fromClientReq :: forall (m :: Method ClientToServer Request). + TMessage m ~ TRequestMessage m => TRequestMessage m -> FromClientMessage +fromClientReq m@TRequestMessage{_method=meth} = FromClientMess meth m + +-- --------------------------------------------------------------------- +-- Parsing +-- --------------------------------------------------------------------- + +type LookupFunc f a = forall (m :: Method f Request). LspId m -> Maybe (SMethod m, a m) + +{- +Message Types we must handle are the following + +Request | jsonrpc | id | method | params? +Response | jsonrpc | id | | | response? | error? +Notification | jsonrpc | | method | params? +-} + +{-# INLINE parseServerMessage #-} +parseServerMessage :: LookupFunc ClientToServer a -> Value -> Parser (FromServerMessage' a) +parseServerMessage lookupId v@(Object o) = do + methMaybe <- o .:! "method" + idMaybe <- o .:! "id" + case methMaybe of + -- Request or Notification + Just (SomeServerMethod m) -> + case splitServerMethod m of + IsServerNot -> FromServerMess m <$> parseJSON v + IsServerReq -> FromServerMess m <$> parseJSON v + IsServerEither | SMethod_CustomMethod (p :: Proxy s') <- m -> do + case idMaybe of + -- Request + Just _ -> + let m' = (SMethod_CustomMethod p :: SMethod (Method_CustomMethod s' :: Method ServerToClient Request)) + in FromServerMess m' <$> parseJSON v + Nothing -> + let m' = (SMethod_CustomMethod p :: SMethod (Method_CustomMethod s' :: Method ServerToClient Notification)) + in FromServerMess m' <$> parseJSON v + Nothing -> do + case idMaybe of + Just i -> do + case lookupId i of + Just (m,res) -> clientResponseJSON m $ FromServerRsp res <$> parseJSON v + Nothing -> fail $ unwords ["Failed in looking up response type of", show v] + Nothing -> fail $ unwords ["Got unexpected message without method or id"] +parseServerMessage _ v = fail $ unwords ["parseServerMessage expected object, got:",show v] + +{-# INLINE parseClientMessage #-} +parseClientMessage :: LookupFunc ServerToClient a -> Value -> Parser (FromClientMessage' a) +parseClientMessage lookupId v@(Object o) = do + methMaybe <- o .:! "method" + idMaybe <- o .:! "id" + case methMaybe of + -- Request or Notification + Just (SomeClientMethod m) -> + case splitClientMethod m of + IsClientNot -> FromClientMess m <$> parseJSON v + IsClientReq -> FromClientMess m <$> parseJSON v + IsClientEither | SMethod_CustomMethod (p :: Proxy s') <- m -> do + case idMaybe of + -- Request + Just _ -> + let m' = (SMethod_CustomMethod p :: SMethod (Method_CustomMethod s' :: Method ClientToServer Request)) + in FromClientMess m' <$> parseJSON v + Nothing -> + let m' = (SMethod_CustomMethod p :: SMethod (Method_CustomMethod s' :: Method ClientToServer Notification)) + in FromClientMess m' <$> parseJSON v + Nothing -> do + case idMaybe of + Just i -> do + case lookupId i of + Just (m,res) -> serverResponseJSON m $ FromClientRsp res <$> parseJSON v + Nothing -> fail $ unwords ["Failed in looking up response type of", show v] + Nothing -> fail $ unwords ["Got unexpected message without method or id"] +parseClientMessage _ v = fail $ unwords ["parseClientMessage expected object, got:",show v] + +-- --------------------------------------------------------------------- +-- Helper Utilities +-- --------------------------------------------------------------------- + +{-# INLINE clientResponseJSON #-} +clientResponseJSON :: SClientMethod m -> (HasJSON (TResponseMessage m) => x) -> x +clientResponseJSON m x = case splitClientMethod m of + IsClientReq -> x + IsClientEither -> x + +{-# INLINE serverResponseJSON #-} +serverResponseJSON :: SServerMethod m -> (HasJSON (TResponseMessage m) => x) -> x +serverResponseJSON m x = case splitServerMethod m of + IsServerReq -> x + IsServerEither -> x + +{-# INLINE clientMethodJSON#-} +clientMethodJSON :: SClientMethod m -> (ToJSON (TClientMessage m) => x) -> x +clientMethodJSON m x = + case splitClientMethod m of + IsClientNot -> x + IsClientReq -> x + IsClientEither -> x + +{-# INLINE serverMethodJSON #-} +serverMethodJSON :: SServerMethod m -> (ToJSON (TServerMessage m) => x) -> x +serverMethodJSON m x = + case splitServerMethod m of + IsServerNot -> x + IsServerReq -> x + IsServerEither -> x + +type HasJSON a = (ToJSON a,FromJSON a,Eq a) + +-- Reify universal properties about Client/Server Messages + +type ClientNotOrReq :: forall t . Method ClientToServer t -> Type +data ClientNotOrReq m where + IsClientNot + :: ( HasJSON (TClientMessage m) + , TMessage m ~ TNotificationMessage m) + => ClientNotOrReq (m :: Method ClientToServer Notification) + IsClientReq + :: forall (m :: Method ClientToServer Request). + ( HasJSON (TClientMessage m) + , HasJSON (TResponseMessage m) + , TMessage m ~ TRequestMessage m) + => ClientNotOrReq m + IsClientEither + :: ClientNotOrReq (Method_CustomMethod s) + +type ServerNotOrReq :: forall t . Method ServerToClient t -> Type +data ServerNotOrReq m where + IsServerNot + :: ( HasJSON (TServerMessage m) + , TMessage m ~ TNotificationMessage m) + => ServerNotOrReq (m :: Method ServerToClient Notification) + IsServerReq + :: forall (m :: Method ServerToClient Request). + ( HasJSON (TServerMessage m) + , HasJSON (TResponseMessage m) + , TMessage m ~ TRequestMessage m) + => ServerNotOrReq m + IsServerEither + :: ServerNotOrReq (Method_CustomMethod s) + +{-# INLINE splitClientMethod #-} +splitClientMethod :: SClientMethod m -> ClientNotOrReq m +splitClientMethod = \case + SMethod_Initialize -> IsClientReq + SMethod_Initialized -> IsClientNot + SMethod_Shutdown -> IsClientReq + SMethod_Exit -> IsClientNot + SMethod_WorkspaceDidChangeWorkspaceFolders -> IsClientNot + SMethod_WorkspaceDidChangeConfiguration -> IsClientNot + SMethod_WorkspaceDidChangeWatchedFiles -> IsClientNot + SMethod_WorkspaceSymbol -> IsClientReq + SMethod_WorkspaceExecuteCommand -> IsClientReq + SMethod_WindowWorkDoneProgressCancel -> IsClientNot + SMethod_TextDocumentDidOpen -> IsClientNot + SMethod_TextDocumentDidChange -> IsClientNot + SMethod_TextDocumentWillSave -> IsClientNot + SMethod_TextDocumentWillSaveWaitUntil -> IsClientReq + SMethod_TextDocumentDidSave -> IsClientNot + SMethod_TextDocumentDidClose -> IsClientNot + SMethod_TextDocumentCompletion -> IsClientReq + SMethod_TextDocumentHover -> IsClientReq + SMethod_TextDocumentSignatureHelp -> IsClientReq + SMethod_TextDocumentDeclaration -> IsClientReq + SMethod_TextDocumentDefinition -> IsClientReq + SMethod_TextDocumentTypeDefinition -> IsClientReq + SMethod_TextDocumentImplementation -> IsClientReq + SMethod_TextDocumentReferences -> IsClientReq + SMethod_TextDocumentDocumentHighlight -> IsClientReq + SMethod_TextDocumentDocumentSymbol -> IsClientReq + SMethod_TextDocumentCodeAction -> IsClientReq + SMethod_TextDocumentCodeLens -> IsClientReq + SMethod_TextDocumentDocumentLink -> IsClientReq + SMethod_TextDocumentDocumentColor -> IsClientReq + SMethod_TextDocumentColorPresentation -> IsClientReq + SMethod_TextDocumentFormatting -> IsClientReq + SMethod_TextDocumentRangeFormatting -> IsClientReq + SMethod_TextDocumentOnTypeFormatting -> IsClientReq + SMethod_TextDocumentRename -> IsClientReq + SMethod_TextDocumentPrepareRename -> IsClientReq + SMethod_TextDocumentFoldingRange -> IsClientReq + SMethod_TextDocumentSelectionRange -> IsClientReq + SMethod_TextDocumentPrepareCallHierarchy -> IsClientReq + SMethod_TextDocumentLinkedEditingRange -> IsClientReq + SMethod_CallHierarchyIncomingCalls -> IsClientReq + SMethod_CallHierarchyOutgoingCalls -> IsClientReq + SMethod_TextDocumentSemanticTokensFull -> IsClientReq + SMethod_TextDocumentSemanticTokensFullDelta -> IsClientReq + SMethod_TextDocumentSemanticTokensRange -> IsClientReq + SMethod_WorkspaceWillCreateFiles -> IsClientReq + SMethod_WorkspaceWillDeleteFiles -> IsClientReq + SMethod_WorkspaceWillRenameFiles -> IsClientReq + SMethod_WorkspaceDidCreateFiles -> IsClientNot + SMethod_WorkspaceDidDeleteFiles -> IsClientNot + SMethod_WorkspaceDidRenameFiles -> IsClientNot + SMethod_TextDocumentMoniker -> IsClientReq + SMethod_TextDocumentPrepareTypeHierarchy -> IsClientReq + SMethod_TypeHierarchySubtypes -> IsClientReq + SMethod_TypeHierarchySupertypes -> IsClientReq + SMethod_TextDocumentInlineValue -> IsClientReq + SMethod_TextDocumentInlayHint -> IsClientReq + SMethod_TextDocumentDiagnostic -> IsClientReq + SMethod_WorkspaceDiagnostic -> IsClientReq + SMethod_CodeLensResolve -> IsClientReq + SMethod_InlayHintResolve -> IsClientReq + SMethod_CodeActionResolve -> IsClientReq + SMethod_DocumentLinkResolve -> IsClientReq + SMethod_CompletionItemResolve -> IsClientReq + SMethod_WorkspaceSymbolResolve -> IsClientReq + SMethod_NotebookDocumentDidChange -> IsClientNot + SMethod_NotebookDocumentDidClose -> IsClientNot + SMethod_NotebookDocumentDidOpen -> IsClientNot + SMethod_NotebookDocumentDidSave -> IsClientNot + SMethod_SetTrace -> IsClientNot + SMethod_Progress -> IsClientNot + SMethod_CancelRequest -> IsClientNot + (SMethod_CustomMethod _) -> IsClientEither + +{-# INLINE splitServerMethod #-} +splitServerMethod :: SServerMethod m -> ServerNotOrReq m +splitServerMethod = \case + SMethod_WindowShowMessage -> IsServerNot + SMethod_WindowShowMessageRequest -> IsServerReq + SMethod_WindowShowDocument -> IsServerReq + SMethod_WindowLogMessage -> IsServerNot + SMethod_WindowWorkDoneProgressCreate -> IsServerReq + SMethod_Progress -> IsServerNot + SMethod_TelemetryEvent -> IsServerNot + SMethod_ClientRegisterCapability -> IsServerReq + SMethod_ClientUnregisterCapability -> IsServerReq + SMethod_WorkspaceWorkspaceFolders -> IsServerReq + SMethod_WorkspaceConfiguration -> IsServerReq + SMethod_WorkspaceApplyEdit -> IsServerReq + SMethod_TextDocumentPublishDiagnostics -> IsServerNot + SMethod_LogTrace -> IsServerNot + SMethod_CancelRequest -> IsServerNot + SMethod_WorkspaceCodeLensRefresh -> IsServerReq + SMethod_WorkspaceSemanticTokensRefresh -> IsServerReq + SMethod_WorkspaceInlineValueRefresh -> IsServerReq + SMethod_WorkspaceInlayHintRefresh -> IsServerReq + SMethod_WorkspaceDiagnosticRefresh -> IsServerReq + (SMethod_CustomMethod _) -> IsServerEither + +-- | Given a witness that two custom methods are of the same type, produce a witness that the methods are the same +data CustomEq m1 m2 where + CustomEq + :: (m1 ~ (Method_CustomMethod s :: Method f t1), m2 ~ (Method_CustomMethod s :: Method f t2)) + => { runCustomEq :: (t1 ~ t2 => m1 :~~: m2) } + -> CustomEq m1 m2 + +runEq :: (t1 ~ t2) + => (SMethod m1 -> SMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))) + -> SMethod (m1 :: Method f t1) + -> SMethod (m2 :: Method f t2) + -> Maybe (m1 :~~: m2) +runEq f m1 m2 = do + res <- f m1 m2 + pure $ case res of + Right eq -> eq + Left ceq -> runCustomEq ceq + +-- | Heterogeneous equality on singleton server methods +mEqServer :: SServerMethod m1 -> SServerMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2)) +mEqServer m1 m2 = go (splitServerMethod m1) (splitServerMethod m2) + where + go IsServerNot IsServerNot = do + Refl <- geq m1 m2 + pure $ Right HRefl + go IsServerReq IsServerReq = do + Refl <- geq m1 m2 + pure $ Right HRefl + go IsServerEither IsServerEither + | SMethod_CustomMethod p1 <- m1 + , SMethod_CustomMethod p2 <- m2 + = case sameSymbol p1 p2 of + Just Refl -> Just $ Left $ CustomEq HRefl + _ -> Nothing + go _ _ = Nothing + +-- | Heterogeneous equality on singleton client methods +mEqClient :: SClientMethod m1 -> SClientMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2)) +mEqClient m1 m2 = go (splitClientMethod m1) (splitClientMethod m2) + where + go IsClientNot IsClientNot = do + Refl <- geq m1 m2 + pure $ Right HRefl + go IsClientReq IsClientReq = do + Refl <- geq m1 m2 + pure $ Right HRefl + go IsClientEither IsClientEither + | SMethod_CustomMethod p1 <- m1 + , SMethod_CustomMethod p2 <- m2 + = case sameSymbol p1 p2 of + Just Refl -> Just $ Left $ CustomEq HRefl + _ -> Nothing + go _ _ = Nothing diff --git a/lsp-types/src/Language/LSP/Protocol/Message/Registration.hs b/lsp-types/src/Language/LSP/Protocol/Message/Registration.hs new file mode 100644 index 000000000..0487bf7d8 --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Message/Registration.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeInType #-} + +module Language.LSP.Protocol.Message.Registration where + +import Language.LSP.Protocol.Types +import Language.LSP.Protocol.Internal.Method +import Language.LSP.Protocol.Message.Meta +import Language.LSP.Protocol.Message.Method +import Language.LSP.Protocol.Utils.Misc + +import Control.Lens.TH +import Data.Aeson +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics + +-- | Typed registration type, with correct options. +data TRegistration (m :: Method ClientToServer t) = + TRegistration + { -- | 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 :: SClientMethod m + -- | Options necessary for the registration. + -- Make this strict to aid the pattern matching exhaustiveness checker + , _registerOptions :: !(Maybe (RegistrationOptions m)) + } + deriving stock Generic + +deriving stock instance Eq (RegistrationOptions m) => Eq (TRegistration m) +deriving stock instance Show (RegistrationOptions m) => Show (TRegistration m) + +-- TODO: can we do this generically somehow? +-- This generates the function +-- regHelper :: SMethod m +-- -> (( Show (RegistrationOptions m) +-- , ToJSON (RegistrationOptions m) +-- , FromJSON ($regOptTcon m) +-- => x) +-- -> x +makeRegHelper ''RegistrationOptions + +instance ToJSON (TRegistration m) where + toJSON x@(TRegistration _ m _) = regHelper m (genericToJSON lspOptions x) + +data SomeRegistration = forall t (m :: Method ClientToServer t). SomeRegistration (TRegistration m) + +instance ToJSON SomeRegistration where + toJSON (SomeRegistration r) = toJSON r + +instance FromJSON SomeRegistration where + parseJSON = withObject "Registration" $ \o -> do + SomeClientMethod m <- o .: "method" + r <- TRegistration <$> o .: "id" <*> pure m <*> regHelper m (o .: "registerOptions") + pure (SomeRegistration r) + +instance Show SomeRegistration where + show (SomeRegistration r@(TRegistration _ m _)) = regHelper m (show r) + +toUntypedRegistration :: TRegistration m -> Registration +toUntypedRegistration (TRegistration i meth opts) = Registration i (T.pack $ someMethodToMethodString $ SomeMethod meth) (Just $ regHelper meth (toJSON opts)) + +toSomeRegistration :: Registration -> Maybe SomeRegistration +toSomeRegistration r = + let v = toJSON r + in case fromJSON v of + Success r' -> Just r' + _ -> Nothing + +-- --------------------------------------------------------------------- + +-- | Typed unregistration type. +data TUnregistration (m :: Method ClientToServer t) = + TUnregistration + { -- | 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 :: SMethod m + } deriving stock Generic + +deriving stock instance Eq (TUnregistration m) +deriving stock instance Show (TUnregistration m) + +instance ToJSON (TUnregistration m) where + toJSON x@(TUnregistration _ m) = regHelper m (genericToJSON lspOptions x) + +data SomeUnregistration = forall t (m :: Method ClientToServer t). SomeUnregistration (TUnregistration m) + +instance ToJSON SomeUnregistration where + toJSON (SomeUnregistration r) = toJSON r + +instance FromJSON SomeUnregistration where + parseJSON = withObject "Unregistration" $ \o -> do + SomeClientMethod m <- o .: "method" + r <- TUnregistration <$> o .: "id" <*> pure m + pure (SomeUnregistration r) + +toUntypedUnregistration :: TUnregistration m -> Unregistration +toUntypedUnregistration (TUnregistration i meth) = Unregistration i (T.pack $ someMethodToMethodString $ SomeMethod meth) + +toSomeUnregistration :: Unregistration -> Maybe SomeUnregistration +toSomeUnregistration r = + let v = toJSON r + in case fromJSON v of + Success r' -> Just r' + _ -> Nothing + +makeFieldsNoPrefix ''TRegistration +makeFieldsNoPrefix ''TUnregistration diff --git a/lsp-types/src/Language/LSP/Protocol/Message/Types.hs b/lsp-types/src/Language/LSP/Protocol/Message/Types.hs new file mode 100644 index 000000000..418e3b48e --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Message/Types.hs @@ -0,0 +1,213 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeInType #-} + +module Language.LSP.Protocol.Message.Types where + +import Language.LSP.Protocol.Types.Common +import Language.LSP.Protocol.Internal.Lens +import Language.LSP.Protocol.Internal.Method +import Language.LSP.Protocol.Types +import Language.LSP.Protocol.Message.LspId +import Language.LSP.Protocol.Message.Meta +import Language.LSP.Protocol.Message.Method () +import Language.LSP.Protocol.Utils.Misc + +import Control.Lens.TH +import Data.Aeson hiding (Null) +import qualified Data.Aeson as J +import Data.Aeson.TH +import Data.Kind +import Data.String (IsString (..)) +import Data.Text (Text) +import GHC.Generics +import GHC.TypeLits (KnownSymbol) + +-- 'RequestMessage', 'ResponseMessage', 'ResponseError', and 'NotificationMessage' +-- aren't present in the metamodel, although they should be. +-- https://github.com/microsoft/vscode-languageserver-node/issues/1079 + +-- | Notification message type as defined in the spec. +data NotificationMessage = + NotificationMessage + { _jsonrpc :: Text + , _method :: Text + , _params :: Maybe Value + } deriving stock (Show, Eq, Generic) + +deriveJSON lspOptions ''NotificationMessage + +-- This isn't present in the metamodel. +-- | Request message type as defined in the spec. +data RequestMessage = RequestMessage + { _jsonrpc :: Text + , _id :: Int32 |? Text + , _method :: Text + , _params :: Maybe Value + } deriving stock (Show, Eq, Generic) + +deriveJSON lspOptions ''RequestMessage + +-- | Response error type as defined in the spec. +data ResponseError = + ResponseError + { _code :: ErrorCodes + , _message :: Text + , _xdata :: Maybe Value + } deriving stock (Show, Eq, Generic) + +deriveJSON lspOptions ''ResponseError + +-- | Response message type as defined in the spec. +data ResponseMessage = + ResponseMessage + { _jsonrpc :: Text + , _id :: Int32 |? Text |? Null + , _result :: Maybe Value + , _error :: Maybe ResponseError + } deriving stock (Show, Eq, Generic) + +deriveJSON lspOptions ''ResponseMessage + +----- +-- | Typed notification message, containing the correct parameter payload. +data TNotificationMessage (m :: Method f Notification) = + TNotificationMessage + { _jsonrpc :: Text + , _method :: SMethod m + , _params :: MessageParams m + } deriving stock Generic + +deriving stock instance Eq (MessageParams m) => Eq (TNotificationMessage m) +deriving stock instance Show (MessageParams m) => Show (TNotificationMessage m) + +instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (TNotificationMessage m) where + parseJSON = genericParseJSON lspOptions +instance (ToJSON (MessageParams m)) => ToJSON (TNotificationMessage m) where + toJSON = genericToJSON lspOptions + toEncoding = genericToEncoding lspOptions + +-- | Typed request message, containing the correct parameter payload. +data TRequestMessage (m :: Method f Request) = TRequestMessage + { _jsonrpc :: Text + , _id :: LspId m + , _method :: SMethod m + , _params :: MessageParams m + } deriving stock Generic + +deriving stock instance Eq (MessageParams m) => Eq (TRequestMessage m) +deriving stock instance Show (MessageParams m) => Show (TRequestMessage m) + +instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (TRequestMessage m) where + parseJSON = genericParseJSON lspOptions . addNullField "params" +instance (ToJSON (MessageParams m)) => ToJSON (TRequestMessage m) where + toJSON = genericToJSON lspOptions + toEncoding = genericToEncoding lspOptions + +data TResponseError (m :: Method f Request) = + TResponseError + { _code :: ErrorCodes + , _message :: Text + , _xdata :: Maybe (ErrorData m) + } deriving stock Generic + +deriving stock instance Eq (ErrorData m) => Eq (TResponseError m) +deriving stock instance Show (ErrorData m) => Show (TResponseError m) + +instance (FromJSON (ErrorData m)) => FromJSON (TResponseError m) where + parseJSON = genericParseJSON lspOptions +instance (ToJSON (ErrorData m)) => ToJSON (TResponseError m) where + toJSON = genericToJSON lspOptions + toEncoding = genericToEncoding lspOptions + +-- TODO: similar functions for the others? +toUntypedResponseError :: (ToJSON (ErrorData m)) => TResponseError m -> ResponseError +toUntypedResponseError (TResponseError c m d) = ResponseError c m (fmap toJSON d) + +-- | A typed response message with a correct result payload. +data TResponseMessage (m :: Method f Request) = + TResponseMessage + { _jsonrpc :: Text + , _id :: Maybe (LspId m) + , _result :: Either (TResponseError m) (MessageResult m) + } deriving stock Generic + +deriving stock instance (Eq (MessageResult m), Eq (ErrorData m)) => Eq (TResponseMessage m) +deriving stock instance (Show (MessageResult m), Show (ErrorData m)) => Show (TResponseMessage m) + +instance (ToJSON (MessageResult m), ToJSON (ErrorData m)) => ToJSON (TResponseMessage m) where + toJSON TResponseMessage { _jsonrpc = jsonrpc, _id = lspid, _result = result } + = object + [ "jsonrpc" .= jsonrpc + , "id" .= lspid + , case result of + Left err -> "error" .= err + Right a -> "result" .= a + ] + +instance (FromJSON (MessageResult a), FromJSON (ErrorData a)) => FromJSON (TResponseMessage a) where + parseJSON = withObject "Response" $ \o -> do + _jsonrpc <- o .: "jsonrpc" + _id <- o .: "id" + -- It is important to use .:! so that "result = null" (without error) gets decoded as Just Null + _result <- o .:! "result" + _error <- o .:? "error" + result <- case (_error, _result) of + (Just err, Nothing) -> pure $ Left err + (Nothing, Just res) -> pure $ Right res + (Just _err, Just _res) -> fail $ "both error and result cannot be present: " ++ show o + (Nothing, Nothing) -> fail "both error and result cannot be Nothing" + return $ TResponseMessage _jsonrpc _id result + +-- | A typed custom message. A special data type is needed to distinguish between +-- notifications and requests, since a CustomMethod can be both! +data TCustomMessage s f t where + ReqMess :: TRequestMessage (Method_CustomMethod s :: Method f Request) -> TCustomMessage s f Request + NotMess :: TNotificationMessage (Method_CustomMethod s :: Method f Notification) -> TCustomMessage s f Notification + +deriving stock instance Show (TCustomMessage s f t) + +instance ToJSON (TCustomMessage s f t) where + toJSON (ReqMess a) = toJSON a + toJSON (NotMess a) = toJSON a + +instance KnownSymbol s => FromJSON (TCustomMessage s f Request) where + parseJSON v = ReqMess <$> parseJSON v +instance KnownSymbol s => FromJSON (TCustomMessage s f Notification) where + parseJSON v = NotMess <$> parseJSON v + + +-- --------------------------------------------------------------------- +-- Helper Type Families +-- --------------------------------------------------------------------- + +-- | Map a method to the Request/Notification type with the correct +-- payload. +type TMessage :: forall f t . Method f t -> Type +type family TMessage m where + TMessage (Method_CustomMethod s :: Method f t) = TCustomMessage s f t + TMessage (m :: Method f Request) = TRequestMessage m + TMessage (m :: Method f Notification) = TNotificationMessage m + +-- Some helpful type synonyms +type TClientMessage (m :: Method ClientToServer t) = TMessage m +type TServerMessage (m :: Method ServerToClient t) = TMessage m + +-- | Replace a missing field in an object with a null field, to simplify parsing +-- This is a hack to allow other types than Maybe to work like Maybe in allowing the field to be missing. +-- See also this issue: https://github.com/haskell/aeson/issues/646 +addNullField :: String -> Value -> Value +addNullField s (Object o) = Object $ o <> fromString s .= J.Null +addNullField _ v = v + +makeFieldsNoPrefix ''RequestMessage +makeFieldsNoPrefix ''ResponseMessage +makeFieldsNoPrefix ''NotificationMessage +makeFieldsNoPrefix ''ResponseError +makeFieldsNoPrefix ''TRequestMessage +makeFieldsNoPrefix ''TResponseMessage +makeFieldsNoPrefix ''TNotificationMessage +makeFieldsNoPrefix ''TResponseError diff --git a/lsp-types/src/Language/LSP/Protocol/Types.hs b/lsp-types/src/Language/LSP/Protocol/Types.hs new file mode 100644 index 000000000..a9a11bba7 --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Types.hs @@ -0,0 +1,40 @@ +-- The OSPath import sometimes looks unused +{-# OPTIONS_GHC -Wno-unused-imports #-} +module Language.LSP.Protocol.Types ( + -- * Basic types and functions + module Common + -- ** URIs + , module Uri + -- ** Locations + , module Locations + -- ** LSP enumerations + , module LspEnum + -- ** Singleton types + , module Singletons + -- * Helpers for working with LSP types + -- ** Edits + , module Edits + -- ** Markup + , module Markup + -- ** Progress + , module Progress + -- ** Semantic tokens + , module SemanticTokens + -- * Main LSP types and functions + , module Generated + -- * Generated lens classes + , module Lens + ) where + +import Language.LSP.Protocol.Internal.Types as Generated +import Language.LSP.Protocol.Internal.Lens as Lens +import Language.LSP.Protocol.Types.Common as Common +import Language.LSP.Protocol.Types.Location as Locations +import Language.LSP.Protocol.Types.LspEnum as LspEnum +import Language.LSP.Protocol.Types.MarkupContent as Markup +import Language.LSP.Protocol.Types.Progress as Progress +import Language.LSP.Protocol.Types.SemanticTokens as SemanticTokens +import Language.LSP.Protocol.Types.Singletons as Singletons +import Language.LSP.Protocol.Types.Uri as Uri +import Language.LSP.Protocol.Types.Uri.OsPath as Uri +import Language.LSP.Protocol.Types.Edit as Edits diff --git a/lsp-types/src/Language/LSP/Protocol/Types/Common.hs b/lsp-types/src/Language/LSP/Protocol/Types/Common.hs new file mode 100644 index 000000000..700e13047 --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Types/Common.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeOperators #-} + +-- | Common types that aren't in the specification +module Language.LSP.Protocol.Types.Common ( + type (|?) (..) + , toEither + , _L + , _R + , Int32 + , UInt + , Null (..) + , absorbNull + , nullToMaybe + , (.=?) +) where + +import Control.Applicative +import Control.DeepSeq +import Control.Lens +import Data.Aeson hiding (Null) +import qualified Data.Aeson as J +import Data.Hashable +import Data.Int (Int32) +import Data.Mod.Word +import GHC.Generics hiding (UInt) +import GHC.TypeNats hiding (Mod) +import Text.Read (Read (readPrec)) + +-- | The "uinteger" type in the LSP spec. +-- +-- Unusually, this is a **31**-bit unsigned integer, not a 32-bit one. +newtype UInt = UInt (Mod (2^31)) + deriving newtype (Num, Bounded, Enum, Eq, Ord) + deriving stock (Generic) + deriving anyclass (NFData) + +instance Hashable UInt where hashWithSalt s (UInt n) = hashWithSalt s (unMod n) + +instance Show UInt where + show (UInt u) = show $ unMod u + +instance Read UInt where + readPrec = fromInteger <$> readPrec + +instance Real UInt where + toRational (UInt u) = toRational $ unMod u + +instance Integral UInt where + quotRem (UInt x) (UInt y) = bimap fromIntegral fromIntegral $ quotRem (unMod x) (unMod y) + toInteger (UInt u) = toInteger $ unMod u + +instance ToJSON UInt where + toJSON u = toJSON (toInteger u) + +instance FromJSON UInt where + parseJSON v = fromInteger <$> parseJSON v + +-- | An alternative type (isomorphic to 'Either'), but which +-- is encoded into JSON without a tag for the alternative. +-- +-- This corresponds to @a | b@ types in the LSP specification. +data a |? b = InL a + | InR b + deriving stock (Read,Show,Eq,Ord,Generic) +infixr |? + +-- | Prism for the left-hand side of an '(|?)'. +_L :: Prism' (a |? b) a +_L = prism' InL $ \case + InL a -> Just a + InR _ -> Nothing + +-- | Prism for the right-hand side of an '(|?)'. +_R :: Prism' (a |? b) b +_R = prism' InR $ \case + InL _ -> Nothing + InR b -> Just b + +toEither :: a |? b -> Either a b +toEither (InL a) = Left a +toEither (InR b) = Right b + +instance (ToJSON a, ToJSON b) => ToJSON (a |? b) where + toJSON (InL x) = toJSON x + toJSON (InR x) = toJSON x + +instance (FromJSON a, FromJSON b) => FromJSON (a |? b) where + -- Important: Try to parse the **rightmost** type first, as in the specification + -- the more complex types tend to appear on the right of the |, e.g. + -- @colorProvider?: boolean | DocumentColorOptions | DocumentColorRegistrationOptions;@ + parseJSON v = InR <$> parseJSON v <|> InL <$> parseJSON v + +instance (NFData a, NFData b) => NFData (a |? b) + +-- We could use 'Proxy' for this, as aeson also serializes it to/from null, +-- but this is more explicit. +-- | A type for that is precisely null and nothing else. +-- +-- This is useful since the LSP specification often includes types like @a | null@ +-- as distinct from an optional value of type @a@. +data Null = Null deriving stock (Eq,Ord,Show) + +instance ToJSON Null where + toJSON Null = J.Null +instance FromJSON Null where + parseJSON J.Null = pure Null + parseJSON _ = fail "expected 'null'" + +absorbNull :: Monoid a => a |? Null -> a +absorbNull (InL a) = a +absorbNull (InR _) = mempty + +nullToMaybe :: a |? Null -> Maybe a +nullToMaybe (InL a) = Just a +nullToMaybe (InR _) = Nothing + +-- | Include a value in an JSON object optionally, omitting it if it is 'Nothing'. +(.=?) :: (J.KeyValue kv, J.ToJSON v) => J.Key -> Maybe v -> [kv] +k .=? v = case v of + Just v' -> [k J..= v'] + Nothing -> mempty diff --git a/lsp-types/src/Language/LSP/Protocol/Types/Edit.hs b/lsp-types/src/Language/LSP/Protocol/Types/Edit.hs new file mode 100644 index 000000000..d69a55a15 --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Types/Edit.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Language.LSP.Protocol.Types.Edit where + +import Data.Text (Text) +import qualified Data.Text as T + +import Control.Lens hiding (index) +import Language.LSP.Protocol.Types.Common +import Language.LSP.Protocol.Internal.Types + +-- | Convenience alias for the type in the 'WorkspaceEdit._documentChanges' field. +type DocumentChange = TextDocumentEdit |? CreateFile |? RenameFile |? DeleteFile + +-- TODO: get rid of this in favour of the more correct things in VFS +-- | Applies a 'TextEdit' to some 'Text'. +-- +-- >>> applyTextEdit (TextEdit (Range (Position 0 1) (Position 0 2)) "i") "foo" +-- "fio" +applyTextEdit :: TextEdit -> Text -> Text +applyTextEdit (TextEdit (Range sp ep) newText) oldText = + let (_, afterEnd) = splitAtPos ep oldText + (beforeStart, _) = splitAtPos sp oldText + in mconcat [beforeStart, newText, afterEnd] + where + splitAtPos :: Position -> Text -> (Text, Text) + splitAtPos (Position sl sc) t = + -- If we are looking for a line beyond the end of the text, this will give us an index + -- past the end. Fortunately, T.splitAt is fine with this, and just gives us the whole + -- string and an empty string, which is what we want. + let index = sc + startLineIndex sl t + in T.splitAt (fromIntegral index) t + + -- The index of the first character of line 'line' + startLineIndex :: UInt -> Text -> UInt + startLineIndex 0 _ = 0 + startLineIndex line t' = + case T.findIndex (== '\n') t' of + Just i -> fromIntegral i + 1 + startLineIndex (line - 1) (T.drop (i + 1) t') + -- i != 0, and there are no newlines, so this is a line beyond the end of the text. + -- In this case give the "start index" as the end, so we will at least append the text. + Nothing -> fromIntegral $ T.length t' + +-- | 'editTextEdit' @outer@ @inner@ applies @inner@ to the text inside @outer@. +editTextEdit :: TextEdit -> TextEdit -> TextEdit +editTextEdit (TextEdit origRange origText) innerEdit = + let newText = applyTextEdit innerEdit origText + in TextEdit origRange newText + +-- | Conversion between 'OptionalVersionedTextDocumentIdentifier' and 'VersionedTextDocumentIdentifier'. +_versionedTextDocumentIdentifier :: Prism' OptionalVersionedTextDocumentIdentifier VersionedTextDocumentIdentifier +_versionedTextDocumentIdentifier = prism down up + where + down (VersionedTextDocumentIdentifier uri v) = OptionalVersionedTextDocumentIdentifier uri (InL v) + up (OptionalVersionedTextDocumentIdentifier uri (InL v)) = Right $ VersionedTextDocumentIdentifier uri v + up i@(OptionalVersionedTextDocumentIdentifier _ (InR _)) = Left i diff --git a/lsp-types/src/Language/LSP/Protocol/Types/Location.hs b/lsp-types/src/Language/LSP/Protocol/Types/Location.hs new file mode 100644 index 000000000..2b61a2f26 --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Types/Location.hs @@ -0,0 +1,19 @@ +-- | Additional and utilities for 'Position' and 'Range'. +module Language.LSP.Protocol.Types.Location where + +import Language.LSP.Protocol.Types.Common +import Language.LSP.Protocol.Internal.Types.Position +import Language.LSP.Protocol.Internal.Types.Range + +-- | A helper function for creating ranges. +-- prop> mkRange l c l' c' = Range (Position l c) (Position l' c') +mkRange :: UInt -> UInt -> UInt -> UInt -> Range +mkRange l c l' c' = Range (Position l c) (Position l' c') + +-- | 'isSubrangeOf' returns true if for every 'Position' in the first 'Range', it's also in the second 'Range'. +isSubrangeOf :: Range -> Range -> Bool +isSubrangeOf smallRange range = _start smallRange >= _start range && _end smallRange <= _end range + +-- | 'positionInRange' returns true if the given 'Position' is in the 'Range'. +positionInRange :: Position -> Range -> Bool +positionInRange p (Range sp ep) = sp <= p && p < ep -- Range's end position is exclusive. diff --git a/lsp-types/src/Language/LSP/Protocol/Types/LspEnum.hs b/lsp-types/src/Language/LSP/Protocol/Types/LspEnum.hs new file mode 100644 index 000000000..bc34fcde3 --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Types/LspEnum.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE TypeFamilies #-} +module Language.LSP.Protocol.Types.LspEnum where + +import qualified Data.Aeson as Aeson +import Data.Kind +import qualified Data.Set as Set +import Data.String (IsString (..)) +import qualified Data.Text as Text + +-- | A class for types that represent a LSP enum type. +-- +-- This class carries conversion functions to and from the 'base type' of the enum. +-- Not all base type values may have corresponding enum values. +class LspEnum a where + -- | The base type of the enum. + type EnumBaseType a :: Type + + -- | The known values of this type, the ones listed in the LSP specification. + knownValues :: Set.Set a + knownValues = Set.empty + + -- | Convert an enum value to the base type. + toEnumBaseType :: a -> EnumBaseType a + + -- | Convert a base type value to an enum value, failing if it does not correspond to + -- an enum value. + fromEnumBaseType :: EnumBaseType a -> Maybe a + default fromEnumBaseType :: (LspOpenEnum a) => EnumBaseType a -> Maybe a + fromEnumBaseType = Just . fromOpenEnumBaseType + +-- | A class for types that represent a LSP open enum type. +-- +-- Open enum types allow any base type value to be used as a 'custom' enum value. +class LspEnum a => LspOpenEnum a where + -- | Convert a base type to an enum value. All base type values can be converted this way. + fromOpenEnumBaseType :: EnumBaseType a -> a + +-- | Newtype for @deriving via@ to get standard JSON and 'IsString' instances in terms of the 'LspEnum' +-- class methods. +newtype AsLspEnum a b = AsLspEnum a + +instance (LspEnum a, EnumBaseType a ~ b, Aeson.ToJSON b) => Aeson.ToJSON (AsLspEnum a b) where + toJSON (AsLspEnum e) = Aeson.toJSON (toEnumBaseType e) + +instance (LspEnum a, EnumBaseType a ~ b, Aeson.FromJSON b, Show b) => Aeson.FromJSON (AsLspEnum a b) where + parseJSON val = do + v <- Aeson.parseJSON val + case fromEnumBaseType v of + Just x -> pure $ AsLspEnum x + Nothing -> fail $ "unrecognized enum value " ++ show v + +instance (LspOpenEnum a, EnumBaseType a ~ b, b ~ Text.Text) => IsString (AsLspEnum a b) where + fromString s = AsLspEnum $ fromOpenEnumBaseType (Text.pack s) diff --git a/lsp-types/src/Language/LSP/Protocol/Types/MarkupContent.hs b/lsp-types/src/Language/LSP/Protocol/Types/MarkupContent.hs new file mode 100644 index 000000000..c88cc95be --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Types/MarkupContent.hs @@ -0,0 +1,45 @@ +{-# OPTIONS_GHC -Wno-orphans #-} +-- | Additional instances and utilities for 'MarkupContent'. +module Language.LSP.Protocol.Types.MarkupContent where + +import Data.String +import Data.Text (Text) +import qualified Data.Text as T +import Language.LSP.Protocol.Internal.Types.MarkupContent +import Language.LSP.Protocol.Internal.Types.MarkupKind + +-- | Create a 'MarkupContent' containing plain text. +mkPlainText :: Text -> MarkupContent +mkPlainText = MarkupContent MarkupKind_PlainText + +-- | Create a 'MarkupContent' containing markdown. +mkMarkdown :: Text -> MarkupContent +mkMarkdown = MarkupContent MarkupKind_Markdown + +-- | Create a 'MarkupContent' containing a language-annotated code block only. +mkMarkdownCodeBlock :: Text -> Text -> MarkupContent +mkMarkdownCodeBlock lang quote + = MarkupContent MarkupKind_Markdown ("\n```" <> lang <> "\n" <> quote <> "\n```\n") + +-- | Markdown for a section separator in Markdown, being a horizontal line. +sectionSeparator :: Text +sectionSeparator = "* * *\n" + +-- | Given some plaintext, convert it into some equivalent markdown text. +-- This is not *quite* the identity function. +plainTextToMarkdown :: Text -> Text +-- Line breaks in markdown paragraphs are ignored unless the line ends with two spaces. +-- In order to respect the line breaks in the original plaintext, we stick two spaces on the end of every line. +plainTextToMarkdown = T.unlines . fmap (<> " ") . T.lines + +instance Semigroup MarkupContent where + MarkupContent MarkupKind_PlainText s1 <> MarkupContent MarkupKind_PlainText s2 = MarkupContent MarkupKind_PlainText (s1 `mappend` s2) + MarkupContent MarkupKind_Markdown s1 <> MarkupContent MarkupKind_Markdown s2 = MarkupContent MarkupKind_Markdown (s1 `mappend` s2) + MarkupContent MarkupKind_PlainText s1 <> MarkupContent MarkupKind_Markdown s2 = MarkupContent MarkupKind_Markdown (plainTextToMarkdown s1 `mappend` s2) + MarkupContent MarkupKind_Markdown s1 <> MarkupContent MarkupKind_PlainText s2 = MarkupContent MarkupKind_Markdown (s1 `mappend` plainTextToMarkdown s2) + +instance Monoid MarkupContent where + mempty = MarkupContent MarkupKind_PlainText "" + +instance IsString MarkupContent where + fromString = mkPlainText . T.pack diff --git a/lsp-types/src/Language/LSP/Protocol/Types/Progress.hs b/lsp-types/src/Language/LSP/Protocol/Types/Progress.hs new file mode 100644 index 000000000..1efb8da14 --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Types/Progress.hs @@ -0,0 +1,31 @@ +module Language.LSP.Protocol.Types.Progress + ( _workDoneProgressBegin + , _workDoneProgressEnd + , _workDoneProgressReport + ) + where + +import Control.Lens +import Data.Aeson + +import Language.LSP.Protocol.Internal.Types.WorkDoneProgressBegin +import Language.LSP.Protocol.Internal.Types.WorkDoneProgressEnd +import Language.LSP.Protocol.Internal.Types.WorkDoneProgressReport + +-- From lens-aeson +_JSON :: (ToJSON a, FromJSON a) => Prism' Value a +_JSON = prism toJSON $ \x -> case fromJSON x of + Success y -> Right y; + _ -> Left x + +-- | Prism for extracting the 'WorkDoneProgressBegin' case from the unstructured 'value' field of 'ProgressParams'. +_workDoneProgressBegin :: Prism' Value WorkDoneProgressBegin +_workDoneProgressBegin = _JSON + +-- | Prism for extracting the 'WorkDoneProgressEnd' case from the unstructured 'value' field of 'ProgressParams'. +_workDoneProgressEnd :: Prism' Value WorkDoneProgressEnd +_workDoneProgressEnd = _JSON + +-- | Prism for extracting the 'WorkDoneProgressReport' case from the unstructured 'value' field of 'ProgressParams'. +_workDoneProgressReport :: Prism' Value WorkDoneProgressReport +_workDoneProgressReport = _JSON diff --git a/lsp-types/src/Language/LSP/Protocol/Types/SemanticTokens.hs b/lsp-types/src/Language/LSP/Protocol/Types/SemanticTokens.hs new file mode 100644 index 000000000..e69695461 --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Types/SemanticTokens.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Language.LSP.Protocol.Types.SemanticTokens where + +import Data.Text (Text) + +import Control.Monad.Except + +import Language.LSP.Protocol.Types.Common +import Language.LSP.Protocol.Internal.Types.SemanticTokenModifiers +import Language.LSP.Protocol.Internal.Types.SemanticTokens +import Language.LSP.Protocol.Internal.Types.SemanticTokensDelta +import Language.LSP.Protocol.Internal.Types.SemanticTokensEdit +import Language.LSP.Protocol.Internal.Types.SemanticTokensLegend +import Language.LSP.Protocol.Internal.Types.SemanticTokenTypes +import Language.LSP.Protocol.Types.LspEnum + +import qualified Data.Algorithm.Diff as Diff +import qualified Data.Bits as Bits +import qualified Data.DList as DList +import Data.Foldable hiding + (length) +import qualified Data.Map as Map +import Data.Maybe (fromMaybe, + maybeToList) +import Data.String + +defaultSemanticTokensLegend :: SemanticTokensLegend +defaultSemanticTokensLegend = SemanticTokensLegend + (fmap toEnumBaseType . toList $ knownValues @SemanticTokenTypes) + (fmap toEnumBaseType . toList $ knownValues @SemanticTokenModifiers) + +---------------------------------------------------------- +-- Tools for working with semantic tokens. +---------------------------------------------------------- + +-- | A single 'semantic token' as described in the LSP specification, using absolute positions. +-- This is the kind of token that is usually easiest for editors to produce. +data SemanticTokenAbsolute = SemanticTokenAbsolute { + line :: UInt, + startChar :: UInt, + length :: UInt, + tokenType :: SemanticTokenTypes, + tokenModifiers :: [SemanticTokenModifiers] +} deriving stock (Show, Eq, Ord) +-- Note: we want the Ord instance to sort the tokens textually: this is achieved due to the +-- order of the constructors + +-- | A single 'semantic token' as described in the LSP specification, using relative positions. +data SemanticTokenRelative = SemanticTokenRelative { + deltaLine :: UInt, + deltaStartChar :: UInt, + length :: UInt, + tokenType :: SemanticTokenTypes, + tokenModifiers :: [SemanticTokenModifiers] +} deriving stock (Show, Eq, Ord) +-- Note: we want the Ord instance to sort the tokens textually: this is achieved due to the +-- order of the constructors + +-- | Turn a list of absolutely-positioned tokens into a list of relatively-positioned tokens. The tokens are assumed to be in the +-- order that they appear in the document! +relativizeTokens :: [SemanticTokenAbsolute] -> [SemanticTokenRelative] +relativizeTokens xs = DList.toList $ go 0 0 xs mempty + where + -- Pass an accumulator to make this tail-recursive + go :: UInt -> UInt -> [SemanticTokenAbsolute] -> DList.DList SemanticTokenRelative -> DList.DList SemanticTokenRelative + go _ _ [] acc = acc + go lastLine lastChar (SemanticTokenAbsolute l c len ty mods:ts) acc = + let + lastCharInLine = if l == lastLine then lastChar else 0 + dl = l - lastLine + dc = c - lastCharInLine + in go l c ts (DList.snoc acc (SemanticTokenRelative dl dc len ty mods)) + +-- | Turn a list of relatively-positioned tokens into a list of absolutely-positioned tokens. The tokens are assumed to be in the +-- order that they appear in the document! +absolutizeTokens :: [SemanticTokenRelative] -> [SemanticTokenAbsolute] +absolutizeTokens xs = DList.toList $ go 0 0 xs mempty + where + -- Pass an accumulator to make this tail-recursive + go :: UInt -> UInt -> [SemanticTokenRelative] -> DList.DList SemanticTokenAbsolute -> DList.DList SemanticTokenAbsolute + go _ _ [] acc = acc + go lastLine lastChar (SemanticTokenRelative dl dc len ty mods:ts) acc = + let + lastCharInLine = if dl == 0 then lastChar else 0 + l = lastLine + dl + c = lastCharInLine + dc + in go l c ts (DList.snoc acc (SemanticTokenAbsolute l c len ty mods)) + +-- | Encode a series of relatively-positioned semantic tokens into an integer array following the given legend. +encodeTokens :: SemanticTokensLegend -> [SemanticTokenRelative] -> Either Text [UInt] +encodeTokens SemanticTokensLegend{_tokenTypes=tts,_tokenModifiers=tms} sts = + DList.toList . DList.concat <$> traverse encodeToken sts + where + -- Note that there's no "fast" version of these (e.g. backed by an IntMap or similar) + -- in general, due to the possibility of unknown token types which are only identified by strings. + tyMap :: Map.Map SemanticTokenTypes UInt + tyMap = Map.fromList $ zip (fmap fromOpenEnumBaseType tts) [0..] + modMap :: Map.Map SemanticTokenModifiers Int + modMap = Map.fromList $ zip (fmap fromOpenEnumBaseType tms) [0..] + + lookupTy :: SemanticTokenTypes -> Either Text UInt + lookupTy ty = case Map.lookup ty tyMap of + Just tycode -> pure tycode + Nothing -> throwError $ "Semantic token type " <> fromString (show ty) <> " did not appear in the legend" + lookupMod :: SemanticTokenModifiers -> Either Text Int + lookupMod modifier = case Map.lookup modifier modMap of + Just modcode -> pure modcode + Nothing -> throwError $ "Semantic token modifier " <> fromString (show modifier) <> " did not appear in the legend" + + -- Use a DList here for better efficiency when concatenating all these together + encodeToken :: SemanticTokenRelative -> Either Text (DList.DList UInt) + encodeToken (SemanticTokenRelative dl dc len ty mods) = do + tycode <- lookupTy ty + modcodes <- traverse lookupMod mods + let combinedModcode :: Int = foldl' Bits.setBit Bits.zeroBits modcodes + + pure [dl, dc, len, tycode, fromIntegral combinedModcode ] + +-- This is basically 'SemanticTokensEdit', but slightly easier to work with. +-- | An edit to a buffer of items. +data Edit a = Edit { editStart :: UInt, editDeleteCount :: UInt, editInsertions :: [a] } + deriving stock (Read, Show, Eq, Ord) + +-- | Compute a list of edits that will turn the first list into the second list. +computeEdits :: Eq a => [a] -> [a] -> [Edit a] +computeEdits l r = DList.toList $ go 0 Nothing (Diff.getGroupedDiff l r) mempty + where + {- + Strategy: traverse the list of diffs, keeping the current index and (maybe) an in-progress 'Edit'. + Whenever we see a 'Diff' that's only one side or the other, we can bundle that in to our in-progress + 'Edit'. We only have to stop if we see a 'Diff' that's on both sides (i.e. unchanged), then we + dump the 'Edit' into the accumulator. + We need the index, because 'Edit's need to say where they start. + -} + go :: UInt -> Maybe (Edit a) -> [Diff.Diff [a]] -> DList.DList (Edit a) -> DList.DList (Edit a) + -- No more diffs: append the current edit if there is one and return + go _ e [] acc = acc <> DList.fromList (maybeToList e) + + -- Items only on the left (i.e. deletions): increment the current index, and record the count of deletions, + -- starting a new edit if necessary. + go ix e (Diff.First ds : rest) acc = + let + deleteCount = fromIntegral $ Prelude.length ds + edit = fromMaybe (Edit ix 0 []) e + in go (ix + deleteCount) (Just (edit{editDeleteCount=editDeleteCount edit + deleteCount})) rest acc + -- Items only on the right (i.e. insertions): don't increment the current index, and record the insertions, + -- starting a new edit if necessary. + go ix e (Diff.Second as : rest) acc = + let edit = fromMaybe (Edit ix 0 []) e + in go ix (Just (edit{editInsertions=editInsertions edit <> as})) rest acc + + -- Items on both sides: increment the current index appropriately (since the items appear on the left), + -- and append the current edit (if there is one) to our list of edits (since we can't continue it with a break). + go ix e (Diff.Both bs _bs : rest) acc = + let bothCount = fromIntegral $ Prelude.length bs + in go (ix + bothCount) Nothing rest (acc <> DList.fromList (maybeToList e)) + +-- | Convenience method for making a 'SemanticTokens' from a list of 'SemanticTokenAbsolute's. An error may be returned if + +-- The resulting 'SemanticTokens' lacks a result ID, which must be set separately if you are using that. +makeSemanticTokens :: SemanticTokensLegend -> [SemanticTokenAbsolute] -> Either Text SemanticTokens +makeSemanticTokens legend sts = do + encoded <- encodeTokens legend $ relativizeTokens sts + pure $ SemanticTokens Nothing encoded + +-- | Convenience function for making a 'SemanticTokensDelta' from a previous and current 'SemanticTokens'. +-- The resulting 'SemanticTokensDelta' lacks a result ID, which must be set separately if you are using that. +makeSemanticTokensDelta :: SemanticTokens -> SemanticTokens -> SemanticTokensDelta +makeSemanticTokensDelta SemanticTokens{_data_=prevTokens} SemanticTokens{_data_=curTokens} = + let edits = computeEdits prevTokens curTokens + stEdits = fmap (\(Edit s ds as) -> SemanticTokensEdit s ds (Just as)) edits + in SemanticTokensDelta Nothing stEdits diff --git a/lsp-types/src/Language/LSP/Protocol/Types/Singletons.hs b/lsp-types/src/Language/LSP/Protocol/Types/Singletons.hs new file mode 100644 index 000000000..30eba55dd --- /dev/null +++ b/lsp-types/src/Language/LSP/Protocol/Types/Singletons.hs @@ -0,0 +1,55 @@ +module Language.LSP.Protocol.Types.Singletons where + +import Data.Aeson +import Data.Proxy +import qualified Data.Text as T +import GHC.TypeLits (KnownNat, KnownSymbol, Nat, Symbol, natVal, + symbolVal) + +-- | A type whose only inhabitant is a single, statically-known string. +-- +-- This corresponds to types like @"hello"@ in the LSP specification that +-- are exactly types with a single inhabitant. +data AString (s :: Symbol) where + AString :: KnownSymbol s => AString s + +instance Show (AString s) where + show AString = symbolVal (Proxy @s) +instance Eq (AString s) where + _ == _ = True +instance Ord (AString s) where + compare _ _ = EQ + +instance ToJSON (AString s) where + toJSON AString = toJSON (T.pack (symbolVal (Proxy @s))) + +instance KnownSymbol s => FromJSON (AString s) where + parseJSON = withText "string literal type" $ \s -> do + let sym = symbolVal (Proxy @s) + if s == T.pack sym + then pure AString + else fail $ "wrong string, got: " <> show s <> " expected " <> sym + +-- | A type whose only inhabitant is a single, statically-known integer. +-- +-- This corresponds to types like @1@ in the LSP specification that +-- are exactly types with a single inhabitant. +data AnInteger (n :: Nat) where + AnInteger :: KnownNat n => AnInteger n + +instance Show (AnInteger n) where + show AnInteger = show $ natVal (Proxy @n) +instance Eq (AnInteger n) where + _ == _ = True +instance Ord (AnInteger n) where + compare _ _ = EQ + +instance ToJSON (AnInteger n) where + toJSON AnInteger = toJSON (natVal (Proxy @n)) + +instance KnownNat n => FromJSON (AnInteger n) where + parseJSON = withScientific "integer literal type" $ \n -> do + let nat = natVal (Proxy @n) + if truncate n == nat + then pure AnInteger + else fail $ "wrong integer, got: " <> show n <> " expected " <> show nat diff --git a/lsp-types/src/Language/LSP/Types/Uri.hs b/lsp-types/src/Language/LSP/Protocol/Types/Uri.hs similarity index 92% rename from lsp-types/src/Language/LSP/Types/Uri.hs rename to lsp-types/src/Language/LSP/Protocol/Types/Uri.hs index c7235d26e..729c7c9c2 100644 --- a/lsp-types/src/Language/LSP/Types/Uri.hs +++ b/lsp-types/src/Language/LSP/Protocol/Types/Uri.hs @@ -6,7 +6,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeSynonymInstances #-} -module Language.LSP.Types.Uri +module Language.LSP.Protocol.Types.Uri ( Uri(..) , uriToFilePath , filePathToUri @@ -41,15 +41,23 @@ import qualified System.FilePath.Posix as FPP import qualified System.FilePath.Windows as FPW import qualified System.Info +-- | The @Uri@ type in the LSP specification. newtype Uri = Uri { getUri :: Text } - deriving (Eq,Ord,Read,Show,Generic,A.FromJSON,A.ToJSON,Hashable,A.ToJSONKey,A.FromJSONKey) + deriving stock (Eq,Ord,Read,Show,Generic) + deriving newtype (A.FromJSON,A.ToJSON,Hashable,A.ToJSONKey,A.FromJSONKey) instance NFData Uri --- If you care about performance then you should use a hash map. The keys --- are cached in order to make hashing very fast. +{- | A normalized 'Uri'. + +If you want to use a URI as a map key, use this type. It is important to normalize +the percent encoding in the URI since URIs that only differ +when it comes to the percent-encoding should be treated as equivalent. + +'NormalizedUri' has a cached hash in order to make it especially fast in a hash map. +-} data NormalizedUri = NormalizedUri !Int !Text - deriving (Read,Show,Generic, Eq) + deriving stock (Read,Show,Generic, Eq) -- Slow but compares paths alphabetically as you would expect. instance Ord NormalizedUri where @@ -66,9 +74,6 @@ isUnescapedInUriPath systemOS c | systemOS == windowsOS = isUnreserved c || c `elem` [':', '\\', '/'] | otherwise = isUnreserved c || c == '/' --- | When URIs are supposed to be used as keys, it is important to normalize --- the percent encoding in the URI since URIs that only differ --- when it comes to the percent-encoding should be treated as equivalent. normalizeUriEscaping :: String -> String normalizeUriEscaping uri = case stripPrefix (fileScheme ++ "//") uri of @@ -158,17 +163,9 @@ platformAdjustToUriPath systemOS srcPath FPP.addTrailingPathSeparator (init drv) | otherwise = drv -{-| A file path that is already normalized. - -The 'NormalizedUri' is cached to avoided -repeated normalisation when we need to compute them (which is a lot). - -This is one of the most performance critical parts of HLS, do not -modify it without profiling. - -== Adoption Plan of OsPath -Currently we store 'Text'. We may change it to OsPath in the future if +{- Note [Adoption Plan of OsPath] +Currently we store 'Text' in 'NormalizedFilePath'. We may change it to OsPath in the future if the following steps are executed. 1. In the client codebase, use 'osPathToNormalizedFilePath' and 'normalizedFilePathToOsPath' instead of 'fromNormalizedFilePath' @@ -180,9 +177,18 @@ the following steps are executed. See [#453](https://github.com/haskell/lsp/pull/453) and [#446](https://github.com/haskell/lsp/pull/446) for more discussions on this topic. +-} +{-| A file path that is already normalized. + +The 'NormalizedUri' is cached to avoided +repeated normalisation when we need to compute them (which is a lot). + +This is one of the most performance critical parts of HLS, do not +modify it without profiling. + -} data NormalizedFilePath = NormalizedFilePath !NormalizedUri {-# UNPACK #-} !Text - deriving (Generic, Eq, Ord) + deriving stock (Generic, Eq, Ord) instance NFData NormalizedFilePath diff --git a/lsp-types/src/Language/LSP/Types/Uri/OsPath.hs b/lsp-types/src/Language/LSP/Protocol/Types/Uri/OsPath.hs similarity index 97% rename from lsp-types/src/Language/LSP/Types/Uri/OsPath.hs rename to lsp-types/src/Language/LSP/Protocol/Types/Uri/OsPath.hs index 317b1dd33..a94f4d2f6 100644 --- a/lsp-types/src/Language/LSP/Types/Uri/OsPath.hs +++ b/lsp-types/src/Language/LSP/Protocol/Types/Uri/OsPath.hs @@ -5,7 +5,7 @@ #define OS_PATH 1 #endif -module Language.LSP.Types.Uri.OsPath +module Language.LSP.Protocol.Types.Uri.OsPath ( #ifdef OS_PATH osPathToNormalizedFilePath diff --git a/lsp-types/src/Language/LSP/Types/Utils.hs b/lsp-types/src/Language/LSP/Protocol/Utils/Misc.hs similarity index 58% rename from lsp-types/src/Language/LSP/Types/Utils.hs rename to lsp-types/src/Language/LSP/Protocol/Utils/Misc.hs index 0039118b5..faba056d9 100644 --- a/lsp-types/src/Language/LSP/Types/Utils.hs +++ b/lsp-types/src/Language/LSP/Protocol/Utils/Misc.hs @@ -1,20 +1,19 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE LambdaCase #-} --- | Internal helpers for generating definitions -module Language.LSP.Types.Utils +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +module Language.LSP.Protocol.Utils.Misc ( rdrop , makeSingletonFromJSON , makeRegHelper - , makeExtendingDatatype , lspOptions , lspOptionsUntagged ) where -import Control.Monad -import Data.Aeson -import Data.List -import Language.Haskell.TH +import Control.Monad +import Data.Aeson +import Data.List +import Data.Maybe (mapMaybe) +import Language.Haskell.TH -- --------------------------------------------------------------------- @@ -24,10 +23,10 @@ rdrop cnt = reverse . drop cnt . reverse -- | Given a wrapper and a singleton GADT, construct FromJSON -- instances for each constructor return type by invoking the -- FromJSON instance for the wrapper and unwrapping -makeSingletonFromJSON :: Name -> Name -> Q [Dec] -makeSingletonFromJSON wrap gadt = do +makeSingletonFromJSON :: Name -> Name -> [Name] -> Q [Dec] +makeSingletonFromJSON wrap gadt skip = do TyConI (DataD _ _ _ _ cons _) <- reify gadt - concat <$> mapM (makeInst wrap) cons + concat <$> (sequence $ mapMaybe (makeInst wrap skip) cons) {- instance FromJSON (SMethod $method) where @@ -35,38 +34,39 @@ instance FromJSON (SMethod $method) where SomeMethod $singleton-method -> pure $singleton-method _ -> mempty -} -makeInst :: Name -> Con -> Q [Dec] -makeInst wrap (GadtC [sConstructor] args t) = do +makeInst :: Name -> [Name] -> Con -> Maybe (Q [Dec]) +makeInst _ skip (GadtC [sConstructor] _ _) | sConstructor `elem` skip = Nothing +makeInst wrap _ (GadtC [sConstructor] args t) = Just $ do ns <- replicateM (length args) (newName "x") let wrappedPat = conP wrap [conP sConstructor (map varP ns)] unwrappedE = pure $ foldl' AppE (ConE sConstructor) (map VarE ns) [d| instance FromJSON $(pure t) where parseJSON = parseJSON >=> \case $wrappedPat -> pure $unwrappedE - _ -> mempty + _ -> mempty |] -makeInst wrap (ForallC _ _ con) = makeInst wrap con -- Cancel and Custom requests -makeInst _ _ = fail "makeInst only defined for GADT constructors" +makeInst wrap skip (ForallC _ _ con) = makeInst wrap skip con -- Cancel and Custom requests +makeInst _ _ _ = Just $ fail "makeInst only defined for GADT constructors" makeRegHelper :: Name -> DecsQ makeRegHelper regOptTypeName = do Just sMethodTypeName <- lookupTypeName "SMethod" - Just fromClientName <- lookupValueName "FromClient" + Just fromClientName <- lookupValueName "ClientToServer" TyConI (DataD _ _ _ _ allCons _) <- reify sMethodTypeName let isConsFromClient (GadtC _ _ (AppT _ method)) = isMethodFromClient method - isConsFromClient _ = return False + isConsFromClient _ = return False isMethodFromClient :: Type -> Q Bool isMethodFromClient (PromotedT method) = do DataConI _ typ _ <- reify method case typ of AppT (AppT _ (PromotedT n)) _ -> return $ n == fromClientName - _ -> return False + _ -> return False isMethodFromClient _ = fail "Didn't expect this type of Method!" cons <- filterM isConsFromClient allCons - let conNames = map (\(GadtC [name] _ _) -> name) cons + let conNames = mapMaybe (\case { (GadtC [name] _ _) -> Just name; _ -> Nothing; }) cons helperName = mkName "regHelper" mkClause name = do x <- newName "x" @@ -82,28 +82,6 @@ makeRegHelper regOptTypeName = do -> x |] return [typSig, fun] --- | @makeExtendingDatatype name extends fields@ generates a record datatype --- that contains all the fields of @extends@, plus the additional fields in --- @fields@. --- e.g. --- data Foo = { a :: Int } --- makeExtendingDatatype "bar" [''Foo] [("b", [t| String |])] --- Will generate --- data Bar = { a :: Int, b :: String } -makeExtendingDatatype :: String -> [Name] -> [(String, TypeQ)] -> DecsQ -makeExtendingDatatype datatypeNameStr extends fields = do - extendFields <- fmap concat $ forM extends $ \e -> do - TyConI (DataD _ _ _ _ [RecC _ eFields] _) <- reify e - return eFields - let datatypeName = mkName datatypeNameStr - insts = [[t| Read |], [t| Show |], [t| Eq |]] - constructor = recC datatypeName combinedFields - userFields = flip map fields $ \(s, typ) -> do - varBangType (mkName s) (bangType (bang noSourceUnpackedness noSourceStrictness) typ) - combinedFields = (map pure extendFields) <> userFields - derivs = [derivClause Nothing insts] - (\a -> [a]) <$> dataD (cxt []) datatypeName [] Nothing [constructor] derivs - -- | Standard options for use when generating JSON instances -- NOTE: This needs to be in a separate file because of the TH stage restriction lspOptions :: Options @@ -115,9 +93,8 @@ lspOptions = defaultOptions { omitNothingFields = True, fieldLabelModifier = mod -- fixes up the json derivation modifier "_xdata" = "data" modifier "_xtype" = "type" - modifier xs = drop 1 xs + modifier xs = drop 1 xs -- | Standard options for use when generating JSON instances for an untagged union lspOptionsUntagged :: Options lspOptionsUntagged = lspOptions { sumEncoding = UntaggedValue } - diff --git a/lsp-types/src/Language/LSP/Types/SMethodMap.hs b/lsp-types/src/Language/LSP/Protocol/Utils/SMethodMap.hs similarity index 57% rename from lsp-types/src/Language/LSP/Types/SMethodMap.hs rename to lsp-types/src/Language/LSP/Protocol/Utils/SMethodMap.hs index 3d2340a66..8ef93ad40 100644 --- a/lsp-types/src/Language/LSP/Types/SMethodMap.hs +++ b/lsp-types/src/Language/LSP/Protocol/Utils/SMethodMap.hs @@ -4,7 +4,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} -module Language.LSP.Types.SMethodMap +module Language.LSP.Protocol.Utils.SMethodMap ( SMethodMap , singleton , insert @@ -14,17 +14,17 @@ module Language.LSP.Types.SMethodMap , map ) where -import Prelude hiding (lookup, map) -import Data.IntMap (IntMap) -import qualified Data.IntMap.Strict as IntMap -import Data.Kind (Type) -import Data.Map (Map) -import qualified Data.Map.Strict as Map -import Data.Text (Text) -import GHC.Exts (Int(..), dataToTag#, Any) -import Unsafe.Coerce (unsafeCoerce) +import Data.IntMap (IntMap) +import qualified Data.IntMap.Strict as IntMap +import Data.Kind (Type) +import Data.Map (Map) +import qualified Data.Map.Strict as Map +import GHC.Exts (Any, Int (..), dataToTag#) +import Prelude hiding (lookup, map) +import Unsafe.Coerce (unsafeCoerce) -import Language.LSP.Types.Method (Method(..), SMethod(..)) +import GHC.TypeLits (symbolVal) +import Language.LSP.Protocol.Message (Method (..), SMethod (..)) -- This type exists to avoid a dependency on 'dependent-map'. It is less -- safe (since we use 'unsafeCoerce') but much simpler and hence easier to include. @@ -35,30 +35,30 @@ data SMethodMap (v :: Method f t -> Type) = -- in the map. We do not attempt to be truly dependent here, and instead exploit -- 'usafeCoerce' to go to and from 'v Any'. -- The sole exception is 'SCustomMethod', for which we keep a separate map from - -- its 'Text' parameter (and where we can get the type indices right). - SMethodMap !(IntMap (v Any)) !(Map Text (v 'CustomMethod)) + -- its 'Text' parameter + SMethodMap !(IntMap (v Any)) !(Map String (v Any)) toIx :: SMethod a -> Int toIx k = I# (dataToTag# k) singleton :: SMethod a -> v a -> SMethodMap v -singleton (SCustomMethod t) v = SMethodMap mempty (Map.singleton t v) +singleton (SMethod_CustomMethod t) v = SMethodMap mempty (Map.singleton (symbolVal t) (unsafeCoerce v)) singleton k v = SMethodMap (IntMap.singleton (toIx k) (unsafeCoerce v)) mempty insert :: SMethod a -> v a -> SMethodMap v -> SMethodMap v -insert (SCustomMethod t) v (SMethodMap xs ys) = SMethodMap xs (Map.insert t v ys) +insert (SMethod_CustomMethod t) v (SMethodMap xs ys) = SMethodMap xs (Map.insert (symbolVal t) (unsafeCoerce v) ys) insert k v (SMethodMap xs ys) = SMethodMap (IntMap.insert (toIx k) (unsafeCoerce v) xs) ys delete :: SMethod a -> SMethodMap v -> SMethodMap v -delete (SCustomMethod t) (SMethodMap xs ys) = SMethodMap xs (Map.delete t ys) +delete (SMethod_CustomMethod t) (SMethodMap xs ys) = SMethodMap xs (Map.delete (symbolVal t) ys) delete k (SMethodMap xs ys) = SMethodMap (IntMap.delete (toIx k) xs) ys member :: SMethod a -> SMethodMap v -> Bool -member (SCustomMethod t) (SMethodMap _ ys) = Map.member t ys -member k (SMethodMap xs _) = IntMap.member (toIx k) xs +member (SMethod_CustomMethod t) (SMethodMap _ ys) = Map.member (symbolVal t) ys +member k (SMethodMap xs _) = IntMap.member (toIx k) xs lookup :: SMethod a -> SMethodMap v -> Maybe (v a) -lookup (SCustomMethod t) (SMethodMap _ ys) = Map.lookup t ys +lookup (SMethod_CustomMethod t) (SMethodMap _ ys) = unsafeCoerce (Map.lookup (symbolVal t) ys) lookup k (SMethodMap xs _) = unsafeCoerce (IntMap.lookup (toIx k) xs) map :: (forall a. u a -> v a) -> SMethodMap u -> SMethodMap v diff --git a/lsp-types/src/Language/LSP/Types.hs b/lsp-types/src/Language/LSP/Types.hs deleted file mode 100644 index 4c4975765..000000000 --- a/lsp-types/src/Language/LSP/Types.hs +++ /dev/null @@ -1,92 +0,0 @@ -module Language.LSP.Types - ( module Language.LSP.Types.CallHierarchy - , module Language.LSP.Types.Cancellation - , module Language.LSP.Types.CodeAction - , module Language.LSP.Types.CodeLens - , module Language.LSP.Types.Command - , module Language.LSP.Types.Common - , module Language.LSP.Types.Completion - , module Language.LSP.Types.Configuration - , module Language.LSP.Types.Declaration - , module Language.LSP.Types.Definition - , module Language.LSP.Types.Diagnostic - , module Language.LSP.Types.DocumentColor - , module Language.LSP.Types.DocumentFilter - , module Language.LSP.Types.DocumentHighlight - , module Language.LSP.Types.DocumentLink - , module Language.LSP.Types.DocumentSymbol - , module Language.LSP.Types.FoldingRange - , module Language.LSP.Types.Formatting - , module Language.LSP.Types.Hover - , module Language.LSP.Types.Implementation - , module Language.LSP.Types.Initialize - , module Language.LSP.Types.Location - , module Language.LSP.Types.LspId - , module Language.LSP.Types.MarkupContent - , module Language.LSP.Types.Method - , module Language.LSP.Types.Message - , module Language.LSP.Types.Parsing - , module Language.LSP.Types.Progress - , module Language.LSP.Types.References - , module Language.LSP.Types.Registration - , module Language.LSP.Types.Rename - , module Language.LSP.Types.SignatureHelp - , module Language.LSP.Types.StaticRegistrationOptions - , module Language.LSP.Types.SelectionRange - , module Language.LSP.Types.SemanticTokens - , module Language.LSP.Types.TextDocument - , module Language.LSP.Types.TypeDefinition - , module Language.LSP.Types.Uri - , module Language.LSP.Types.Uri.OsPath - , module Language.LSP.Types.WatchedFiles - , module Language.LSP.Types.Window - , module Language.LSP.Types.WorkspaceEdit - , module Language.LSP.Types.WorkspaceFolders - , module Language.LSP.Types.WorkspaceSymbol - ) -where - -import Language.LSP.Types.CallHierarchy -import Language.LSP.Types.Cancellation -import Language.LSP.Types.CodeAction -import Language.LSP.Types.CodeLens -import Language.LSP.Types.Command -import Language.LSP.Types.Common -import Language.LSP.Types.Completion -import Language.LSP.Types.Configuration -import Language.LSP.Types.Declaration -import Language.LSP.Types.Definition -import Language.LSP.Types.Diagnostic -import Language.LSP.Types.DocumentColor -import Language.LSP.Types.DocumentFilter -import Language.LSP.Types.DocumentHighlight -import Language.LSP.Types.DocumentLink -import Language.LSP.Types.DocumentSymbol -import Language.LSP.Types.FoldingRange -import Language.LSP.Types.Formatting -import Language.LSP.Types.Hover -import Language.LSP.Types.Implementation -import Language.LSP.Types.Initialize -import Language.LSP.Types.Location -import Language.LSP.Types.LspId -import Language.LSP.Types.MarkupContent -import Language.LSP.Types.Message -import Language.LSP.Types.Method -import Language.LSP.Types.Parsing -import Language.LSP.Types.Progress -import Language.LSP.Types.References -import Language.LSP.Types.Registration -import Language.LSP.Types.Rename -import Language.LSP.Types.SelectionRange -import Language.LSP.Types.SemanticTokens -import Language.LSP.Types.SignatureHelp -import Language.LSP.Types.StaticRegistrationOptions -import Language.LSP.Types.TextDocument -import Language.LSP.Types.TypeDefinition -import Language.LSP.Types.Uri -import Language.LSP.Types.Uri.OsPath -import Language.LSP.Types.WatchedFiles -import Language.LSP.Types.Window -import Language.LSP.Types.WorkspaceEdit -import Language.LSP.Types.WorkspaceFolders -import Language.LSP.Types.WorkspaceSymbol diff --git a/lsp-types/src/Language/LSP/Types/CallHierarchy.hs b/lsp-types/src/Language/LSP/Types/CallHierarchy.hs deleted file mode 100644 index d627ca1a6..000000000 --- a/lsp-types/src/Language/LSP/Types/CallHierarchy.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} - -{- | Since LSP 3.16.0 -} -module Language.LSP.Types.CallHierarchy where - -import Data.Aeson.TH -import Data.Aeson.Types ( Value ) -import Data.Text ( Text ) - -import Language.LSP.Types.Common -import Language.LSP.Types.DocumentSymbol -import Language.LSP.Types.Location -import Language.LSP.Types.Progress -import Language.LSP.Types.StaticRegistrationOptions -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Uri -import Language.LSP.Types.Utils - - -data CallHierarchyClientCapabilities = - CallHierarchyClientCapabilities - { _dynamicRegistration :: Maybe Bool } - deriving (Show, Read, Eq) -deriveJSON lspOptions ''CallHierarchyClientCapabilities - -makeExtendingDatatype "CallHierarchyOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''CallHierarchyOptions - -makeExtendingDatatype "CallHierarchyRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''CallHierarchyOptions - , ''StaticRegistrationOptions - ] - [] -deriveJSON lspOptions ''CallHierarchyRegistrationOptions - -makeExtendingDatatype "CallHierarchyPrepareParams" - [''TextDocumentPositionParams, ''WorkDoneProgressParams] [] -deriveJSON lspOptions ''CallHierarchyPrepareParams - -data CallHierarchyItem = - CallHierarchyItem - { _name :: Text - , _kind :: SymbolKind - , _tags :: Maybe (List SymbolTag) - -- | More detail for this item, e.g. the signature of a function. - , _detail :: Maybe Text - , _uri :: Uri - , _range :: Range - -- | The range that should be selected and revealed when this symbol - -- is being picked, e.g. the name of a function. Must be contained by - -- the @_range@. - , _selectionRange :: Range - -- | A data entry field that is preserved between a call hierarchy - -- prepare and incoming calls or outgoing calls requests. - , _xdata :: Maybe Value - } - deriving (Show, Read, Eq, Ord) -deriveJSON lspOptions ''CallHierarchyItem - --- ------------------------------------- - -makeExtendingDatatype "CallHierarchyIncomingCallsParams" - [ ''WorkDoneProgressParams - , ''PartialResultParams - ] - [("_item", [t| CallHierarchyItem |])] -deriveJSON lspOptions ''CallHierarchyIncomingCallsParams - -data CallHierarchyIncomingCall = - CallHierarchyIncomingCall - { -- | The item that makes the call. - _from :: CallHierarchyItem - -- | The ranges at which the calls appear. This is relative to the caller - -- denoted by @_from@. - , _fromRanges :: List Range - } - deriving (Show, Read, Eq, Ord) -deriveJSON lspOptions ''CallHierarchyIncomingCall - --- ------------------------------------- - -makeExtendingDatatype "CallHierarchyOutgoingCallsParams" - [ ''WorkDoneProgressParams - , ''PartialResultParams - ] - [("_item", [t| CallHierarchyItem |])] -deriveJSON lspOptions ''CallHierarchyOutgoingCallsParams - -data CallHierarchyOutgoingCall = - CallHierarchyOutgoingCall - { -- | The item that is called. - _to :: CallHierarchyItem - -- | The range at which this item is called. THis is the range relative to - -- the caller, e.g the item passed to `callHierarchy/outgoingCalls` request. - , _fromRanges :: List Range - } - deriving (Show, Read, Eq, Ord) -deriveJSON lspOptions ''CallHierarchyOutgoingCall diff --git a/lsp-types/src/Language/LSP/Types/Cancellation.hs b/lsp-types/src/Language/LSP/Types/Cancellation.hs deleted file mode 100644 index eec4043b6..000000000 --- a/lsp-types/src/Language/LSP/Types/Cancellation.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE ExistentialQuantification #-} -module Language.LSP.Types.Cancellation where - -import Data.Aeson.TH -import Language.LSP.Types.LspId -import Language.LSP.Types.Utils - -data CancelParams = forall m. - CancelParams - { -- | The request id to cancel. - _id :: LspId m - } - -deriving instance Read CancelParams -deriving instance Show CancelParams -instance Eq CancelParams where - (CancelParams a) == CancelParams b = - case (a,b) of - (IdInt x, IdInt y) -> x == y - (IdString x, IdString y) -> x == y - _ -> False - -deriveJSON lspOptions ''CancelParams diff --git a/lsp-types/src/Language/LSP/Types/Capabilities.hs b/lsp-types/src/Language/LSP/Types/Capabilities.hs deleted file mode 100644 index f20817ed2..000000000 --- a/lsp-types/src/Language/LSP/Types/Capabilities.hs +++ /dev/null @@ -1,290 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Language.LSP.Types.Capabilities - ( - module Language.LSP.Types.ClientCapabilities - , module Language.LSP.Types.ServerCapabilities - , module Language.LSP.Types.WorkspaceEdit - , fullCaps - , LSPVersion(..) - , capsForVersion - ) where - -import Prelude hiding (min) -import Language.LSP.Types.ClientCapabilities -import Language.LSP.Types.ServerCapabilities -import Language.LSP.Types.WorkspaceEdit -import Language.LSP.Types - --- | Capabilities for full conformance to the current (v3.15) LSP specification. -fullCaps :: ClientCapabilities -fullCaps = capsForVersion (LSPVersion maxBound maxBound) - --- | A specific version of the LSP specification. -data LSPVersion = LSPVersion Int Int -- ^ Construct a major.minor version - --- | Capabilities for full conformance to the LSP specification up until a version. --- Some important milestones: --- --- * 3.12 textDocument/prepareRename request --- * 3.11 CodeActionOptions provided by the server --- * 3.10 hierarchical document symbols, folding ranges --- * 3.9 completion item preselect --- * 3.8 codeAction literals --- * 3.7 related information in diagnostics --- * 3.6 workspace folders, colors, goto type/implementation --- * 3.4 extended completion item and symbol item kinds --- * 3.0 dynamic registration -capsForVersion :: LSPVersion -> ClientCapabilities -capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Just window) (since 3 16 general) Nothing - where - w = WorkspaceClientCapabilities - (Just True) - (Just (WorkspaceEditClientCapabilities - (Just True) - (since 3 13 resourceOperations) - Nothing - (since 3 16 True) - (since 3 16 (WorkspaceEditChangeAnnotationClientCapabilities (Just True))))) - (Just (DidChangeConfigurationClientCapabilities dynamicReg)) - (Just (DidChangeWatchedFilesClientCapabilities dynamicReg)) - (Just symbolCapabilities) - (Just (ExecuteCommandClientCapabilities dynamicReg)) - (since 3 6 True) - (since 3 6 True) - (since 3 16 (SemanticTokensWorkspaceClientCapabilities $ Just True)) - - resourceOperations = List - [ ResourceOperationCreate - , ResourceOperationDelete - , ResourceOperationRename - ] - - symbolCapabilities = WorkspaceSymbolClientCapabilities - dynamicReg - (since 3 4 symbolKindCapabilities) - (since 3 16 symbolTagCapabilities) - - symbolKindCapabilities = - WorkspaceSymbolKindClientCapabilities (Just sKs) - - symbolTagCapabilities = - WorkspaceSymbolTagClientCapabilities (Just (List [StDeprecated])) - - sKs - | maj >= 3 && min >= 4 = List (oldSKs ++ newSKs) - | otherwise = List oldSKs - - oldSKs = [ SkFile - , SkModule - , SkNamespace - , SkPackage - , SkClass - , SkMethod - , SkProperty - , SkField - , SkConstructor - , SkEnum - , SkInterface - , SkFunction - , SkVariable - , SkConstant - , SkString - , SkNumber - , SkBoolean - , SkArray - ] - - newSKs = [ SkObject - , SkKey - , SkNull - , SkEnumMember - , SkStruct - , SkEvent - , SkOperator - , SkTypeParameter - ] - - -- Only one token format for now, just list it here - tfs = List [ TokenFormatRelative ] - - semanticTokensCapabilities = SemanticTokensClientCapabilities - (Just True) - (SemanticTokensRequestsClientCapabilities - (Just $ SemanticTokensRangeBool True) - (Just (SemanticTokensFullDelta (SemanticTokensDeltaClientCapabilities $ Just True)))) - (List knownSemanticTokenTypes) - (List knownSemanticTokenModifiers) - tfs - (Just True) - (Just True) - - td = TextDocumentClientCapabilities - (Just sync) - (Just completionCapability) - (Just hoverCapability) - (Just signatureHelpCapability) - (Just (ReferencesClientCapabilities dynamicReg)) - (Just (DocumentHighlightClientCapabilities dynamicReg)) - (Just documentSymbolCapability) - (Just (DocumentFormattingClientCapabilities dynamicReg)) - (Just (DocumentRangeFormattingClientCapabilities dynamicReg)) - (Just (DocumentOnTypeFormattingClientCapabilities dynamicReg)) - (since 3 14 (DeclarationClientCapabilities dynamicReg (Just True))) - (Just (DefinitionClientCapabilities dynamicReg (since 3 14 True))) - (since 3 6 (TypeDefinitionClientCapabilities dynamicReg (since 3 14 True))) - (since 3 6 (ImplementationClientCapabilities dynamicReg (since 3 14 True))) - (Just codeActionCapability) - (Just (CodeLensClientCapabilities dynamicReg)) - (Just (DocumentLinkClientCapabilities dynamicReg (since 3 15 True))) - (since 3 6 (DocumentColorClientCapabilities dynamicReg)) - (Just (RenameClientCapabilities dynamicReg (since 3 12 True) (since 3 16 PsIdentifier) (since 3 16 True))) - (Just publishDiagnosticsCapabilities) - (since 3 10 foldingRangeCapability) - (since 3 5 (SelectionRangeClientCapabilities dynamicReg)) - (since 3 16 (CallHierarchyClientCapabilities dynamicReg)) - (since 3 16 semanticTokensCapabilities) - - sync = - TextDocumentSyncClientCapabilities - dynamicReg - (Just True) - (Just True) - (Just True) - - completionCapability = - CompletionClientCapabilities - dynamicReg - (Just completionItemCapabilities) - (since 3 4 completionItemKindCapabilities) - (since 3 3 True) - - completionItemCapabilities = CompletionItemClientCapabilities - (Just True) - (Just True) - (since 3 3 (List [MkPlainText, MkMarkdown])) - (Just True) - (since 3 9 True) - (since 3 15 completionItemTagsCapabilities) - (since 3 16 True) - (since 3 16 (CompletionItemResolveClientCapabilities (List ["documentation", "details"]))) - (since 3 16 (CompletionItemInsertTextModeClientCapabilities (List []))) - - completionItemKindCapabilities = - CompletionItemKindClientCapabilities (Just ciKs) - - completionItemTagsCapabilities = - CompletionItemTagsClientCapabilities (List [ CitDeprecated ]) - - ciKs - | maj >= 3 && min >= 4 = List (oldCiKs ++ newCiKs) - | otherwise = List oldCiKs - - oldCiKs = [ CiText - , CiMethod - , CiFunction - , CiConstructor - , CiField - , CiVariable - , CiClass - , CiInterface - , CiModule - , CiProperty - , CiUnit - , CiValue - , CiEnum - , CiKeyword - , CiSnippet - , CiColor - , CiFile - , CiReference - ] - - newCiKs = [ CiFolder - , CiEnumMember - , CiConstant - , CiStruct - , CiEvent - , CiOperator - , CiTypeParameter - ] - - hoverCapability = - HoverClientCapabilities - dynamicReg - (since 3 3 (List [MkPlainText, MkMarkdown])) - - codeActionCapability - = CodeActionClientCapabilities - dynamicReg - (since 3 8 (CodeActionLiteralSupport caKs)) - (since 3 15 True) - (since 3 16 True) - (since 3 16 True) - (since 3 16 (CodeActionResolveClientCapabilities (List []))) - (since 3 16 True) - caKs = CodeActionKindClientCapabilities - (List specCodeActionKinds) - - signatureHelpCapability = - SignatureHelpClientCapabilities - dynamicReg - (Just signatureInformationCapability) - Nothing - - signatureInformationCapability = - SignatureHelpSignatureInformation - (Just (List [MkPlainText, MkMarkdown])) - (Just signatureParameterCapability) - (since 3 16 True) - - signatureParameterCapability = - SignatureHelpParameterInformation (since 3 14 True) - - documentSymbolCapability = - DocumentSymbolClientCapabilities - dynamicReg - (since 3 4 documentSymbolKind) - (since 3 10 True) - (since 3 16 documentSymbolTag) - (since 3 16 True) - - documentSymbolKind = - DocumentSymbolKindClientCapabilities - (Just sKs) -- same as workspace symbol kinds - - documentSymbolTag = - DocumentSymbolTagClientCapabilities (Just (List [StDeprecated])) - - foldingRangeCapability = - FoldingRangeClientCapabilities - dynamicReg - Nothing - (Just False) - - publishDiagnosticsCapabilities = - PublishDiagnosticsClientCapabilities - (since 3 7 True) - (since 3 15 publishDiagnosticsTagsCapabilities) - (since 3 15 True) - - publishDiagnosticsTagsCapabilities = - PublishDiagnosticsTagsClientCapabilities - (List [ DtUnnecessary, DtDeprecated ]) - - dynamicReg - | maj >= 3 = Just True - | otherwise = Nothing - since x y a - | maj >= x && min >= y = Just a - | otherwise = Nothing - - window = - WindowClientCapabilities - (since 3 15 True) - (since 3 16 $ ShowMessageRequestClientCapabilities Nothing) - (since 3 16 $ ShowDocumentClientCapabilities True) - - general = GeneralClientCapabilities - (since 3 16 $ StaleRequestClientCapabilities True (List [])) - (since 3 16 $ RegularExpressionsClientCapabilities "" Nothing) - (since 3 16 $ MarkdownClientCapabilities "" Nothing) diff --git a/lsp-types/src/Language/LSP/Types/ClientCapabilities.hs b/lsp-types/src/Language/LSP/Types/ClientCapabilities.hs deleted file mode 100644 index 7c1288959..000000000 --- a/lsp-types/src/Language/LSP/Types/ClientCapabilities.hs +++ /dev/null @@ -1,295 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} - -module Language.LSP.Types.ClientCapabilities where - -import Data.Aeson.TH -import qualified Data.Aeson as A -import Data.Default -import Data.Text (Text) - -import Language.LSP.Types.CallHierarchy -import Language.LSP.Types.CodeAction -import Language.LSP.Types.CodeLens -import Language.LSP.Types.Command -import Language.LSP.Types.Completion -import Language.LSP.Types.Configuration -import Language.LSP.Types.Diagnostic -import Language.LSP.Types.Declaration -import Language.LSP.Types.Definition -import Language.LSP.Types.DocumentColor -import Language.LSP.Types.DocumentHighlight -import Language.LSP.Types.DocumentLink -import Language.LSP.Types.DocumentSymbol -import Language.LSP.Types.FoldingRange -import Language.LSP.Types.Formatting -import Language.LSP.Types.Hover -import Language.LSP.Types.Implementation -import Language.LSP.Types.References -import Language.LSP.Types.Rename -import Language.LSP.Types.SelectionRange -import Language.LSP.Types.SemanticTokens -import Language.LSP.Types.SignatureHelp -import Language.LSP.Types.TextDocument -import Language.LSP.Types.TypeDefinition -import Language.LSP.Types.Utils -import Language.LSP.Types.WatchedFiles -import Language.LSP.Types.WorkspaceEdit -import Language.LSP.Types.WorkspaceSymbol -import Language.LSP.Types.MarkupContent (MarkdownClientCapabilities) -import Language.LSP.Types.Common (List) - - -data WorkspaceClientCapabilities = - WorkspaceClientCapabilities - { -- | 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 WorkspaceEditClientCapabilities - - -- | 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 WorkspaceSymbolClientCapabilities - - -- | Capabilities specific to the `workspace/executeCommand` request. - , _executeCommand :: Maybe ExecuteCommandClientCapabilities - - -- | The client has support for workspace folders. - , _workspaceFolders :: Maybe Bool - - -- | The client supports `workspace/configuration` requests. - , _configuration :: Maybe Bool - - -- | Capabilities specific to the semantic token requests scoped to the - -- workspace. - -- - -- @since 3.16.0 - , _semanticTokens :: Maybe SemanticTokensWorkspaceClientCapabilities - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''WorkspaceClientCapabilities - -instance Default WorkspaceClientCapabilities where - def = WorkspaceClientCapabilities def def def def def def def def def - --- ------------------------------------- - -data TextDocumentClientCapabilities = - TextDocumentClientCapabilities - { _synchronization :: Maybe TextDocumentSyncClientCapabilities - - -- | 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 DocumentFormattingClientCapabilities - - -- | Capabilities specific to the `textDocument/rangeFormatting` - , _rangeFormatting :: Maybe DocumentRangeFormattingClientCapabilities - - -- | Capabilities specific to the `textDocument/onTypeFormatting` - , _onTypeFormatting :: Maybe DocumentOnTypeFormattingClientCapabilities - - -- | Capabilities specific to the `textDocument/declaration` request. - -- - -- Since LSP 3.14.0 - , _declaration :: Maybe DeclarationClientCapabilities - - -- | Capabilities specific to the `textDocument/definition` - , _definition :: Maybe DefinitionClientCapabilities - - -- | Capabilities specific to the `textDocument/typeDefinition` - , _typeDefinition :: Maybe TypeDefinitionClientCapabilities - - -- | Capabilities specific to the `textDocument/implementation` - , _implementation :: Maybe ImplementationClientCapabilities - - -- | 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/documentColor` and the - -- `textDocument/colorPresentation` request - , _colorProvider :: Maybe DocumentColorClientCapabilities - - -- | Capabilities specific to the `textDocument/rename` - , _rename :: Maybe RenameClientCapabilities - - -- | Capabilities specific to `textDocument/publishDiagnostics` - , _publishDiagnostics :: Maybe PublishDiagnosticsClientCapabilities - - -- | Capabilities specific to the `textDocument/foldingRange` request. - -- Since LSP 3.10. - -- - -- @since 0.7.0.0 - , _foldingRange :: Maybe FoldingRangeClientCapabilities - - -- | Capabilities specific to the `textDocument/selectionRange` request. - -- Since LSP 3.15.0 - , _selectionRange :: Maybe SelectionRangeClientCapabilities - - -- | Call hierarchy specific to the `textDocument/prepareCallHierarchy` request. - -- Since LSP 3.16.0 - , _callHierarchy :: Maybe CallHierarchyClientCapabilities - - -- | Capabilities specific to the various semantic token requests. - -- - -- @since 3.16.0 - , _semanticTokens :: Maybe SemanticTokensClientCapabilities - } 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 def - def def def def def def def def - --- --------------------------------------------------------------------- - --- | Capabilities specific to the `MessageActionItem` type. -data MessageActionItemClientCapabilities = - MessageActionItemClientCapabilities - { - -- | Whether the client supports additional attributes which - -- are preserved and sent back to the server in the - -- request's response. - _additionalPropertiesSupport :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''MessageActionItemClientCapabilities - --- | Show message request client capabilities -data ShowMessageRequestClientCapabilities = - ShowMessageRequestClientCapabilities - { -- | Capabilities specific to the `MessageActionItem` type. - _messageActionItem :: Maybe MessageActionItemClientCapabilities - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''ShowMessageRequestClientCapabilities - --- | Client capabilities for the show document request. --- --- @since 3.16.0 -data ShowDocumentClientCapabilities = - ShowDocumentClientCapabilities - { -- | The client has support for the show document request - _support :: Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''ShowDocumentClientCapabilities - --- | Window specific client capabilities. -data WindowClientCapabilities = - WindowClientCapabilities - { -- | Whether client supports handling progress notifications. - -- - -- @since 3.15.0 - _workDoneProgress :: Maybe Bool - -- | Capabilities specific to the showMessage request - -- - -- @since 3.16.0 - , _showMessage :: Maybe ShowMessageRequestClientCapabilities - -- | Capabilities specific to the showDocument request - -- - -- @since 3.16.0 - , _showDocument :: Maybe ShowDocumentClientCapabilities - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''WindowClientCapabilities - -instance Default WindowClientCapabilities where - def = WindowClientCapabilities def def def - --- --------------------------------------------------------------------- - --- | Client capability that signals how the client --- handles stale requests (e.g. a request --- for which the client will not process the response --- anymore since the information is outdated). --- @since 3.17.0 -data StaleRequestClientCapabilities = - StaleRequestClientCapabilities - { _cancel :: Bool - , _retryOnContentModified :: List Text - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''StaleRequestClientCapabilities - --- | Client capabilities specific to the used markdown parser. --- @since 3.16.0 -data RegularExpressionsClientCapabilities = - RegularExpressionsClientCapabilities - { _engine :: Text - , _version :: Maybe Text - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''RegularExpressionsClientCapabilities - --- | General client capabilities. --- @since 3.16.0 -data GeneralClientCapabilities = - GeneralClientCapabilities - { - _staleRequestSupport :: Maybe StaleRequestClientCapabilities - -- | Client capabilities specific to regular expressions. - -- @since 3.16.0 - , _regularExpressions :: Maybe RegularExpressionsClientCapabilities - -- | Client capabilities specific to the client's markdown parser. - -- @since 3.16.0 - , _markdown :: Maybe MarkdownClientCapabilities - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''GeneralClientCapabilities - -instance Default GeneralClientCapabilities where - def = GeneralClientCapabilities def def def - --- --------------------------------------------------------------------- - -data ClientCapabilities = - ClientCapabilities - { -- | Workspace specific client capabilities - _workspace :: Maybe WorkspaceClientCapabilities - -- | Text document specific client capabilities - , _textDocument :: Maybe TextDocumentClientCapabilities - -- | Window specific client capabilities. - , _window :: Maybe WindowClientCapabilities - -- | General client capabilities. - -- @since 3.16.0 - , _general :: Maybe GeneralClientCapabilities - -- | Experimental client capabilities. - , _experimental :: Maybe A.Object - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''ClientCapabilities - -instance Default ClientCapabilities where - def = ClientCapabilities def def def def def diff --git a/lsp-types/src/Language/LSP/Types/CodeAction.hs b/lsp-types/src/Language/LSP/Types/CodeAction.hs deleted file mode 100644 index a59386922..000000000 --- a/lsp-types/src/Language/LSP/Types/CodeAction.hs +++ /dev/null @@ -1,268 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -module Language.LSP.Types.CodeAction where - -import Data.Aeson.TH -import Data.Aeson.Types -import Data.Default -import Data.String -import Data.Text ( Text ) -import qualified Data.Text as T -import Language.LSP.Types.Command -import Language.LSP.Types.Diagnostic -import Language.LSP.Types.Common -import Language.LSP.Types.Location -import Language.LSP.Types.Progress -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils -import Language.LSP.Types.WorkspaceEdit - - -data CodeActionKind - = -- | Empty kind. - CodeActionEmpty - | -- | Base kind for quickfix actions: @quickfix@. - CodeActionQuickFix - | -- | Base kind for refactoring actions: @refactor@. - CodeActionRefactor - | -- | Base kind for refactoring extraction actions: @refactor.extract@. - -- Example extract actions: - -- - -- - Extract method - -- - Extract function - -- - Extract variable - -- - Extract interface from class - -- - ... - CodeActionRefactorExtract - | -- | Base kind for refactoring inline actions: @refactor.inline@. - -- - -- Example inline actions: - -- - -- - Inline function - -- - Inline variable - -- - Inline constant - -- - ... - CodeActionRefactorInline - | -- | Base kind for refactoring rewrite actions: @refactor.rewrite@. - -- - -- Example rewrite actions: - -- - -- - Convert JavaScript function to class - -- - Add or remove parameter - -- - Encapsulate field - -- - Make method static - -- - Move method to base class - -- - ... - CodeActionRefactorRewrite - | -- | Base kind for source actions: @source@. - -- - -- Source code actions apply to the entire file. - CodeActionSource - | -- | Base kind for an organize imports source action: @source.organizeImports@. - CodeActionSourceOrganizeImports - | CodeActionUnknown Text - deriving (Read, Show, Eq) - -fromHierarchicalString :: Text -> CodeActionKind -fromHierarchicalString t = case t of - "" -> CodeActionEmpty - "quickfix" -> CodeActionQuickFix - "refactor" -> CodeActionRefactor - "refactor.extract" -> CodeActionRefactorExtract - "refactor.inline" -> CodeActionRefactorInline - "refactor.rewrite" -> CodeActionRefactorRewrite - "source" -> CodeActionSource - "source.organizeImports" -> CodeActionSourceOrganizeImports - s -> CodeActionUnknown s - -toHierarchicalString :: CodeActionKind -> Text -toHierarchicalString k = case k of - CodeActionEmpty -> "" - CodeActionQuickFix -> "quickfix" - CodeActionRefactor -> "refactor" - CodeActionRefactorExtract -> "refactor.extract" - CodeActionRefactorInline -> "refactor.inline" - CodeActionRefactorRewrite -> "refactor.rewrite" - CodeActionSource -> "source" - CodeActionSourceOrganizeImports -> "source.organizeImports" - (CodeActionUnknown s) -> s - -instance IsString CodeActionKind where - fromString = fromHierarchicalString . T.pack - -instance ToJSON CodeActionKind where - toJSON = String . toHierarchicalString - -instance FromJSON CodeActionKind where - parseJSON (String s) = pure $ fromHierarchicalString s - parseJSON _ = fail "CodeActionKind" - --- | Does the first 'CodeActionKind' subsume the other one, hierarchically. Reflexive. -codeActionKindSubsumes :: CodeActionKind -> CodeActionKind -> Bool --- Simple but ugly implementation: prefix on the string representation -codeActionKindSubsumes parent child = toHierarchicalString parent `T.isPrefixOf` toHierarchicalString child - --- | The 'CodeActionKind's listed in the LSP spec specifically. -specCodeActionKinds :: [CodeActionKind] -specCodeActionKinds = [ - CodeActionQuickFix - , CodeActionRefactor - , CodeActionRefactorExtract - , CodeActionRefactorInline - , CodeActionRefactorRewrite - , CodeActionSource - , CodeActionSourceOrganizeImports - ] - --- ------------------------------------- - -data CodeActionKindClientCapabilities = - CodeActionKindClientCapabilities - { -- | The code action kind values the client supports. When this - -- property exists the client also guarantees that it will - -- handle values outside its set gracefully and falls back - -- to a default value when unknown. - _valueSet :: List CodeActionKind - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''CodeActionKindClientCapabilities - -instance Default CodeActionKindClientCapabilities where - def = CodeActionKindClientCapabilities (List specCodeActionKinds) - -data CodeActionLiteralSupport = - CodeActionLiteralSupport - { _codeActionKind :: CodeActionKindClientCapabilities -- ^ The code action kind is support with the following value set. - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''CodeActionLiteralSupport - -data CodeActionResolveClientCapabilities = - CodeActionResolveClientCapabilities - { _properties :: List Text -- ^ The properties that a client can resolve lazily. - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''CodeActionResolveClientCapabilities - -data CodeActionClientCapabilities = CodeActionClientCapabilities - { -- | Whether code action supports dynamic registration. - _dynamicRegistration :: Maybe Bool, - -- | The client support code action literals as a valid response - -- of the `textDocument/codeAction` request. - -- Since 3.8.0 - _codeActionLiteralSupport :: Maybe CodeActionLiteralSupport, - -- | Whether code action supports the `isPreferred` property. Since LSP 3.15.0 - _isPreferredSupport :: Maybe Bool, - -- | Whether code action supports the `disabled` property. - -- - -- @since 3.16.0 - _disabledSupport :: Maybe Bool, - -- | Whether code action supports the `data` property which is - -- preserved between a `textDocument/codeAction` and a - -- `codeAction/resolve` request. - -- - -- @since 3.16.0 - _dataSupport :: Maybe Bool, - -- | Whether the client supports resolving additional code action - -- properties via a separate `codeAction/resolve` request. - -- - -- @since 3.16.0 - _resolveSupport :: Maybe CodeActionResolveClientCapabilities, - -- | Whether the client honors the change annotations in - -- text edits and resource operations returned via the - -- `CodeAction#edit` property by for example presenting - -- the workspace edit in the user interface and asking - -- for confirmation. - -- - -- @since 3.16.0 - _honorsChangeAnnotations :: Maybe Bool - } - deriving (Show, Read, Eq) - -deriveJSON lspOptions ''CodeActionClientCapabilities - --- ------------------------------------- - -makeExtendingDatatype "CodeActionOptions" [''WorkDoneProgressOptions] - [("_codeActionKinds", [t| Maybe (List CodeActionKind) |]), ("_resolveProvider", [t| Maybe Bool |]) ] -deriveJSON lspOptions ''CodeActionOptions - -makeExtendingDatatype "CodeActionRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''CodeActionOptions - ] [] -deriveJSON lspOptions ''CodeActionRegistrationOptions - --- ------------------------------------- - --- | Contains additional diagnostic information about the context in which a --- code action is run. -data CodeActionContext = CodeActionContext - { -- | An array of diagnostics known on the client side overlapping the range provided to the - -- @textDocument/codeAction@ request. They are provided so that the server knows which - -- errors are currently presented to the user for the given range. There is no guarantee - -- that these accurately reflect the error state of the resource. The primary parameter - -- to compute code actions is the provided range. - _diagnostics :: List Diagnostic - -- | Requested kind of actions to return. - -- - -- Actions not of this kind are filtered out by the client before being shown. So servers - -- can omit computing them. - , _only :: Maybe (List CodeActionKind) - } - deriving (Read, Show, Eq) - -deriveJSON lspOptions ''CodeActionContext - -makeExtendingDatatype "CodeActionParams" - [ ''WorkDoneProgressParams - , ''PartialResultParams - ] - [ ("_textDocument", [t|TextDocumentIdentifier|]), - ("_range", [t|Range|]), - ("_context", [t|CodeActionContext|]) - ] -deriveJSON lspOptions ''CodeActionParams - -newtype Reason = Reason {_reason :: Text} - deriving (Read, Show, Eq) - -deriveJSON lspOptions ''Reason - --- | A code action represents a change that can be performed in code, e.g. to fix a problem or --- to refactor code. --- --- A CodeAction must set either '_edit' and/or a '_command'. If both are supplied, --- the '_edit' is applied first, then the '_command' is executed. -data CodeAction = - CodeAction - { -- | A short, human-readable, title for this code action. - _title :: Text, - -- | The kind of the code action. Used to filter code actions. - _kind :: Maybe CodeActionKind, - -- | The diagnostics that this code action resolves. - _diagnostics :: Maybe (List Diagnostic), - -- | Marks this as a preferred action. Preferred actions are used by the `auto fix` command and can be targeted - -- by keybindings. - -- - -- A quick fix should be marked preferred if it properly addresses the underlying error. - -- A refactoring should be marked preferred if it is the most reasonable choice of actions to take. - -- - -- Since LSP 3.15.0 - _isPreferred :: Maybe Bool, - _disabled :: Maybe Reason, -- ^ Marks that the code action cannot currently be applied. - -- | The workspace edit this code action performs. - _edit :: Maybe WorkspaceEdit, - -- | A command this code action executes. If a code action - -- provides an edit and a command, first the edit is - -- executed and then the command. - _command :: Maybe Command, - -- | A data entry field that is preserved on a code action between - -- a `textDocument/codeAction` and a `codeAction/resolve` request. - -- - -- @since 3.16.0 - _xdata :: Maybe Value - } - deriving (Read, Show, Eq) -deriveJSON lspOptions ''CodeAction diff --git a/lsp-types/src/Language/LSP/Types/CodeLens.hs b/lsp-types/src/Language/LSP/Types/CodeLens.hs deleted file mode 100644 index 86ec9580f..000000000 --- a/lsp-types/src/Language/LSP/Types/CodeLens.hs +++ /dev/null @@ -1,64 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} - -module Language.LSP.Types.CodeLens where - -import Data.Aeson -import Data.Aeson.TH -import Language.LSP.Types.Command -import Language.LSP.Types.Location -import Language.LSP.Types.Progress -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils - --- ------------------------------------- - -data CodeLensClientCapabilities = - CodeLensClientCapabilities - { -- | Whether code lens supports dynamic registration. - _dynamicRegistration :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''CodeLensClientCapabilities - --- ------------------------------------- - -makeExtendingDatatype "CodeLensOptions" [''WorkDoneProgressOptions] - [ ("_resolveProvider", [t| Maybe Bool |] )] -deriveJSON lspOptions ''CodeLensOptions - -makeExtendingDatatype "CodeLensRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''CodeLensOptions - ] [] -deriveJSON lspOptions ''CodeLensRegistrationOptions - --- ------------------------------------- - -makeExtendingDatatype "CodeLensParams" - [ ''WorkDoneProgressParams, - ''PartialResultParams - ] - [("_textDocument", [t|TextDocumentIdentifier|])] -deriveJSON lspOptions ''CodeLensParams - --- ------------------------------------- - --- | 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. -data CodeLens = - 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 :: Maybe Command - , -- | A data entry field that is preserved on a code lens item between - -- a code lens and a code lens resolve request. - _xdata :: Maybe Value - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''CodeLens diff --git a/lsp-types/src/Language/LSP/Types/Command.hs b/lsp-types/src/Language/LSP/Types/Command.hs deleted file mode 100644 index c1c54cd34..000000000 --- a/lsp-types/src/Language/LSP/Types/Command.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} - -module Language.LSP.Types.Command where - -import Data.Aeson -import Data.Aeson.TH -import Data.Text -import Language.LSP.Types.Common -import Language.LSP.Types.Progress -import Language.LSP.Types.Utils - --- ------------------------------------- - -data ExecuteCommandClientCapabilities = - ExecuteCommandClientCapabilities - { _dynamicRegistration :: Maybe Bool -- ^Execute command supports dynamic - -- registration. - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''ExecuteCommandClientCapabilities - --- ------------------------------------- - -makeExtendingDatatype "ExecuteCommandOptions" [''WorkDoneProgressOptions] - [("_commands", [t| List Text |])] -deriveJSON lspOptions ''ExecuteCommandOptions - -makeExtendingDatatype "ExecuteCommandRegistrationOptions" [''ExecuteCommandOptions] [] -deriveJSON lspOptions ''ExecuteCommandRegistrationOptions - --- ------------------------------------- - -makeExtendingDatatype "ExecuteCommandParams" [''WorkDoneProgressParams] - [ ("_command", [t| Text |]) - , ("_arguments", [t| Maybe (List Value) |]) - ] -deriveJSON lspOptions ''ExecuteCommandParams - -data Command = - Command - { -- | Title of the command, like @save@. - _title :: Text - , -- | The identifier of the actual command handler. - _command :: Text - , -- | Arguments that the command handler should be invoked with. - _arguments :: Maybe (List Value) - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''Command - diff --git a/lsp-types/src/Language/LSP/Types/Common.hs b/lsp-types/src/Language/LSP/Types/Common.hs deleted file mode 100644 index 36ad58d43..000000000 --- a/lsp-types/src/Language/LSP/Types/Common.hs +++ /dev/null @@ -1,103 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE TypeOperators #-} - --- | Common types that aren't in the specification -module Language.LSP.Types.Common ( - type (|?) (..) - , toEither - , List (..) - , Empty (..) - , Int32 - , UInt ) where - -import Control.Applicative -import Control.DeepSeq -import Data.Aeson -import Data.Hashable -import Data.Int (Int32) -import Data.Mod.Word -import Text.Read (Read(readPrec)) -import GHC.Generics hiding (UInt) -import GHC.TypeNats hiding (Mod) -import Data.Bifunctor (bimap) - --- | The "uinteger" type in the LSP spec. --- --- Unusually, this is a **31**-bit unsigned integer, not a 32-bit one. -newtype UInt = UInt (Mod (2^31)) - deriving newtype (Num, Bounded, Enum, Eq, Ord) - deriving stock (Generic) - deriving anyclass (NFData) - -instance Hashable UInt where hashWithSalt s (UInt n) = hashWithSalt s (unMod n) - -instance Show UInt where - show (UInt u) = show $ unMod u - -instance Read UInt where - readPrec = fromInteger <$> readPrec - -instance Real UInt where - toRational (UInt u) = toRational $ unMod u - -instance Integral UInt where - quotRem (UInt x) (UInt y) = bimap fromIntegral fromIntegral $ quotRem (unMod x) (unMod y) - toInteger (UInt u) = toInteger $ unMod u - -instance ToJSON UInt where - toJSON u = toJSON (toInteger u) - -instance FromJSON UInt where - parseJSON v = fromInteger <$> parseJSON v - --- | A terser, isomorphic data type for 'Either', that does not get tagged when --- converting to and from JSON. -data a |? b = InL a - | InR b - deriving (Read,Show,Eq,Ord,Generic) -infixr |? - -toEither :: a |? b -> Either a b -toEither (InL a) = Left a -toEither (InR b) = Right b - -instance (ToJSON a, ToJSON b) => ToJSON (a |? b) where - toJSON (InL x) = toJSON x - toJSON (InR x) = toJSON x - -instance (FromJSON a, FromJSON b) => FromJSON (a |? b) where - -- Important: Try to parse the **rightmost** type first, as in the specification - -- the more complex types tend to appear on the right of the |, i.e. - -- @colorProvider?: boolean | DocumentColorOptions | DocumentColorRegistrationOptions;@ - parseJSON v = InR <$> parseJSON v <|> InL <$> parseJSON v - -instance (NFData a, NFData b) => NFData (a |? b) - --- | All LSP types representing a list **must** use this type rather than '[]'. --- In particular this is necessary to change the 'FromJSON' instance to be compatible --- with Elisp (where empty lists show up as 'null') -newtype List a = List [a] - deriving stock (Traversable,Generic) - deriving newtype (Show,Read,Eq,Ord,Semigroup,Monoid,Functor,Foldable) - -instance NFData a => NFData (List a) - -instance (ToJSON a) => ToJSON (List a) where - toJSON (List ls) = toJSON ls - -instance (FromJSON a) => FromJSON (List a) where - parseJSON Null = return (List []) - parseJSON v = List <$> parseJSON v - -data Empty = Empty deriving (Eq,Ord,Show) -instance ToJSON Empty where - toJSON Empty = Null -instance FromJSON Empty where - parseJSON Null = pure Empty - parseJSON (Object o) | o == mempty = pure Empty - parseJSON _ = fail "expected 'null' or '{}'" diff --git a/lsp-types/src/Language/LSP/Types/Completion.hs b/lsp-types/src/Language/LSP/Types/Completion.hs deleted file mode 100644 index e1f17f168..000000000 --- a/lsp-types/src/Language/LSP/Types/Completion.hs +++ /dev/null @@ -1,418 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -module Language.LSP.Types.Completion where - -import qualified Data.Aeson as A -import Data.Aeson.TH -import Data.Scientific ( Scientific ) -import Data.Text ( Text ) -import Language.LSP.Types.Command -import Language.LSP.Types.Common -import Language.LSP.Types.MarkupContent -import Language.LSP.Types.Progress -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils -import Language.LSP.Types.WorkspaceEdit -import Language.LSP.Types.Location (Range) - -data CompletionItemKind = CiText - | CiMethod - | CiFunction - | CiConstructor - | CiField - | CiVariable - | CiClass - | CiInterface - | CiModule - | CiProperty - | CiUnit - | CiValue - | CiEnum - | CiKeyword - | CiSnippet - | CiColor - | CiFile - | CiReference - | CiFolder - | CiEnumMember - | CiConstant - | CiStruct - | CiEvent - | CiOperator - | CiTypeParameter - 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 - toJSON CiFolder = A.Number 19 - toJSON CiEnumMember = A.Number 20 - toJSON CiConstant = A.Number 21 - toJSON CiStruct = A.Number 22 - toJSON CiEvent = A.Number 23 - toJSON CiOperator = A.Number 24 - toJSON CiTypeParameter = A.Number 25 - -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 (A.Number 19) = pure CiFolder - parseJSON (A.Number 20) = pure CiEnumMember - parseJSON (A.Number 21) = pure CiConstant - parseJSON (A.Number 22) = pure CiStruct - parseJSON (A.Number 23) = pure CiEvent - parseJSON (A.Number 24) = pure CiOperator - parseJSON (A.Number 25) = pure CiTypeParameter - parseJSON _ = fail "CompletionItemKind" - -data CompletionItemTag - -- | Render a completion as obsolete, usually using a strike-out. - = CitDeprecated - | CitUnknown Scientific - deriving (Eq, Ord, Show, Read) - -instance A.ToJSON CompletionItemTag where - toJSON CitDeprecated = A.Number 1 - toJSON (CitUnknown i) = A.Number i - -instance A.FromJSON CompletionItemTag where - parseJSON (A.Number 1) = pure CitDeprecated - parseJSON _ = fail "CompletionItemTag" - -data CompletionItemTagsClientCapabilities = - CompletionItemTagsClientCapabilities - { -- | The tag supported by the client. - _valueSet :: List CompletionItemTag - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''CompletionItemTagsClientCapabilities - -data CompletionItemResolveClientCapabilities = - CompletionItemResolveClientCapabilities - { -- | The properties that a client can resolve lazily. - _properties :: List Text - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''CompletionItemResolveClientCapabilities - -{-| -How whitespace and indentation is handled during completion -item insertion. - -@since 3.16.0 --} -data InsertTextMode = - -- | The insertion or replace strings is taken as it is. If the - -- value is multi line the lines below the cursor will be - -- inserted using the indentation defined in the string value. - -- The client will not apply any kind of adjustments to the - -- string. - AsIs - -- | The editor adjusts leading whitespace of new lines so that - -- they match the indentation up to the cursor of the line for - -- which the item is accepted. - -- - -- Consider a line like this: <2tabs><3tabs>foo. Accepting a - -- multi line completion item is indented using 2 tabs and all - -- following lines inserted will be indented using 2 tabs as well. - | AdjustIndentation - deriving (Read,Show,Eq) - -instance A.ToJSON InsertTextMode where - toJSON AsIs = A.Number 1 - toJSON AdjustIndentation = A.Number 2 - -instance A.FromJSON InsertTextMode where - parseJSON (A.Number 1) = pure AsIs - parseJSON (A.Number 2) = pure AdjustIndentation - parseJSON _ = fail "InsertTextMode" - -data CompletionItemInsertTextModeClientCapabilities = - CompletionItemInsertTextModeClientCapabilities - { _valueSet :: List InsertTextMode - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''CompletionItemInsertTextModeClientCapabilities - -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 - - -- | Client supports commit characters on a completion item. - , _commitCharactersSupport :: Maybe Bool - - -- | Client supports the follow content formats for the documentation - -- property. The order describes the preferred format of the client. - , _documentationFormat :: Maybe (List MarkupKind) - - -- | Client supports the deprecated property on a completion item. - , _deprecatedSupport :: Maybe Bool - - -- | Client supports the preselect property on a completion item. - , _preselectSupport :: Maybe Bool - - -- | Client supports the tag property on a completion item. Clients - -- supporting tags have to handle unknown tags gracefully. Clients - -- especially need to preserve unknown tags when sending a - -- completion item back to the server in a resolve call. - -- - -- @since 3.15.0 - , _tagSupport :: Maybe CompletionItemTagsClientCapabilities - -- | Client supports insert replace edit to control different behavior if - -- completion item is inserted in the text or should replace text. - -- - -- @since 3.16.0 - , _insertReplaceSupport :: Maybe Bool - -- | Indicates which properties a client can resolve lazily on a - -- completion item. Before version 3.16.0 only the predefined properties - -- `documentation` and `details` could be resolved lazily. - -- - -- @since 3.16.0 - , _resolveSupport :: Maybe CompletionItemResolveClientCapabilities - -- | The client supports the `insertTextMode` property on - -- a completion item to override the whitespace handling mode - -- as defined by the client (see `insertTextMode`). - -- - -- @since 3.16.0 - , _insertTextModeSupport :: Maybe CompletionItemInsertTextModeClientCapabilities - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''CompletionItemClientCapabilities - -data CompletionItemKindClientCapabilities = - CompletionItemKindClientCapabilities - { -- | The completion item kind values the client supports. When this - -- property exists the client also guarantees that it will - -- handle values outside its set gracefully and falls back - -- to a default value when unknown. - _valueSet :: Maybe (List CompletionItemKind) - } - deriving (Show, Read, Eq) - -deriveJSON lspOptions ''CompletionItemKindClientCapabilities - -data CompletionClientCapabilities = - CompletionClientCapabilities - { _dynamicRegistration :: Maybe Bool -- ^ Whether completion supports dynamic - -- registration. - , _completionItem :: Maybe CompletionItemClientCapabilities - , _completionItemKind :: Maybe CompletionItemKindClientCapabilities - , _contextSupport :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''CompletionClientCapabilities - --- ------------------------------------- - -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 _ = fail "InsertTextFormat" - -data CompletionDoc = CompletionDocString Text - | CompletionDocMarkup MarkupContent - deriving (Show, Read, Eq) - -deriveJSON lspOptionsUntagged ''CompletionDoc - -data InsertReplaceEdit = - InsertReplaceEdit - { _newText :: Text -- ^ The string to be inserted. - , _insert :: Range -- ^ The range if the insert is requested - , _repalce :: Range -- ^ The range if the replace is requested. - } - deriving (Read,Show,Eq) -deriveJSON lspOptions ''InsertReplaceEdit - -data CompletionEdit = CompletionEditText TextEdit | CompletionEditInsertReplace InsertReplaceEdit - deriving (Read,Show,Eq) - -deriveJSON lspOptionsUntagged ''CompletionEdit - -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 - , _tags :: Maybe (List CompletionItemTag) -- ^ Tags for this completion item. - , _detail :: Maybe Text -- ^ A human-readable string with additional - -- information about this item, like type or - -- symbol information. - , _documentation :: Maybe CompletionDoc -- ^ A human-readable string that represents - -- a doc-comment. - , _deprecated :: Maybe Bool -- ^ Indicates if this item is deprecated. - , _preselect :: Maybe Bool - -- ^ Select this item when showing. - -- *Note* that only one completion item can be selected and that the - -- tool / client decides which item that is. The rule is that the *first* - -- item of those that match best is selected. - , _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`. - , _insertTextMode :: Maybe InsertTextMode - -- ^ How whitespace and indentation is handled during completion - -- item insertion. If not provided the client's default value depends on - -- the @textDocument.completion.insertTextMode@ client capability. - , _textEdit :: Maybe CompletionEdit - -- ^ 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. - , _commitCharacters :: Maybe (List Text) - -- ^ An optional set of characters that when pressed while this completion - -- is active will accept it first and then type that character. *Note* - -- that all commit characters should have `length=1` and that superfluous - -- characters will be ignored. - , _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 ''CompletionItem - --- | Represents a collection of 'CompletionItem's to be presented in the editor. -data CompletionList = - CompletionList - { _isIncomplete :: Bool -- ^ This list it not complete. Further typing - -- should result in recomputing this list. - , _items :: List CompletionItem -- ^ The completion items. - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''CompletionList - --- | How a completion was triggered -data CompletionTriggerKind = -- | Completion was triggered by typing an identifier (24x7 code - -- complete), manual invocation (e.g Ctrl+Space) or via API. - CtInvoked - -- | Completion was triggered by a trigger character specified by - -- the `triggerCharacters` properties of the `CompletionRegistrationOptions`. - | CtTriggerCharacter - -- | Completion was re-triggered as the current completion list is incomplete. - | CtTriggerForIncompleteCompletions - -- | An unknown 'CompletionTriggerKind' not yet supported in haskell-lsp. - | CtUnknown Scientific - deriving (Read, Show, Eq) - -instance A.ToJSON CompletionTriggerKind where - toJSON CtInvoked = A.Number 1 - toJSON CtTriggerCharacter = A.Number 2 - toJSON CtTriggerForIncompleteCompletions = A.Number 3 - toJSON (CtUnknown x) = A.Number x - -instance A.FromJSON CompletionTriggerKind where - parseJSON (A.Number 1) = pure CtInvoked - parseJSON (A.Number 2) = pure CtTriggerCharacter - parseJSON (A.Number 3) = pure CtTriggerForIncompleteCompletions - parseJSON (A.Number x) = pure (CtUnknown x) - parseJSON _ = fail "CompletionTriggerKind" - -makeExtendingDatatype "CompletionOptions" [''WorkDoneProgressOptions] - [ ("_triggerCharacters", [t| Maybe [Text] |]) - , ("_allCommitCharacters", [t| Maybe [Text] |]) - , ("_resolveProvider", [t| Maybe Bool|]) - ] -deriveJSON lspOptions ''CompletionOptions - -makeExtendingDatatype "CompletionRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''CompletionOptions - ] - [] -deriveJSON lspOptions ''CompletionRegistrationOptions - -data CompletionContext = - CompletionContext - { _triggerKind :: CompletionTriggerKind -- ^ How the completion was triggered. - , _triggerCharacter :: Maybe Text - -- ^ The trigger character (a single character) that has trigger code complete. - -- Is undefined if `triggerKind !== CompletionTriggerKind.TriggerCharacter` - } - deriving (Read, Show, Eq) - -deriveJSON lspOptions ''CompletionContext - -makeExtendingDatatype "CompletionParams" - [ ''TextDocumentPositionParams - , ''WorkDoneProgressParams - , ''PartialResultParams - ] - [ ("_context", [t| Maybe CompletionContext |]) ] -deriveJSON lspOptions ''CompletionParams - diff --git a/lsp-types/src/Language/LSP/Types/Configuration.hs b/lsp-types/src/Language/LSP/Types/Configuration.hs deleted file mode 100644 index a33860dbd..000000000 --- a/lsp-types/src/Language/LSP/Types/Configuration.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Language.LSP.Types.Configuration where - -import Data.Aeson -import Data.Aeson.TH -import Data.Text (Text) -import Language.LSP.Types.Common -import Language.LSP.Types.Utils - --- ------------------------------------- - -data DidChangeConfigurationClientCapabilities = - DidChangeConfigurationClientCapabilities - { _dynamicRegistration :: Maybe Bool -- ^Did change configuration - -- notification supports dynamic - -- registration. - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''DidChangeConfigurationClientCapabilities - -data DidChangeConfigurationParams = - DidChangeConfigurationParams - { _settings :: Value -- ^ The actual changed settings - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''DidChangeConfigurationParams - --- --------------------------------------------------------------------- - -data ConfigurationItem = - ConfigurationItem - { _scopeUri :: Maybe Text -- ^ The scope to get the configuration section for. - , _section :: Maybe Text -- ^ The configuration section asked for. - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''ConfigurationItem - -data ConfigurationParams = - ConfigurationParams - { _items :: List ConfigurationItem - } deriving (Show, Read, Eq) -deriveJSON lspOptions ''ConfigurationParams diff --git a/lsp-types/src/Language/LSP/Types/Declaration.hs b/lsp-types/src/Language/LSP/Types/Declaration.hs deleted file mode 100644 index 00ba8747e..000000000 --- a/lsp-types/src/Language/LSP/Types/Declaration.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} - -module Language.LSP.Types.Declaration where - -import Data.Aeson.TH -import Language.LSP.Types.Progress -import Language.LSP.Types.StaticRegistrationOptions -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils - -data DeclarationClientCapabilities = - DeclarationClientCapabilities - { -- | Whether declaration supports dynamic registration. If this is set to 'true' - -- the client supports the new 'DeclarationRegistrationOptions' return value - -- for the corresponding server capability as well. - _dynamicRegistration :: Maybe Bool - -- | The client supports additional metadata in the form of declaration links. - , _linkSupport :: Maybe Bool - } - deriving (Read, Show, Eq) -deriveJSON lspOptions ''DeclarationClientCapabilities - -makeExtendingDatatype "DeclarationOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''DeclarationOptions - -makeExtendingDatatype "DeclarationRegistrationOptions" - [ ''DeclarationOptions - , ''TextDocumentRegistrationOptions - , ''StaticRegistrationOptions - ] [] -deriveJSON lspOptions ''DeclarationRegistrationOptions - -makeExtendingDatatype "DeclarationParams" - [ ''TextDocumentPositionParams - , ''WorkDoneProgressParams - , ''PartialResultParams - ] [] -deriveJSON lspOptions ''DeclarationParams diff --git a/lsp-types/src/Language/LSP/Types/Definition.hs b/lsp-types/src/Language/LSP/Types/Definition.hs deleted file mode 100644 index 1e308680c..000000000 --- a/lsp-types/src/Language/LSP/Types/Definition.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} - -module Language.LSP.Types.Definition where - -import Data.Aeson.TH -import Language.LSP.Types.Progress -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils - -data DefinitionClientCapabilities = - DefinitionClientCapabilities - { -- | Whether definition supports dynamic registration. - _dynamicRegistration :: Maybe Bool - -- | The client supports additional metadata in the form of definition - -- links. - -- Since LSP 3.14.0 - , _linkSupport :: Maybe Bool - } deriving (Show, Read, Eq) -deriveJSON lspOptions ''DefinitionClientCapabilities - -makeExtendingDatatype "DefinitionOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''DefinitionOptions - -makeExtendingDatatype "DefinitionRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''DefinitionOptions - ] [] -deriveJSON lspOptions ''DefinitionRegistrationOptions - -makeExtendingDatatype "DefinitionParams" - [ ''TextDocumentPositionParams - , ''WorkDoneProgressParams - , ''PartialResultParams - ] [] -deriveJSON lspOptions ''DefinitionParams diff --git a/lsp-types/src/Language/LSP/Types/Diagnostic.hs b/lsp-types/src/Language/LSP/Types/Diagnostic.hs deleted file mode 100644 index 4d17b1ba9..000000000 --- a/lsp-types/src/Language/LSP/Types/Diagnostic.hs +++ /dev/null @@ -1,139 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} - -module Language.LSP.Types.Diagnostic where - -import Control.DeepSeq -import qualified Data.Aeson as A -import Data.Aeson.TH -import Data.Text -import GHC.Generics hiding (UInt) -import Language.LSP.Types.Common -import Language.LSP.Types.Location -import Language.LSP.Types.Uri -import Language.LSP.Types.Utils - --- --------------------------------------------------------------------- - -data DiagnosticSeverity - = DsError -- ^ Error = 1, - | DsWarning -- ^ Warning = 2, - | DsInfo -- ^ Info = 3, - | DsHint -- ^ Hint = 4 - deriving (Eq,Ord,Show,Read, Generic) - -instance NFData DiagnosticSeverity - -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 _ = fail "DiagnosticSeverity" - -data DiagnosticTag - -- | Unused or unnecessary code. - -- - -- Clients are allowed to render diagnostics with this tag faded out - -- instead of having an error squiggle. - = DtUnnecessary - -- | Deprecated or obsolete code. - -- - -- Clients are allowed to rendered diagnostics with this tag strike - -- through. - | DtDeprecated - deriving (Eq, Ord, Show, Read, Generic) - -instance NFData DiagnosticTag - -instance A.ToJSON DiagnosticTag where - toJSON DtUnnecessary = A.Number 1 - toJSON DtDeprecated = A.Number 2 - -instance A.FromJSON DiagnosticTag where - parseJSON (A.Number 1) = pure DtUnnecessary - parseJSON (A.Number 2) = pure DtDeprecated - parseJSON _ = fail "DiagnosticTag" - --- --------------------------------------------------------------------- - -data DiagnosticRelatedInformation = - DiagnosticRelatedInformation - { _location :: Location - , _message :: Text - } deriving (Show, Read, Eq, Ord, Generic) - -instance NFData DiagnosticRelatedInformation - -deriveJSON lspOptions ''DiagnosticRelatedInformation - --- --------------------------------------------------------------------- - -type DiagnosticSource = Text -data Diagnostic = - Diagnostic - { _range :: Range - , _severity :: Maybe DiagnosticSeverity - , _code :: Maybe (Int32 |? Text) - , _source :: Maybe DiagnosticSource - , _message :: Text - , _tags :: Maybe (List DiagnosticTag) - , _relatedInformation :: Maybe (List DiagnosticRelatedInformation) - } deriving (Show, Read, Eq, Ord, Generic) - -instance NFData Diagnostic - -deriveJSON lspOptions ''Diagnostic - --- ------------------------------------- - -data PublishDiagnosticsTagsClientCapabilities = - PublishDiagnosticsTagsClientCapabilities - { -- | The tags supported by the client. - _valueSet :: List DiagnosticTag - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''PublishDiagnosticsTagsClientCapabilities - -data PublishDiagnosticsClientCapabilities = - PublishDiagnosticsClientCapabilities - { -- | Whether the clients accepts diagnostics with related information. - _relatedInformation :: Maybe Bool - -- | Client supports the tag property to provide metadata about a - -- diagnostic. - -- - -- Clients supporting tags have to handle unknown tags gracefully. - -- - -- Since LSP 3.15.0 - , _tagSupport :: Maybe PublishDiagnosticsTagsClientCapabilities - -- | Whether the client interprets the version property of the - -- @textDocument/publishDiagnostics@ notification's parameter. - -- - -- Since LSP 3.15.0 - , _versionSupport :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''PublishDiagnosticsClientCapabilities - -data PublishDiagnosticsParams = - PublishDiagnosticsParams - { -- | The URI for which diagnostic information is reported. - _uri :: Uri - -- | Optional the version number of the document the diagnostics are - -- published for. - -- - -- Since LSP 3.15.0 - , _version :: Maybe UInt - -- | An array of diagnostic information items. - , _diagnostics :: List Diagnostic - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''PublishDiagnosticsParams diff --git a/lsp-types/src/Language/LSP/Types/DocumentColor.hs b/lsp-types/src/Language/LSP/Types/DocumentColor.hs deleted file mode 100644 index 50b0fa7f3..000000000 --- a/lsp-types/src/Language/LSP/Types/DocumentColor.hs +++ /dev/null @@ -1,91 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} -module Language.LSP.Types.DocumentColor where - -import Data.Aeson.TH -import Data.Text (Text) -import Language.LSP.Types.Common -import Language.LSP.Types.Location -import Language.LSP.Types.Progress -import Language.LSP.Types.StaticRegistrationOptions -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils -import Language.LSP.Types.WorkspaceEdit - -data DocumentColorClientCapabilities = - DocumentColorClientCapabilities - { -- | Whether document color supports dynamic registration. - _dynamicRegistration :: Maybe Bool - } deriving (Read, Show, Eq) -deriveJSON lspOptions ''DocumentColorClientCapabilities - --- ------------------------------------- - -makeExtendingDatatype "DocumentColorOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''DocumentColorOptions - -makeExtendingDatatype "DocumentColorRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''StaticRegistrationOptions - , ''DocumentColorOptions - ] [] -deriveJSON lspOptions ''DocumentColorRegistrationOptions - --- ------------------------------------- - -makeExtendingDatatype "DocumentColorParams" - [ ''WorkDoneProgressParams - , ''PartialResultParams - ] - [("_textDocument", [t| TextDocumentIdentifier |])] -deriveJSON lspOptions ''DocumentColorParams - --- ------------------------------------- - --- | Represents a color in RGBA space. -data Color = - Color - { _red :: Float -- ^ The red component of this color in the range [0-1]. - , _green :: Float -- ^ The green component of this color in the range [0-1]. - , _blue :: Float -- ^ The blue component of this color in the range [0-1]. - , _alpha :: Float -- ^ The alpha component of this color in the range [0-1]. - } deriving (Read, Show, Eq) -deriveJSON lspOptions ''Color - -data ColorInformation = - ColorInformation - { _range :: Range -- ^ The range in the document where this color appears. - , _color :: Color -- ^ The actual color value for this color range. - } deriving (Read, Show, Eq) -deriveJSON lspOptions ''ColorInformation - --- ------------------------------------- - -makeExtendingDatatype "ColorPresentationParams" - [ ''WorkDoneProgressParams - , ''PartialResultParams - ] - [ ("_textDocument", [t| TextDocumentIdentifier |]) - , ("_color", [t| Color |]) - , ("_range", [t| Range |]) - ] -deriveJSON lspOptions ''ColorPresentationParams - --- ------------------------------------- - -data ColorPresentation = - ColorPresentation - { -- | The label of this color presentation. It will be shown on the color - -- picker header. By default this is also the text that is inserted when selecting - -- this color presentation. - _label :: Text - -- | A 'TextEdit' which is applied to a document when selecting - -- this presentation for the color. When `falsy` the '_label' - -- is used. - , _textEdit :: Maybe TextEdit - -- | An optional array of additional 'TextEdit's that are applied when - -- selecting this color presentation. Edits must not overlap with the main - -- '_textEdit' nor with themselves. - , _additionalTextEdits :: Maybe (List TextEdit) - } deriving (Read, Show, Eq) -deriveJSON lspOptions ''ColorPresentation diff --git a/lsp-types/src/Language/LSP/Types/DocumentFilter.hs b/lsp-types/src/Language/LSP/Types/DocumentFilter.hs deleted file mode 100644 index 49ac85924..000000000 --- a/lsp-types/src/Language/LSP/Types/DocumentFilter.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Language.LSP.Types.DocumentFilter where - -import Data.Aeson.TH -import Data.Text ( Text ) -import Language.LSP.Types.Common -import Language.LSP.Types.Utils - --- --------------------------------------------------------------------- - -data DocumentFilter = - DocumentFilter - { -- | A language id, like `typescript`. - _language :: Maybe Text - -- | A Uri scheme, like @file@ or @untitled@. - , _scheme :: Maybe Text - , -- | A glob pattern, like `*.{ts,js}`. - -- - -- Glob patterns can have the following syntax: - -- - @*@ to match one or more characters in a path segment - -- - @?@ to match on one character in a path segment - -- - @**@ to match any number of path segments, including none - -- - @{}@ to group conditions (e.g. @**​/*.{ts,js}@ matches all TypeScript and JavaScript files) - -- - @[]@ to declare a range of characters to match in a path segment (e.g., @example.[0-9]@ to match on @example.0@, @example.1@, …) - -- - @[!...]@ to negate a range of characters to match in a path segment (e.g., @example.[!0-9]@ to match on @example.a@, @example.b@, but not @example.0@) - _pattern :: Maybe Text - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''DocumentFilter - -{- -A document selector is the combination of one or many document filters. - -export type DocumentSelector = DocumentFilter[]; --} -type DocumentSelector = List DocumentFilter diff --git a/lsp-types/src/Language/LSP/Types/DocumentHighlight.hs b/lsp-types/src/Language/LSP/Types/DocumentHighlight.hs deleted file mode 100644 index a6dce6556..000000000 --- a/lsp-types/src/Language/LSP/Types/DocumentHighlight.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} -module Language.LSP.Types.DocumentHighlight where - -import Data.Aeson -import Data.Aeson.TH -import Language.LSP.Types.Location -import Language.LSP.Types.Progress -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils - --- ------------------------------------- - -data DocumentHighlightClientCapabilities = - DocumentHighlightClientCapabilities - { -- | Whether document highlight supports dynamic registration. - _dynamicRegistration :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''DocumentHighlightClientCapabilities - -makeExtendingDatatype "DocumentHighlightOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''DocumentHighlightOptions - -makeExtendingDatatype "DocumentHighlightRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''DocumentHighlightOptions - ] [] -deriveJSON lspOptions ''DocumentHighlightRegistrationOptions - -makeExtendingDatatype "DocumentHighlightParams" - [ ''TextDocumentPositionParams - , ''WorkDoneProgressParams - , ''PartialResultParams - ] [] -deriveJSON lspOptions ''DocumentHighlightParams - -data DocumentHighlightKind - = -- | A textual occurrence. - HkText - | -- | Read-access of a symbol, like reading a variable. - HkRead - | -- | Write-access of a symbol, like writing to a variable. - HkWrite - deriving (Read, Show, Eq) - -instance ToJSON DocumentHighlightKind where - toJSON HkText = Number 1 - toJSON HkRead = Number 2 - toJSON HkWrite = Number 3 - -instance FromJSON DocumentHighlightKind where - parseJSON (Number 1) = pure HkText - parseJSON (Number 2) = pure HkRead - parseJSON (Number 3) = pure HkWrite - parseJSON _ = mempty "DocumentHighlightKind" - --- ------------------------------------- - --- | 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. -data DocumentHighlight = - DocumentHighlight - { -- | The range this highlight applies to. - _range :: Range - -- | The highlight kind, default is 'HkText'. - , _kind :: Maybe DocumentHighlightKind - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''DocumentHighlight diff --git a/lsp-types/src/Language/LSP/Types/DocumentLink.hs b/lsp-types/src/Language/LSP/Types/DocumentLink.hs deleted file mode 100644 index 494ade1e7..000000000 --- a/lsp-types/src/Language/LSP/Types/DocumentLink.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} - -module Language.LSP.Types.DocumentLink where - -import Data.Aeson -import Data.Aeson.TH -import Language.LSP.Types.Location -import Language.LSP.Types.Progress -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Uri -import Language.LSP.Types.Utils -import Data.Text (Text) - -data DocumentLinkClientCapabilities = - DocumentLinkClientCapabilities - { -- | Whether document link supports dynamic registration. - _dynamicRegistration :: Maybe Bool - -- | Whether the client supports the `tooltip` property on `DocumentLink`. - -- - -- Since LSP 3.15.0 - , _tooltipSupport :: Maybe Bool - } deriving (Read, Show, Eq) -deriveJSON lspOptions ''DocumentLinkClientCapabilities - --- ------------------------------------- - -makeExtendingDatatype "DocumentLinkOptions" [''WorkDoneProgressOptions] - [("_resolveProvider", [t| Maybe Bool |])] -deriveJSON lspOptions ''DocumentLinkOptions - -makeExtendingDatatype "DocumentLinkRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''DocumentLinkOptions - ] [] -deriveJSON lspOptions ''DocumentLinkRegistrationOptions - --- ------------------------------------- - -makeExtendingDatatype "DocumentLinkParams" - [ ''WorkDoneProgressParams - , ''PartialResultParams - ] - [("_textDocument", [t| TextDocumentIdentifier |])] -deriveJSON lspOptions ''DocumentLinkParams - --- ------------------------------------- - --- | 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. -data DocumentLink = - DocumentLink - { -- | The range this link applies to. - _range :: Range - -- | The uri this link points to. If missing a resolve request is sent - -- later. - , _target :: Maybe Uri - -- | The tooltip text when you hover over this link. - -- - -- If a tooltip is provided, is will be displayed in a string that includes - -- instructions on how to trigger the link, such as @{0} (ctrl + click)@. - -- The specific instructions vary depending on OS, user settings, and - -- localization. - -- - -- Since LSP 3.15.0 - , _tooltip :: Maybe Text - -- | A data entry field that is preserved on a document link between a - -- DocumentLinkRequest and a DocumentLinkResolveRequest. - , _xdata :: Maybe Value - } deriving (Read, Show, Eq) -deriveJSON lspOptions ''DocumentLink diff --git a/lsp-types/src/Language/LSP/Types/DocumentSymbol.hs b/lsp-types/src/Language/LSP/Types/DocumentSymbol.hs deleted file mode 100644 index 81a9866e1..000000000 --- a/lsp-types/src/Language/LSP/Types/DocumentSymbol.hs +++ /dev/null @@ -1,253 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} -module Language.LSP.Types.DocumentSymbol where - -import Data.Aeson -import Data.Aeson.TH -import Data.Scientific -import Data.Text (Text) - -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Common -import Language.LSP.Types.Location -import Language.LSP.Types.Progress -import Language.LSP.Types.Utils - --- --------------------------------------------------------------------- - -makeExtendingDatatype "DocumentSymbolOptions" - [''WorkDoneProgressOptions] - [ ("_label", [t| Maybe Bool |])] -deriveJSON lspOptions ''DocumentSymbolOptions - -makeExtendingDatatype "DocumentSymbolRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''DocumentSymbolOptions - ] [] -deriveJSON lspOptions ''DocumentSymbolRegistrationOptions - --- --------------------------------------------------------------------- - -makeExtendingDatatype "DocumentSymbolParams" - [ ''WorkDoneProgressParams - , ''PartialResultParams - ] - [ ("_textDocument", [t| TextDocumentIdentifier |])] -deriveJSON lspOptions ''DocumentSymbolParams - --- ------------------------------------- - -data SymbolKind - = SkFile - | SkModule - | SkNamespace - | SkPackage - | SkClass - | SkMethod - | SkProperty - | SkField - | SkConstructor - | SkEnum - | SkInterface - | SkFunction - | SkVariable - | SkConstant - | SkString - | SkNumber - | SkBoolean - | SkArray - | SkObject - | SkKey - | SkNull - | SkEnumMember - | SkStruct - | SkEvent - | SkOperator - | SkTypeParameter - | SkUnknown Scientific - deriving (Read,Show,Eq, Ord) - -instance ToJSON SymbolKind where - toJSON SkFile = Number 1 - toJSON SkModule = Number 2 - toJSON SkNamespace = Number 3 - toJSON SkPackage = Number 4 - toJSON SkClass = Number 5 - toJSON SkMethod = Number 6 - toJSON SkProperty = Number 7 - toJSON SkField = Number 8 - toJSON SkConstructor = Number 9 - toJSON SkEnum = Number 10 - toJSON SkInterface = Number 11 - toJSON SkFunction = Number 12 - toJSON SkVariable = Number 13 - toJSON SkConstant = Number 14 - toJSON SkString = Number 15 - toJSON SkNumber = Number 16 - toJSON SkBoolean = Number 17 - toJSON SkArray = Number 18 - toJSON SkObject = Number 19 - toJSON SkKey = Number 20 - toJSON SkNull = Number 21 - toJSON SkEnumMember = Number 22 - toJSON SkStruct = Number 23 - toJSON SkEvent = Number 24 - toJSON SkOperator = Number 25 - toJSON SkTypeParameter = Number 26 - toJSON (SkUnknown x) = Number x - -instance FromJSON SymbolKind where - parseJSON (Number 1) = pure SkFile - parseJSON (Number 2) = pure SkModule - parseJSON (Number 3) = pure SkNamespace - parseJSON (Number 4) = pure SkPackage - parseJSON (Number 5) = pure SkClass - parseJSON (Number 6) = pure SkMethod - parseJSON (Number 7) = pure SkProperty - parseJSON (Number 8) = pure SkField - parseJSON (Number 9) = pure SkConstructor - parseJSON (Number 10) = pure SkEnum - parseJSON (Number 11) = pure SkInterface - parseJSON (Number 12) = pure SkFunction - parseJSON (Number 13) = pure SkVariable - parseJSON (Number 14) = pure SkConstant - parseJSON (Number 15) = pure SkString - parseJSON (Number 16) = pure SkNumber - parseJSON (Number 17) = pure SkBoolean - parseJSON (Number 18) = pure SkArray - parseJSON (Number 19) = pure SkObject - parseJSON (Number 20) = pure SkKey - parseJSON (Number 21) = pure SkNull - parseJSON (Number 22) = pure SkEnumMember - parseJSON (Number 23) = pure SkStruct - parseJSON (Number 24) = pure SkEvent - parseJSON (Number 25) = pure SkOperator - parseJSON (Number 26) = pure SkTypeParameter - parseJSON (Number x) = pure (SkUnknown x) - parseJSON _ = fail "SymbolKind" - -{-| -Symbol tags are extra annotations that tweak the rendering of a symbol. - -@since 3.16.0 --} -data SymbolTag = - StDeprecated -- ^ Render a symbol as obsolete, usually using a strike-out. - | StUnknown Scientific - deriving (Read, Show, Eq, Ord) - -instance ToJSON SymbolTag where - toJSON StDeprecated = Number 1 - toJSON (StUnknown x) = Number x - -instance FromJSON SymbolTag where - parseJSON (Number 1) = pure StDeprecated - parseJSON (Number x) = pure (StUnknown x) - parseJSON _ = fail "SymbolTag" - --- ------------------------------------- - -data DocumentSymbolKindClientCapabilities = - DocumentSymbolKindClientCapabilities - { -- | The symbol kind values the client supports. When this - -- property exists the client also guarantees that it will - -- handle values outside its set gracefully and falls back - -- to a default value when unknown. - -- - -- If this property is not present the client only supports - -- the symbol kinds from `File` to `Array` as defined in - -- the initial version of the protocol. - _valueSet :: Maybe (List SymbolKind) - } - deriving (Show, Read, Eq) - -deriveJSON lspOptions ''DocumentSymbolKindClientCapabilities - -data DocumentSymbolTagClientCapabilities = - DocumentSymbolTagClientCapabilities - { -- | The tags supported by the client. - _valueSet :: Maybe (List SymbolTag) - } - deriving (Show, Read, Eq) - -deriveJSON lspOptions ''DocumentSymbolTagClientCapabilities - -data DocumentSymbolClientCapabilities = - DocumentSymbolClientCapabilities - { -- | Whether document symbol supports dynamic registration. - _dynamicRegistration :: Maybe Bool - -- | Specific capabilities for the `SymbolKind`. - , _symbolKind :: Maybe DocumentSymbolKindClientCapabilities - , _hierarchicalDocumentSymbolSupport :: Maybe Bool - -- | The client supports tags on `SymbolInformation`. - -- Clients supporting tags have to handle unknown tags gracefully. - -- - -- @since 3.16.0 - , _tagSupport :: Maybe DocumentSymbolTagClientCapabilities - -- | The client supports an additional label presented in the UI when - -- registering a document symbol provider. - -- - -- @since 3.16.0 - , _labelSupport :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''DocumentSymbolClientCapabilities - --- --------------------------------------------------------------------- - --- | Represents programming constructs like variables, classes, interfaces etc. --- that appear in a document. Document symbols can be hierarchical and they --- have two ranges: one that encloses its definition and one that points to its --- most interesting range, e.g. the range of an identifier. -data DocumentSymbol = - DocumentSymbol - { _name :: Text -- ^ The name of this symbol. - -- | More detail for this symbol, e.g the signature of a function. If not - -- provided the name is used. - , _detail :: Maybe Text - , _kind :: SymbolKind -- ^ The kind of this symbol. - , _tags :: Maybe (List SymbolTag) -- ^ Tags for this document symbol. - , _deprecated :: Maybe Bool -- ^ Indicates if this symbol is deprecated. Deprecated, use tags instead. - -- | The range enclosing this symbol not including leading/trailing - -- whitespace but everything else like comments. This information is - -- typically used to determine if the the clients cursor is inside the symbol - -- to reveal in the symbol in the UI. - , _range :: Range - -- | The range that should be selected and revealed when this symbol is being - -- picked, e.g the name of a function. Must be contained by the the '_range'. - , _selectionRange :: Range - -- | Children of this symbol, e.g. properties of a class. - , _children :: Maybe (List DocumentSymbol) - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''DocumentSymbol - --- --------------------------------------------------------------------- - --- | Represents information about programming constructs like variables, classes, --- interfaces etc. -data SymbolInformation = - SymbolInformation - { _name :: Text -- ^ The name of this symbol. - , _kind :: SymbolKind -- ^ The kind of this symbol. - , _tags :: Maybe (List SymbolTag) -- ^ Tags for this symbol. - , _deprecated :: Maybe Bool -- ^ Indicates if this symbol is deprecated. Deprecated, use tags instead. - -- | The location of this symbol. The location's range is used by a tool - -- to reveal the location in the editor. If the symbol is selected in the - -- tool the range's start information is used to position the cursor. So - -- the range usually spans more then the actual symbol's name and does - -- normally include things like visibility modifiers. - -- - -- The range doesn't have to denote a node range in the sense of a abstract - -- syntax tree. It can therefore not be used to re-construct a hierarchy of - -- the symbols. - , _location :: Location - -- | The name of the symbol containing this symbol. This information is for - -- user interface purposes (e.g. to render a qualifier in the user interface - -- if necessary). It can't be used to re-infer a hierarchy for the document - -- symbols. - , _containerName :: Maybe Text - } deriving (Read,Show,Eq) -{-# DEPRECATED _deprecated "Use tags instead" #-} - -deriveJSON lspOptions ''SymbolInformation diff --git a/lsp-types/src/Language/LSP/Types/FoldingRange.hs b/lsp-types/src/Language/LSP/Types/FoldingRange.hs deleted file mode 100644 index c89a4d010..000000000 --- a/lsp-types/src/Language/LSP/Types/FoldingRange.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} -module Language.LSP.Types.FoldingRange where - -import qualified Data.Aeson as A -import Data.Aeson.TH -import Data.Text (Text) -import Language.LSP.Types.Common -import Language.LSP.Types.Progress -import Language.LSP.Types.StaticRegistrationOptions -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils - - --- ------------------------------------- - -data FoldingRangeClientCapabilities = - FoldingRangeClientCapabilities - { -- | Whether implementation supports dynamic registration for folding range - -- providers. If this is set to `true` the client supports the new - -- `(FoldingRangeProviderOptions & TextDocumentRegistrationOptions & StaticRegistrationOptions)` - -- return value for the corresponding server capability as well. - _dynamicRegistration :: Maybe Bool - -- | The maximum number of folding ranges that the client prefers to receive - -- per document. The value serves as a hint, servers are free to follow the limit. - , _rangeLimit :: Maybe UInt - -- | If set, the client signals that it only supports folding complete lines. If set, - -- client will ignore specified `startCharacter` and `endCharacter` properties in a - -- FoldingRange. - , _lineFoldingOnly :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''FoldingRangeClientCapabilities - -makeExtendingDatatype "FoldingRangeOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''FoldingRangeOptions - -makeExtendingDatatype "FoldingRangeRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''FoldingRangeOptions - , ''StaticRegistrationOptions - ] [] -deriveJSON lspOptions ''FoldingRangeRegistrationOptions - - -makeExtendingDatatype "FoldingRangeParams" - [ ''WorkDoneProgressParams - , ''PartialResultParams - ] - [("_textDocument", [t| TextDocumentIdentifier |])] -deriveJSON lspOptions ''FoldingRangeParams - --- | Enum of known range kinds -data FoldingRangeKind = FoldingRangeComment - -- ^ Folding range for a comment - | FoldingRangeImports - -- ^ Folding range for a imports or includes - | FoldingRangeRegion - -- ^ Folding range for a region (e.g. #region) - | FoldingRangeUnknown Text - -- ^ Folding range that haskell-lsp-types does - -- not yet support - deriving (Read, Show, Eq) - -instance A.ToJSON FoldingRangeKind where - toJSON FoldingRangeComment = A.String "comment" - toJSON FoldingRangeImports = A.String "imports" - toJSON FoldingRangeRegion = A.String "region" - toJSON (FoldingRangeUnknown x) = A.String x - -instance A.FromJSON FoldingRangeKind where - parseJSON (A.String "comment") = pure FoldingRangeComment - parseJSON (A.String "imports") = pure FoldingRangeImports - parseJSON (A.String "region") = pure FoldingRangeRegion - parseJSON (A.String x) = pure (FoldingRangeUnknown x) - parseJSON _ = fail "FoldingRangeKind" - --- | Represents a folding range. -data FoldingRange = - FoldingRange - { -- | The zero-based line number from where the folded range starts. - _startLine :: UInt - -- | The zero-based character offset from where the folded range - -- starts. If not defined, defaults to the length of the start line. - , _startCharacter :: Maybe UInt - -- | The zero-based line number where the folded range ends. - , _endLine :: UInt - -- | The zero-based character offset before the folded range ends. - -- If not defined, defaults to the length of the end line. - , _endCharacter :: Maybe UInt - -- | Describes the kind of the folding range such as 'comment' or - -- 'region'. The kind is used to categorize folding ranges and used - -- by commands like 'Fold all comments'. See 'FoldingRangeKind' for - -- an enumeration of standardized kinds. - , _kind :: Maybe FoldingRangeKind - } - deriving (Read, Show, Eq) - -deriveJSON lspOptions ''FoldingRange diff --git a/lsp-types/src/Language/LSP/Types/Formatting.hs b/lsp-types/src/Language/LSP/Types/Formatting.hs deleted file mode 100644 index 8bed6e734..000000000 --- a/lsp-types/src/Language/LSP/Types/Formatting.hs +++ /dev/null @@ -1,114 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} -module Language.LSP.Types.Formatting where - -import Data.Aeson.TH -import Data.Text (Text) -import Language.LSP.Types.Common -import Language.LSP.Types.Location -import Language.LSP.Types.Progress -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils - -data DocumentFormattingClientCapabilities = - DocumentFormattingClientCapabilities - { -- | Whether formatting supports dynamic registration. - _dynamicRegistration :: Maybe Bool - } deriving (Show, Read, Eq) -deriveJSON lspOptions ''DocumentFormattingClientCapabilities - -makeExtendingDatatype "DocumentFormattingOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''DocumentFormattingOptions - -makeExtendingDatatype "DocumentFormattingRegistrationOptions" - [ ''TextDocumentRegistrationOptions, - ''DocumentFormattingOptions - ] - [] -deriveJSON lspOptions ''DocumentFormattingRegistrationOptions - --- | Value-object describing what options formatting should use. -data FormattingOptions = FormattingOptions - { -- | Size of a tab in spaces. - _tabSize :: UInt, - -- | Prefer spaces over tabs - _insertSpaces :: Bool, - -- | Trim trailing whitespace on a line. - -- - -- Since LSP 3.15.0 - _trimTrailingWhitespace :: Maybe Bool, - -- | Insert a newline character at the end of the file if one does not exist. - -- - -- Since LSP 3.15.0 - _insertFinalNewline :: Maybe Bool, - -- | Trim all newlines after the final newline at the end of the file. - -- - -- Since LSP 3.15.0 - _trimFinalNewlines :: Maybe Bool - -- Note: May be more properties - } - deriving (Read, Show, Eq) - -deriveJSON lspOptions ''FormattingOptions -makeExtendingDatatype "DocumentFormattingParams" [''WorkDoneProgressParams] - [ ("_textDocument", [t| TextDocumentIdentifier |]) - , ("_options", [t| FormattingOptions |]) - ] -deriveJSON lspOptions ''DocumentFormattingParams - --- ------------------------------------- - -data DocumentRangeFormattingClientCapabilities = - DocumentRangeFormattingClientCapabilities - { -- | Whether formatting supports dynamic registration. - _dynamicRegistration :: Maybe Bool - } deriving (Show, Read, Eq) -deriveJSON lspOptions ''DocumentRangeFormattingClientCapabilities - -makeExtendingDatatype "DocumentRangeFormattingOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''DocumentRangeFormattingOptions - -makeExtendingDatatype "DocumentRangeFormattingRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''DocumentRangeFormattingOptions - ] - [] -deriveJSON lspOptions ''DocumentRangeFormattingRegistrationOptions - -makeExtendingDatatype "DocumentRangeFormattingParams" [''WorkDoneProgressParams] - [ ("_textDocument", [t| TextDocumentIdentifier |]) - , ("_range", [t| Range |]) - , ("_options", [t| FormattingOptions |]) - ] -deriveJSON lspOptions ''DocumentRangeFormattingParams - --- ------------------------------------- - -data DocumentOnTypeFormattingClientCapabilities = - DocumentOnTypeFormattingClientCapabilities - { -- | Whether formatting supports dynamic registration. - _dynamicRegistration :: Maybe Bool - } deriving (Show, Read, Eq) -deriveJSON lspOptions ''DocumentOnTypeFormattingClientCapabilities - -data DocumentOnTypeFormattingOptions = - DocumentOnTypeFormattingOptions - { -- | A character on which formatting should be triggered, like @}@. - _firstTriggerCharacter :: Text - , -- | More trigger characters. - _moreTriggerCharacter :: Maybe [Text] - } deriving (Read,Show,Eq) -deriveJSON lspOptions ''DocumentOnTypeFormattingOptions - -makeExtendingDatatype "DocumentOnTypeFormattingRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''DocumentOnTypeFormattingOptions - ] - [] -deriveJSON lspOptions ''DocumentOnTypeFormattingRegistrationOptions - -makeExtendingDatatype "DocumentOnTypeFormattingParams" [''TextDocumentPositionParams] - [ ("_ch", [t| Text |]) - , ("_options", [t| FormattingOptions |]) - ] -deriveJSON lspOptions ''DocumentOnTypeFormattingParams diff --git a/lsp-types/src/Language/LSP/Types/Hover.hs b/lsp-types/src/Language/LSP/Types/Hover.hs deleted file mode 100644 index 58fe24d5a..000000000 --- a/lsp-types/src/Language/LSP/Types/Hover.hs +++ /dev/null @@ -1,84 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} -module Language.LSP.Types.Hover where - -import Data.Aeson.TH -import Data.Text ( Text ) - -import Language.LSP.Types.Common -import Language.LSP.Types.Location -import Language.LSP.Types.MarkupContent -import Language.LSP.Types.Progress -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils - - --- ------------------------------------- - -data HoverClientCapabilities = - HoverClientCapabilities - { _dynamicRegistration :: Maybe Bool - , _contentFormat :: Maybe (List MarkupKind) - } deriving (Show, Read, Eq) -deriveJSON lspOptions ''HoverClientCapabilities - -makeExtendingDatatype "HoverOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''HoverOptions - -makeExtendingDatatype "HoverRegistrationOptions" [''TextDocumentRegistrationOptions, ''HoverOptions] [] -deriveJSON lspOptions ''HoverRegistrationOptions - -makeExtendingDatatype "HoverParams" [''TextDocumentPositionParams, ''WorkDoneProgressParams] [] -deriveJSON lspOptions ''HoverParams - --- ------------------------------------- - -data LanguageString = - LanguageString - { _language :: Text - , _value :: Text - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''LanguageString - -{-# DEPRECATED MarkedString, PlainString, CodeString "Use MarkupContent instead, since 3.3.0 (11/24/2017)" #-} -data MarkedString = - PlainString Text - | CodeString LanguageString - deriving (Eq,Read,Show) - -deriveJSON lspOptionsUntagged ''MarkedString - --- ------------------------------------- - -data HoverContents = - HoverContentsMS (List MarkedString) - | HoverContents MarkupContent - deriving (Read,Show,Eq) - -deriveJSON lspOptionsUntagged ''HoverContents - --- ------------------------------------- - -instance Semigroup HoverContents where - HoverContents h1 <> HoverContents h2 = HoverContents (h1 `mappend` h2) - HoverContents h1 <> HoverContentsMS (List h2s) = HoverContents (mconcat (h1: (map toMarkupContent h2s))) - HoverContentsMS (List h1s) <> HoverContents h2 = HoverContents (mconcat ((map toMarkupContent h1s) ++ [h2])) - HoverContentsMS (List h1s) <> HoverContentsMS (List h2s) = HoverContentsMS (List (h1s `mappend` h2s)) - -instance Monoid HoverContents where - mempty = HoverContentsMS (List []) - -toMarkupContent :: MarkedString -> MarkupContent -toMarkupContent (PlainString s) = unmarkedUpContent s -toMarkupContent (CodeString (LanguageString lang s)) = markedUpContent lang s - --- ------------------------------------- - -data Hover = - Hover - { _contents :: HoverContents - , _range :: Maybe Range - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''Hover diff --git a/lsp-types/src/Language/LSP/Types/Implementation.hs b/lsp-types/src/Language/LSP/Types/Implementation.hs deleted file mode 100644 index a36a29045..000000000 --- a/lsp-types/src/Language/LSP/Types/Implementation.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} - -module Language.LSP.Types.Implementation where - -import Data.Aeson.TH -import Language.LSP.Types.Progress -import Language.LSP.Types.StaticRegistrationOptions -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils - -data ImplementationClientCapabilities = ImplementationClientCapabilities - { -- | Whether implementation supports dynamic registration. If this is set - -- to 'True' - -- the client supports the new 'ImplementationRegistrationOptions' return - -- value for the corresponding server capability as well. - _dynamicRegistration :: Maybe Bool, - -- | The client supports additional metadata in the form of definition links. - -- - -- Since LSP 3.14.0 - _linkSupport :: Maybe Bool - } - deriving (Read, Show, Eq) - -deriveJSON lspOptions ''ImplementationClientCapabilities - -makeExtendingDatatype "ImplementationOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''ImplementationOptions - -makeExtendingDatatype "ImplementationRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''ImplementationOptions - , ''StaticRegistrationOptions - ] [] -deriveJSON lspOptions ''ImplementationRegistrationOptions - -makeExtendingDatatype "ImplementationParams" - [ ''TextDocumentPositionParams - , ''WorkDoneProgressParams - , ''PartialResultParams - ] [] -deriveJSON lspOptions ''ImplementationParams diff --git a/lsp-types/src/Language/LSP/Types/Initialize.hs b/lsp-types/src/Language/LSP/Types/Initialize.hs deleted file mode 100644 index 77247d10d..000000000 --- a/lsp-types/src/Language/LSP/Types/Initialize.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} - -module Language.LSP.Types.Initialize where - -import Data.Aeson -import Data.Aeson.TH -import Data.Text (Text) -import qualified Data.Text as T -import Language.LSP.Types.ClientCapabilities -import Language.LSP.Types.Common -import Language.LSP.Types.Progress -import Language.LSP.Types.ServerCapabilities -import Language.LSP.Types.Uri -import Language.LSP.Types.Utils -import Language.LSP.Types.WorkspaceFolders - -data Trace = TraceOff | TraceMessages | TraceVerbose - deriving (Show, Read, Eq) - -instance ToJSON Trace where - toJSON TraceOff = String (T.pack "off") - toJSON TraceMessages = String (T.pack "messages") - toJSON TraceVerbose = String (T.pack "verbose") - -instance FromJSON Trace where - parseJSON (String s) = case T.unpack s of - "off" -> return TraceOff - "messages" -> return TraceMessages - "verbose" -> return TraceVerbose - _ -> fail "Trace" - parseJSON _ = fail "Trace" - -data ClientInfo = - ClientInfo - { -- | The name of the client as defined by the client. - _name :: Text - -- | The client's version as defined by the client. - , _version :: Maybe Text - } deriving (Show, Read, Eq) -deriveJSON lspOptions ''ClientInfo - -makeExtendingDatatype "InitializeParams" [''WorkDoneProgressParams] - [ ("_processId", [t| Maybe Int32|]) - , ("_clientInfo", [t| Maybe ClientInfo |]) - , ("_rootPath", [t| Maybe Text |]) - , ("_rootUri", [t| Maybe Uri |]) - , ("_initializationOptions", [t| Maybe Value |]) - , ("_capabilities", [t| ClientCapabilities |]) - , ("_trace", [t| Maybe Trace |]) - , ("_workspaceFolders", [t| Maybe (List WorkspaceFolder) |]) - ] - -deriveJSON lspOptions ''InitializeParams - -data InitializeError = - InitializeError - { _retry :: Bool - } deriving (Read, Show, Eq) - -deriveJSON lspOptions ''InitializeError - -data ServerInfo = - ServerInfo - { -- | The name of the server as defined by the server. - _name :: Text - -- | The server's version as defined by the server. - , _version :: Maybe Text - } deriving (Show, Read, Eq) -deriveJSON lspOptions ''ServerInfo - -data InitializeResult = - InitializeResult - { -- | The capabilities the language server provides. - _capabilities :: ServerCapabilities - -- | Information about the server. - -- Since LSP 3.15.0 - , _serverInfo :: Maybe ServerInfo - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''InitializeResult - --- --------------------------------------------------------------------- - -data InitializedParams = - InitializedParams - { - } deriving (Show, Read, Eq) - -instance FromJSON InitializedParams where - parseJSON (Object _) = pure InitializedParams - parseJSON _ = fail "InitializedParams" - -instance ToJSON InitializedParams where - toJSON InitializedParams = Object mempty - diff --git a/lsp-types/src/Language/LSP/Types/Lens.hs b/lsp-types/src/Language/LSP/Types/Lens.hs deleted file mode 100644 index 1b20b31d4..000000000 --- a/lsp-types/src/Language/LSP/Types/Lens.hs +++ /dev/null @@ -1,399 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeInType #-} -{-# LANGUAGE ExplicitNamespaces #-} - -module Language.LSP.Types.Lens where - -import Language.LSP.Types.CallHierarchy -import Language.LSP.Types.Cancellation -import Language.LSP.Types.ClientCapabilities -import Language.LSP.Types.CodeAction -import Language.LSP.Types.CodeLens -import Language.LSP.Types.DocumentColor -import Language.LSP.Types.Command -import Language.LSP.Types.Common (type (|?)) -import Language.LSP.Types.Completion -import Language.LSP.Types.Configuration -import Language.LSP.Types.Declaration -import Language.LSP.Types.Definition -import Language.LSP.Types.Diagnostic -import Language.LSP.Types.DocumentFilter -import Language.LSP.Types.DocumentHighlight -import Language.LSP.Types.DocumentLink -import Language.LSP.Types.FoldingRange -import Language.LSP.Types.Formatting -import Language.LSP.Types.Hover -import Language.LSP.Types.Implementation -import Language.LSP.Types.Initialize -import Language.LSP.Types.Location -import Language.LSP.Types.MarkupContent -import Language.LSP.Types.Progress -import Language.LSP.Types.Registration -import Language.LSP.Types.References -import Language.LSP.Types.Rename -import Language.LSP.Types.SignatureHelp -import Language.LSP.Types.SelectionRange -import Language.LSP.Types.ServerCapabilities -import Language.LSP.Types.StaticRegistrationOptions -import Language.LSP.Types.DocumentSymbol -import Language.LSP.Types.TextDocument -import Language.LSP.Types.TypeDefinition -import Language.LSP.Types.Window -import Language.LSP.Types.WatchedFiles -import Language.LSP.Types.WorkspaceEdit -import Language.LSP.Types.WorkspaceFolders -import Language.LSP.Types.WorkspaceSymbol -import Language.LSP.Types.Message -import Language.LSP.Types.SemanticTokens -import Control.Lens.TH - --- TODO: This is out of date and very unmaintainable, use TH to call all these!! - --- client capabilities -makeFieldsNoPrefix ''MessageActionItemClientCapabilities -makeFieldsNoPrefix ''ShowMessageRequestClientCapabilities -makeFieldsNoPrefix ''ShowDocumentClientCapabilities -makeFieldsNoPrefix ''StaleRequestClientCapabilities -makeFieldsNoPrefix ''RegularExpressionsClientCapabilities -makeFieldsNoPrefix ''GeneralClientCapabilities -makeFieldsNoPrefix ''WorkspaceClientCapabilities -makeFieldsNoPrefix ''WindowClientCapabilities -makeFieldsNoPrefix ''ClientCapabilities - --- --------------------------------------------------------------------- - -makeFieldsNoPrefix ''SaveOptions -makeFieldsNoPrefix ''WorkspaceServerCapabilities -makeFieldsNoPrefix ''WorkspaceFoldersServerCapabilities -makeFieldsNoPrefix ''ServerCapabilities -makeFieldsNoPrefix ''Registration -makeFieldsNoPrefix ''RegistrationParams -makeFieldsNoPrefix ''Unregistration -makeFieldsNoPrefix ''UnregistrationParams -makeFieldsNoPrefix ''ParameterInformation -makeFieldsNoPrefix ''SignatureInformation -makeFieldsNoPrefix ''ApplyWorkspaceEditParams -makeFieldsNoPrefix ''ApplyWorkspaceEditResponseBody - --- --------------------------------------------------------------------- - --- Initialize -makeFieldsNoPrefix ''InitializeParams -makeFieldsNoPrefix ''InitializeError -makeFieldsNoPrefix ''InitializeResult -makeFieldsNoPrefix ''ClientInfo -makeFieldsNoPrefix ''ServerInfo -makeFieldsNoPrefix ''InitializedParams - --- Configuration -makeFieldsNoPrefix ''DidChangeConfigurationParams -makeFieldsNoPrefix ''ConfigurationItem -makeFieldsNoPrefix ''ConfigurationParams -makeFieldsNoPrefix ''DidChangeConfigurationClientCapabilities - --- Watched files -makeFieldsNoPrefix ''DidChangeWatchedFilesClientCapabilities -makeFieldsNoPrefix ''DidChangeWatchedFilesRegistrationOptions -makeFieldsNoPrefix ''FileSystemWatcher -makeFieldsNoPrefix ''WatchKind -makeFieldsNoPrefix ''FileEvent -makeFieldsNoPrefix ''DidChangeWatchedFilesParams - --- Workspace symbols -makeFieldsNoPrefix ''WorkspaceSymbolKindClientCapabilities -makeFieldsNoPrefix ''WorkspaceSymbolClientCapabilities -makeFieldsNoPrefix ''WorkspaceSymbolOptions -makeFieldsNoPrefix ''WorkspaceSymbolRegistrationOptions -makeFieldsNoPrefix ''WorkspaceSymbolParams - --- Location -makeFieldsNoPrefix ''Position -makeFieldsNoPrefix ''Range -makeFieldsNoPrefix ''Location -makeFieldsNoPrefix ''LocationLink - --- Markup -makeFieldsNoPrefix ''MarkupContent -makeFieldsNoPrefix ''MarkdownClientCapabilities - --- Completion -makeFieldsNoPrefix ''CompletionDoc -makeFieldsNoPrefix ''CompletionEdit -makeFieldsNoPrefix ''CompletionItem -makeFieldsNoPrefix ''CompletionContext -makeFieldsNoPrefix ''CompletionList -makeFieldsNoPrefix ''CompletionParams -makeFieldsNoPrefix ''CompletionOptions -makeFieldsNoPrefix ''CompletionRegistrationOptions -makeFieldsNoPrefix ''CompletionItemTagsClientCapabilities -makeFieldsNoPrefix ''CompletionItemResolveClientCapabilities -makeFieldsNoPrefix ''CompletionItemInsertTextModeClientCapabilities -makeFieldsNoPrefix ''CompletionItemClientCapabilities -makeFieldsNoPrefix ''CompletionItemKindClientCapabilities -makeFieldsNoPrefix ''CompletionClientCapabilities -makeFieldsNoPrefix ''InsertReplaceEdit - --- Declaration -makeFieldsNoPrefix ''DeclarationClientCapabilities -makeFieldsNoPrefix ''DeclarationOptions -makeFieldsNoPrefix ''DeclarationRegistrationOptions -makeFieldsNoPrefix ''DeclarationParams - --- CodeActions -makeFieldsNoPrefix ''CodeActionKindClientCapabilities -makeFieldsNoPrefix ''CodeActionLiteralSupport -makeFieldsNoPrefix ''CodeActionClientCapabilities -makeFieldsNoPrefix ''CodeActionResolveClientCapabilities -makeFieldsNoPrefix ''CodeActionOptions -makeFieldsNoPrefix ''CodeActionRegistrationOptions -makeFieldsNoPrefix ''CodeActionContext -makeFieldsNoPrefix ''CodeActionParams -makeFieldsNoPrefix ''CodeAction - --- CodeLens -makeFieldsNoPrefix ''CodeLensClientCapabilities -makeFieldsNoPrefix ''CodeLensOptions -makeFieldsNoPrefix ''CodeLensRegistrationOptions -makeFieldsNoPrefix ''CodeLensParams -makeFieldsNoPrefix ''CodeLens - --- DocumentLink -makeFieldsNoPrefix ''DocumentLinkClientCapabilities -makeFieldsNoPrefix ''DocumentLinkOptions -makeFieldsNoPrefix ''DocumentLinkRegistrationOptions -makeFieldsNoPrefix ''DocumentLinkParams -makeFieldsNoPrefix ''DocumentLink - --- DocumentColor -makeFieldsNoPrefix ''DocumentColorClientCapabilities -makeFieldsNoPrefix ''DocumentColorOptions -makeFieldsNoPrefix ''DocumentColorRegistrationOptions -makeFieldsNoPrefix ''DocumentColorParams -makeFieldsNoPrefix ''Color -makeFieldsNoPrefix ''ColorInformation - --- ColorPresentation -makeFieldsNoPrefix ''ColorPresentationParams -makeFieldsNoPrefix ''ColorPresentation - --- Formatting -makeFieldsNoPrefix ''DocumentFormattingClientCapabilities -makeFieldsNoPrefix ''DocumentFormattingOptions -makeFieldsNoPrefix ''DocumentFormattingRegistrationOptions -makeFieldsNoPrefix ''FormattingOptions -makeFieldsNoPrefix ''DocumentFormattingParams - --- RangeFormatting -makeFieldsNoPrefix ''DocumentRangeFormattingClientCapabilities -makeFieldsNoPrefix ''DocumentRangeFormattingOptions -makeFieldsNoPrefix ''DocumentRangeFormattingRegistrationOptions -makeFieldsNoPrefix ''DocumentRangeFormattingParams - --- OnTypeFormatting -makeFieldsNoPrefix ''DocumentOnTypeFormattingClientCapabilities -makeFieldsNoPrefix ''DocumentOnTypeFormattingOptions -makeFieldsNoPrefix ''DocumentOnTypeFormattingRegistrationOptions -makeFieldsNoPrefix ''DocumentOnTypeFormattingParams - --- Rename -makeFieldsNoPrefix ''RenameClientCapabilities -makeFieldsNoPrefix ''RenameOptions -makeFieldsNoPrefix ''RenameRegistrationOptions -makeFieldsNoPrefix ''RenameParams -makeFieldsNoPrefix ''PrepareSupportDefaultBehavior - --- PrepareRename -makeFieldsNoPrefix ''PrepareRenameParams -makeFieldsNoPrefix ''RangeWithPlaceholder - --- References -makeFieldsNoPrefix ''ReferencesClientCapabilities -makeFieldsNoPrefix ''ReferenceOptions -makeFieldsNoPrefix ''ReferenceRegistrationOptions -makeFieldsNoPrefix ''ReferenceContext -makeFieldsNoPrefix ''ReferenceParams - --- FoldingRange -makeFieldsNoPrefix ''FoldingRangeClientCapabilities -makeFieldsNoPrefix ''FoldingRangeOptions -makeFieldsNoPrefix ''FoldingRangeRegistrationOptions -makeFieldsNoPrefix ''FoldingRangeParams -makeFieldsNoPrefix ''FoldingRange - --- SelectionRange -makeFieldsNoPrefix ''SelectionRangeClientCapabilities -makeFieldsNoPrefix ''SelectionRangeOptions -makeFieldsNoPrefix ''SelectionRangeRegistrationOptions -makeFieldsNoPrefix ''SelectionRangeParams -makeFieldsNoPrefix ''SelectionRange - --- DocumentHighlight -makeFieldsNoPrefix ''DocumentHighlightClientCapabilities -makeFieldsNoPrefix ''DocumentHighlightOptions -makeFieldsNoPrefix ''DocumentHighlightRegistrationOptions -makeFieldsNoPrefix ''DocumentHighlightParams -makeFieldsNoPrefix ''DocumentHighlight - --- DocumentSymbol -makeFieldsNoPrefix ''DocumentSymbolKindClientCapabilities -makeFieldsNoPrefix ''DocumentSymbolClientCapabilities -makeFieldsNoPrefix ''DocumentSymbolOptions -makeFieldsNoPrefix ''DocumentSymbolRegistrationOptions -makeFieldsNoPrefix ''DocumentSymbolParams -makeFieldsNoPrefix ''DocumentSymbol -makeFieldsNoPrefix ''SymbolInformation - --- DocumentFilter -makeFieldsNoPrefix ''DocumentFilter - --- WorkspaceEdit -makeFieldsNoPrefix ''TextEdit -makeFieldsNoPrefix ''ChangeAnnotation -makeFieldsNoPrefix ''AnnotatedTextEdit -makeFieldsNoPrefix ''VersionedTextDocumentIdentifier -makeFieldsNoPrefix ''TextDocumentEdit -makeFieldsNoPrefix ''CreateFileOptions -makeFieldsNoPrefix ''CreateFile -makeFieldsNoPrefix ''RenameFileOptions -makeFieldsNoPrefix ''RenameFile -makeFieldsNoPrefix ''DeleteFileOptions -makeFieldsNoPrefix ''DeleteFile -makeFieldsNoPrefix ''WorkspaceEdit -makeFieldsNoPrefix ''WorkspaceEditClientCapabilities -makeFieldsNoPrefix ''WorkspaceEditChangeAnnotationClientCapabilities - --- Workspace Folders -makeFieldsNoPrefix ''WorkspaceFolder -makeFieldsNoPrefix ''WorkspaceFoldersChangeEvent -makeFieldsNoPrefix ''DidChangeWorkspaceFoldersParams - --- Message -makeFieldsNoPrefix ''RequestMessage -makeFieldsNoPrefix ''ResponseError -makeFieldsNoPrefix ''ResponseMessage -makeFieldsNoPrefix ''NotificationMessage -makeFieldsNoPrefix ''CancelParams - --- TextDocument -makeFieldsNoPrefix ''TextDocumentItem -makeFieldsNoPrefix ''TextDocumentIdentifier -makeFieldsNoPrefix ''TextDocumentPositionParams -makeFieldsNoPrefix ''TextDocumentSyncClientCapabilities -makeFieldsNoPrefix ''TextDocumentClientCapabilities -makeFieldsNoPrefix ''TextDocumentRegistrationOptions -makeFieldsNoPrefix ''TextDocumentSyncOptions -makeFieldsNoPrefix ''DidOpenTextDocumentParams -makeFieldsNoPrefix ''TextDocumentContentChangeEvent -makeFieldsNoPrefix ''DidChangeTextDocumentParams -makeFieldsNoPrefix ''TextDocumentChangeRegistrationOptions -makeFieldsNoPrefix ''WillSaveTextDocumentParams -makeFieldsNoPrefix ''DidSaveTextDocumentParams -makeFieldsNoPrefix ''TextDocumentSaveRegistrationOptions -makeFieldsNoPrefix ''DidCloseTextDocumentParams - --- Command -makeFieldsNoPrefix ''Command -makeFieldsNoPrefix ''ExecuteCommandParams -makeFieldsNoPrefix ''ExecuteCommandRegistrationOptions -makeFieldsNoPrefix ''ExecuteCommandClientCapabilities -makeFieldsNoPrefix ''ExecuteCommandOptions - --- Diagnostic -makeFieldsNoPrefix ''DiagnosticRelatedInformation -makeFieldsNoPrefix ''Diagnostic -makeFieldsNoPrefix ''PublishDiagnosticsTagsClientCapabilities -makeFieldsNoPrefix ''PublishDiagnosticsClientCapabilities -makeFieldsNoPrefix ''PublishDiagnosticsParams - --- Hover -makeFieldsNoPrefix ''HoverClientCapabilities -makeFieldsNoPrefix ''Hover -makeFieldsNoPrefix ''HoverParams -makeFieldsNoPrefix ''HoverOptions -makeFieldsNoPrefix ''HoverRegistrationOptions -makeFieldsNoPrefix ''LanguageString - --- Implementation -makeFieldsNoPrefix ''ImplementationClientCapabilities -makeFieldsNoPrefix ''ImplementationOptions -makeFieldsNoPrefix ''ImplementationRegistrationOptions -makeFieldsNoPrefix ''ImplementationParams - --- Definition -makeFieldsNoPrefix ''DefinitionOptions -makeFieldsNoPrefix ''DefinitionRegistrationOptions -makeFieldsNoPrefix ''DefinitionParams -makeFieldsNoPrefix ''DefinitionClientCapabilities - --- Type Definition -makeFieldsNoPrefix ''TypeDefinitionOptions -makeFieldsNoPrefix ''TypeDefinitionRegistrationOptions -makeFieldsNoPrefix ''TypeDefinitionParams -makeFieldsNoPrefix ''TypeDefinitionClientCapabilities - --- Window -makeFieldsNoPrefix ''ShowMessageParams -makeFieldsNoPrefix ''MessageActionItem -makeFieldsNoPrefix ''ShowMessageRequestParams -makeFieldsNoPrefix ''ShowDocumentParams -makeFieldsNoPrefix ''ShowDocumentResult -makeFieldsNoPrefix ''LogMessageParams -makeFieldsNoPrefix ''ProgressParams -makeFieldsNoPrefix ''WorkDoneProgressBeginParams -makeFieldsNoPrefix ''WorkDoneProgressReportParams -makeFieldsNoPrefix ''WorkDoneProgressEndParams -makeFieldsNoPrefix ''WorkDoneProgressCancelParams -makeFieldsNoPrefix ''WorkDoneProgressCreateParams -makeFieldsNoPrefix ''WorkDoneProgressOptions -makeFieldsNoPrefix ''WorkDoneProgressParams -makeFieldsNoPrefix ''PartialResultParams - --- Signature Help -makeFieldsNoPrefix ''SignatureHelpSignatureInformation -makeFieldsNoPrefix ''SignatureHelpParameterInformation -makeFieldsNoPrefix ''SignatureHelpParams -makeFieldsNoPrefix ''SignatureHelpClientCapabilities -makeFieldsNoPrefix ''SignatureHelpOptions -makeFieldsNoPrefix ''SignatureHelpRegistrationOptions -makeFieldsNoPrefix ''SignatureHelp - --- Static registration -makeFieldsNoPrefix ''StaticRegistrationOptions - --- Call hierarchy -makeFieldsNoPrefix ''CallHierarchyClientCapabilities -makeFieldsNoPrefix ''CallHierarchyOptions -makeFieldsNoPrefix ''CallHierarchyRegistrationOptions -makeFieldsNoPrefix ''CallHierarchyPrepareParams -makeFieldsNoPrefix ''CallHierarchyIncomingCallsParams -makeFieldsNoPrefix ''CallHierarchyIncomingCall -makeFieldsNoPrefix ''CallHierarchyOutgoingCallsParams -makeFieldsNoPrefix ''CallHierarchyOutgoingCall -makeFieldsNoPrefix ''CallHierarchyItem - --- Semantic tokens -makeFieldsNoPrefix ''SemanticTokensLegend -makeFieldsNoPrefix ''SemanticTokensDeltaClientCapabilities -makeFieldsNoPrefix ''SemanticTokensRequestsClientCapabilities -makeFieldsNoPrefix ''SemanticTokensClientCapabilities -makeFieldsNoPrefix ''SemanticTokensParams -makeFieldsNoPrefix ''SemanticTokensDeltaParams -makeFieldsNoPrefix ''SemanticTokensRangeParams -makeFieldsNoPrefix ''SemanticTokens -makeFieldsNoPrefix ''SemanticTokensPartialResult -makeFieldsNoPrefix ''SemanticTokensEdit -makeFieldsNoPrefix ''SemanticTokensDelta -makeFieldsNoPrefix ''SemanticTokensDeltaPartialResult -makeFieldsNoPrefix ''SemanticTokensWorkspaceClientCapabilities - --- Unions -makePrisms ''(|?) \ No newline at end of file diff --git a/lsp-types/src/Language/LSP/Types/Location.hs b/lsp-types/src/Language/LSP/Types/Location.hs deleted file mode 100644 index 3551502f5..000000000 --- a/lsp-types/src/Language/LSP/Types/Location.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} -module Language.LSP.Types.Location where - -import Control.DeepSeq -import Data.Aeson.TH -import Data.Hashable -import GHC.Generics hiding (UInt) -import Language.LSP.Types.Common -import Language.LSP.Types.Uri -import Language.LSP.Types.Utils - --- --------------------------------------------------------------------- - --- | A position in a document. Note that the character offsets in a line --- are given in UTF-16 code units, *not* Unicode code points. -data Position = - Position - { -- | Line position in a document (zero-based). - _line :: UInt - -- | Character offset on a line in a document (zero-based). Assuming that - -- the line is represented as a string, the @character@ value represents the - -- gap between the @character@ and @character + 1@. - , _character :: UInt - } deriving (Show, Read, Eq, Ord, Generic) - -instance NFData Position -deriveJSON lspOptions ''Position - -instance Hashable Position - --- --------------------------------------------------------------------- - -data Range = - Range - { _start :: Position -- ^ The range's start position. (inclusive) - , _end :: Position -- ^ The range's end position. (exclusive, see: https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#range ) - } deriving (Show, Read, Eq, Ord, Generic) - -instance NFData Range -deriveJSON lspOptions ''Range - -instance Hashable Range - --- --------------------------------------------------------------------- - -data Location = - Location - { _uri :: Uri - , _range :: Range - } deriving (Show, Read, Eq, Ord, Generic) - -instance NFData Location -deriveJSON lspOptions ''Location - -instance Hashable Location - --- --------------------------------------------------------------------- - --- | Represents a link between a source and a target location. -data LocationLink = - LocationLink - { -- | Span of the origin of this link. - -- Used as the underlined span for mouse interaction. Defaults to the word - -- range at the mouse position. - _originSelectionRange :: Maybe Range - -- | The target resource identifier of this link. - , _targetUri :: Uri - -- | The full target range of this link. If the target for example is a - -- symbol then target range is the range enclosing this symbol not including - -- leading/trailing whitespace but everything else like comments. This - -- information is typically used to highlight the range in the editor. - , _targetRange :: Range - -- | The range that should be selected and revealed when this link is being - -- followed, e.g the name of a function. Must be contained by the the - -- 'targetRange'. See also @DocumentSymbol._range@ - , _targetSelectionRange :: Range - } deriving (Read, Show, Eq) -deriveJSON lspOptions ''LocationLink - --- --------------------------------------------------------------------- - --- | A helper function for creating ranges. --- prop> mkRange l c l' c' = Range (Position l c) (Position l' c') -mkRange :: UInt -> UInt -> UInt -> UInt -> Range -mkRange l c l' c' = Range (Position l c) (Position l' c') - --- | 'isSubrangeOf' returns true if for every 'Position' in the first 'Range', it's also in the second 'Range'. -isSubrangeOf :: Range -> Range -> Bool -isSubrangeOf smallRange range = _start smallRange >= _start range && _end smallRange <= _end range - --- | 'positionInRange' returns true if the given 'Position' is in the 'Range'. -positionInRange :: Position -> Range -> Bool -positionInRange p (Range sp ep) = sp <= p && p < ep -- Range's end position is exclusive. diff --git a/lsp-types/src/Language/LSP/Types/MarkupContent.hs b/lsp-types/src/Language/LSP/Types/MarkupContent.hs deleted file mode 100644 index f4f1e40da..000000000 --- a/lsp-types/src/Language/LSP/Types/MarkupContent.hs +++ /dev/null @@ -1,111 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - --- | A MarkupContent literal represents a string value which content can --- be represented in different formats. --- Currently plaintext and markdown are supported formats. --- A MarkupContent is usually used in documentation properties of result --- literals like CompletionItem or SignatureInformation. -module Language.LSP.Types.MarkupContent where - -import Data.Aeson -import Data.Aeson.TH -import Data.Text (Text) -import qualified Data.Text as T -import Language.LSP.Types.Utils - --- | Describes the content type that a client supports in various --- result literals like `Hover`, `ParameterInfo` or `CompletionItem`. -data MarkupKind = MkPlainText -- ^ Plain text is supported as a content format - | MkMarkdown -- ^ Markdown is supported as a content format - deriving (Read, Show, Eq) - -instance ToJSON MarkupKind where - toJSON MkPlainText = String "plaintext" - toJSON MkMarkdown = String "markdown" - -instance FromJSON MarkupKind where - parseJSON (String "plaintext") = pure MkPlainText - parseJSON (String "markdown") = pure MkMarkdown - parseJSON _ = fail "MarkupKind" - --- | A `MarkupContent` literal represents a string value which content is interpreted base on its --- | kind flag. Currently the protocol supports `plaintext` and `markdown` as markup kinds. --- | --- | If the kind is `markdown` then the value can contain fenced code blocks like in GitHub issues. --- | See https://help.github.com/articles/creating-and-highlighting-code-blocks/#syntax-highlighting --- | --- | Here is an example how such a string can be constructed using JavaScript / TypeScript: --- | ```ts --- | let markdown: MarkdownContent = { --- | kind: MarkupKind.Markdown, --- | value: [ --- | '# Header', --- | 'Some text', --- | '```typescript', --- | 'someCode();', --- | '```' --- | ].join('\n') --- | }; --- | ``` --- | --- | *Please Note* that clients might sanitize the return markdown. A client could decide to --- | remove HTML from the markdown to avoid script execution. -data MarkupContent = - MarkupContent - { _kind :: MarkupKind -- ^ The type of the Markup - , _value :: Text -- ^ The content itself - } - deriving (Read, Show, Eq) - -deriveJSON lspOptions ''MarkupContent - --- --------------------------------------------------------------------- - --- | Create a 'MarkupContent' containing a quoted language string only. -markedUpContent :: Text -> Text -> MarkupContent -markedUpContent lang quote - = MarkupContent MkMarkdown ("\n```" <> lang <> "\n" <> quote <> "\n```\n") - --- --------------------------------------------------------------------- - --- | Create a 'MarkupContent' containing unquoted text -unmarkedUpContent :: Text -> MarkupContent -unmarkedUpContent str = MarkupContent MkPlainText str - --- --------------------------------------------------------------------- - --- | Markdown for a section separator in Markdown, being a horizontal line -sectionSeparator :: Text -sectionSeparator = "* * *\n" - --- --------------------------------------------------------------------- - --- | Given some plaintext, convert it into some equivalent markdown text. --- This is not *quite* the identity function. -plainTextToMarkdown :: Text -> Text --- Line breaks in markdown paragraphs are ignored unless the line ends with two spaces. --- In order to respect the line breaks in the original plaintext, we stick two spaces on the end of every line. -plainTextToMarkdown = T.unlines . fmap (<> " ") . T.lines - -instance Semigroup MarkupContent where - MarkupContent MkPlainText s1 <> MarkupContent MkPlainText s2 = MarkupContent MkPlainText (s1 `mappend` s2) - MarkupContent MkMarkdown s1 <> MarkupContent MkMarkdown s2 = MarkupContent MkMarkdown (s1 `mappend` s2) - MarkupContent MkPlainText s1 <> MarkupContent MkMarkdown s2 = MarkupContent MkMarkdown (plainTextToMarkdown s1 `mappend` s2) - MarkupContent MkMarkdown s1 <> MarkupContent MkPlainText s2 = MarkupContent MkMarkdown (s1 `mappend` plainTextToMarkdown s2) - -instance Monoid MarkupContent where - mempty = MarkupContent MkPlainText "" - --- --------------------------------------------------------------------- - --- | Client capabilities specific to the used markdown parser. --- @since 3.16.0 -data MarkdownClientCapabilities = - MarkdownClientCapabilities - { _parser :: Text - , _version :: Maybe Text - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''MarkdownClientCapabilities diff --git a/lsp-types/src/Language/LSP/Types/Message.hs b/lsp-types/src/Language/LSP/Types/Message.hs deleted file mode 100644 index da3c2a5ab..000000000 --- a/lsp-types/src/Language/LSP/Types/Message.hs +++ /dev/null @@ -1,423 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeInType #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TupleSections #-} -{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} - -module Language.LSP.Types.Message where - -import Language.LSP.Types.CallHierarchy -import Language.LSP.Types.Cancellation -import Language.LSP.Types.CodeAction -import Language.LSP.Types.CodeLens -import Language.LSP.Types.Command -import Language.LSP.Types.Common -import Language.LSP.Types.Configuration -import Language.LSP.Types.Completion -import Language.LSP.Types.Declaration -import Language.LSP.Types.Definition -import Language.LSP.Types.Diagnostic -import Language.LSP.Types.DocumentColor -import Language.LSP.Types.DocumentHighlight -import Language.LSP.Types.DocumentLink -import Language.LSP.Types.DocumentSymbol -import Language.LSP.Types.FoldingRange -import Language.LSP.Types.Formatting -import Language.LSP.Types.Hover -import Language.LSP.Types.Implementation -import Language.LSP.Types.Initialize -import Language.LSP.Types.Location -import Language.LSP.Types.LspId -import Language.LSP.Types.Method -import Language.LSP.Types.Progress -import Language.LSP.Types.Registration -import Language.LSP.Types.Rename -import Language.LSP.Types.References -import Language.LSP.Types.SelectionRange -import Language.LSP.Types.SemanticTokens -import Language.LSP.Types.SignatureHelp -import Language.LSP.Types.TextDocument -import Language.LSP.Types.TypeDefinition -import Language.LSP.Types.Utils -import Language.LSP.Types.Window -import Language.LSP.Types.WatchedFiles -import Language.LSP.Types.WorkspaceEdit -import Language.LSP.Types.WorkspaceFolders -import Language.LSP.Types.WorkspaceSymbol - -import Data.Kind -import Data.Aeson -import Data.Aeson.TH -import Data.Text (Text) -import Data.Scientific -import Data.String -import GHC.Generics - --- --------------------------------------------------------------------- --- PARAMS definition --- Map Methods to params/responses --- --------------------------------------------------------------------- - --- | Map a method to the message payload type -type family MessageParams (m :: Method f t) :: Type where --- Client - -- General - MessageParams Initialize = InitializeParams - MessageParams Initialized = Maybe InitializedParams - MessageParams Shutdown = Empty - MessageParams Exit = Empty - -- Workspace - MessageParams WorkspaceDidChangeWorkspaceFolders = DidChangeWorkspaceFoldersParams - MessageParams WorkspaceDidChangeConfiguration = DidChangeConfigurationParams - MessageParams WorkspaceDidChangeWatchedFiles = DidChangeWatchedFilesParams - MessageParams WorkspaceSymbol = WorkspaceSymbolParams - MessageParams WorkspaceExecuteCommand = ExecuteCommandParams - -- Sync/Document state - MessageParams TextDocumentDidOpen = DidOpenTextDocumentParams - MessageParams TextDocumentDidChange = DidChangeTextDocumentParams - MessageParams TextDocumentWillSave = WillSaveTextDocumentParams - MessageParams TextDocumentWillSaveWaitUntil = WillSaveTextDocumentParams - MessageParams TextDocumentDidSave = DidSaveTextDocumentParams - MessageParams TextDocumentDidClose = DidCloseTextDocumentParams - -- Completion - MessageParams TextDocumentCompletion = CompletionParams - MessageParams CompletionItemResolve = CompletionItem - -- Language Queries - MessageParams TextDocumentHover = HoverParams - MessageParams TextDocumentSignatureHelp = SignatureHelpParams - MessageParams TextDocumentDeclaration = DeclarationParams - MessageParams TextDocumentDefinition = DefinitionParams - MessageParams TextDocumentTypeDefinition = TypeDefinitionParams - MessageParams TextDocumentImplementation = ImplementationParams - MessageParams TextDocumentReferences = ReferenceParams - MessageParams TextDocumentDocumentHighlight = DocumentHighlightParams - MessageParams TextDocumentDocumentSymbol = DocumentSymbolParams - -- Code Action/Lens/Link - MessageParams TextDocumentCodeAction = CodeActionParams - MessageParams TextDocumentCodeLens = CodeLensParams - MessageParams CodeLensResolve = CodeLens - MessageParams TextDocumentDocumentLink = DocumentLinkParams - MessageParams DocumentLinkResolve = DocumentLink - -- Syntax highlighting/coloring - MessageParams TextDocumentDocumentColor = DocumentColorParams - MessageParams TextDocumentColorPresentation = ColorPresentationParams - -- Formatting - MessageParams TextDocumentFormatting = DocumentFormattingParams - MessageParams TextDocumentRangeFormatting = DocumentRangeFormattingParams - MessageParams TextDocumentOnTypeFormatting = DocumentOnTypeFormattingParams - -- Rename - MessageParams TextDocumentRename = RenameParams - MessageParams TextDocumentPrepareRename = PrepareRenameParams - -- Folding Range - MessageParams TextDocumentFoldingRange = FoldingRangeParams - -- Selection Range - MessageParams TextDocumentSelectionRange = SelectionRangeParams - -- Call hierarchy - MessageParams TextDocumentPrepareCallHierarchy = CallHierarchyPrepareParams - MessageParams CallHierarchyIncomingCalls = CallHierarchyIncomingCallsParams - MessageParams CallHierarchyOutgoingCalls = CallHierarchyOutgoingCallsParams - -- Semantic tokens - MessageParams TextDocumentSemanticTokens = Empty - MessageParams TextDocumentSemanticTokensFull = SemanticTokensParams - MessageParams TextDocumentSemanticTokensFullDelta = SemanticTokensDeltaParams - MessageParams TextDocumentSemanticTokensRange = SemanticTokensRangeParams - MessageParams WorkspaceSemanticTokensRefresh = Empty --- Server - -- Window - MessageParams WindowShowMessage = ShowMessageParams - MessageParams WindowShowMessageRequest = ShowMessageRequestParams - MessageParams WindowShowDocument = ShowDocumentParams - MessageParams WindowLogMessage = LogMessageParams - -- Progress - MessageParams WindowWorkDoneProgressCreate = WorkDoneProgressCreateParams - MessageParams WindowWorkDoneProgressCancel = WorkDoneProgressCancelParams - MessageParams Progress = ProgressParams SomeProgressParams - -- Telemetry - MessageParams TelemetryEvent = Value - -- Client - MessageParams ClientRegisterCapability = RegistrationParams - MessageParams ClientUnregisterCapability = UnregistrationParams - -- Workspace - MessageParams WorkspaceWorkspaceFolders = Empty - MessageParams WorkspaceConfiguration = ConfigurationParams - MessageParams WorkspaceApplyEdit = ApplyWorkspaceEditParams - -- Document/Diagnostic - MessageParams TextDocumentPublishDiagnostics = PublishDiagnosticsParams - -- Cancel - MessageParams CancelRequest = CancelParams - -- Custom - MessageParams CustomMethod = Value - --- | Map a request method to the response payload type -type family ResponseResult (m :: Method f Request) :: Type where --- Even though the specification mentions that the result types are --- @x | y | ... | null@, they don't actually need to be wrapped in a Maybe since --- (we think) this is just to account for how the response field is always --- nullable. I.e. if it is null, then the error field is set - --- Client - -- General - ResponseResult Initialize = InitializeResult - ResponseResult Shutdown = Empty - -- Workspace - ResponseResult WorkspaceSymbol = List SymbolInformation - ResponseResult WorkspaceExecuteCommand = Value - -- Sync/Document state - ResponseResult TextDocumentWillSaveWaitUntil = List TextEdit - -- Completion - ResponseResult TextDocumentCompletion = List CompletionItem |? CompletionList - ResponseResult CompletionItemResolve = CompletionItem - -- Language Queries - ResponseResult TextDocumentHover = Maybe Hover - ResponseResult TextDocumentSignatureHelp = SignatureHelp - ResponseResult TextDocumentDeclaration = Location |? List Location |? List LocationLink - ResponseResult TextDocumentDefinition = Location |? List Location |? List LocationLink - ResponseResult TextDocumentTypeDefinition = Location |? List Location |? List LocationLink - ResponseResult TextDocumentImplementation = Location |? List Location |? List LocationLink - ResponseResult TextDocumentReferences = List Location - ResponseResult TextDocumentDocumentHighlight = List DocumentHighlight - ResponseResult TextDocumentDocumentSymbol = List DocumentSymbol |? List SymbolInformation - -- Code Action/Lens/Link - ResponseResult TextDocumentCodeAction = List (Command |? CodeAction) - ResponseResult TextDocumentCodeLens = List CodeLens - ResponseResult CodeLensResolve = CodeLens - ResponseResult TextDocumentDocumentLink = List DocumentLink - ResponseResult DocumentLinkResolve = DocumentLink - -- Syntax highlighting/coloring - ResponseResult TextDocumentDocumentColor = List ColorInformation - ResponseResult TextDocumentColorPresentation = List ColorPresentation - -- Formatting - ResponseResult TextDocumentFormatting = List TextEdit - ResponseResult TextDocumentRangeFormatting = List TextEdit - ResponseResult TextDocumentOnTypeFormatting = List TextEdit - -- Rename - ResponseResult TextDocumentRename = WorkspaceEdit - ResponseResult TextDocumentPrepareRename = Maybe (Range |? RangeWithPlaceholder) - -- FoldingRange - ResponseResult TextDocumentFoldingRange = List FoldingRange - ResponseResult TextDocumentSelectionRange = List SelectionRange - -- Call hierarchy - ResponseResult TextDocumentPrepareCallHierarchy = Maybe (List CallHierarchyItem) - ResponseResult CallHierarchyIncomingCalls = Maybe (List CallHierarchyIncomingCall) - ResponseResult CallHierarchyOutgoingCalls = Maybe (List CallHierarchyOutgoingCall) - -- Semantic tokens - ResponseResult TextDocumentSemanticTokens = Empty - ResponseResult TextDocumentSemanticTokensFull = Maybe SemanticTokens - ResponseResult TextDocumentSemanticTokensFullDelta = Maybe (SemanticTokens |? SemanticTokensDelta) - ResponseResult TextDocumentSemanticTokensRange = Maybe SemanticTokens - ResponseResult WorkspaceSemanticTokensRefresh = Empty - -- Custom can be either a notification or a message --- Server - -- Window - ResponseResult WindowShowMessageRequest = Maybe MessageActionItem - ResponseResult WindowShowDocument = ShowDocumentResult - ResponseResult WindowWorkDoneProgressCreate = Empty - -- Capability - ResponseResult ClientRegisterCapability = Empty - ResponseResult ClientUnregisterCapability = Empty - -- Workspace - ResponseResult WorkspaceWorkspaceFolders = Maybe (List WorkspaceFolder) - ResponseResult WorkspaceConfiguration = List Value - ResponseResult WorkspaceApplyEdit = ApplyWorkspaceEditResponseBody --- Custom - ResponseResult CustomMethod = 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 :: Method f Notification) = - NotificationMessage - { _jsonrpc :: Text - , _method :: SMethod m - , _params :: MessageParams m - } deriving Generic - -deriving instance Eq (MessageParams m) => Eq (NotificationMessage m) -deriving instance Show (MessageParams m) => Show (NotificationMessage m) - -instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (NotificationMessage m) where - parseJSON = genericParseJSON lspOptions . addNullField "params" -instance (ToJSON (MessageParams m)) => ToJSON (NotificationMessage m) where - toJSON = genericToJSON lspOptions - toEncoding = genericToEncoding lspOptions - -data RequestMessage (m :: Method f Request) = RequestMessage - { _jsonrpc :: Text - , _id :: LspId m - , _method :: SMethod m - , _params :: MessageParams m - } deriving Generic - -deriving instance Eq (MessageParams m) => Eq (RequestMessage m) -deriving instance (Read (SMethod m), Read (MessageParams m)) => Read (RequestMessage m) -deriving instance Show (MessageParams m) => Show (RequestMessage m) - --- | Replace a missing field in an object with a null field, to simplify parsing --- This is a hack to allow other types than Maybe to work like Maybe in allowing the field to be missing. --- See also this issue: https://github.com/haskell/aeson/issues/646 -addNullField :: String -> Value -> Value -addNullField s (Object o) = Object $ o <> fromString s .= Null -addNullField _ v = v - -instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (RequestMessage m) where - parseJSON = genericParseJSON lspOptions . addNullField "params" -instance (ToJSON (MessageParams m), FromJSON (SMethod m)) => ToJSON (RequestMessage m) where - toJSON = genericToJSON lspOptions - toEncoding = genericToEncoding lspOptions - --- | A custom message data type is needed to distinguish between --- notifications and requests, since a CustomMethod can be both! -data CustomMessage f t where - ReqMess :: RequestMessage (CustomMethod :: Method f Request) -> CustomMessage f Request - NotMess :: NotificationMessage (CustomMethod :: Method f Notification) -> CustomMessage f Notification - -deriving instance Show (CustomMessage p t) - -instance ToJSON (CustomMessage p t) where - toJSON (ReqMess a) = toJSON a - toJSON (NotMess a) = toJSON a - -instance FromJSON (CustomMessage p Request) where - parseJSON v = ReqMess <$> parseJSON v -instance FromJSON (CustomMessage p Notification) where - parseJSON v = NotMess <$> parseJSON v - --- --------------------------------------------------------------------- --- Response Message --- --------------------------------------------------------------------- - -data ErrorCode = ParseError - | InvalidRequest - | MethodNotFound - | InvalidParams - | InternalError - | ServerErrorStart - | ServerErrorEnd - | ServerNotInitialized - | UnknownErrorCode - | RequestCancelled - | ContentModified - | ServerCancelled - | RequestFailed - | ErrorCodeCustom Int32 - -- ^ Note: server error codes are reserved from -32099 to -32000 - deriving (Read,Show,Eq) - -instance ToJSON ErrorCode where - toJSON ParseError = Number (-32700) - toJSON InvalidRequest = Number (-32600) - toJSON MethodNotFound = Number (-32601) - toJSON InvalidParams = Number (-32602) - toJSON InternalError = Number (-32603) - toJSON ServerErrorStart = Number (-32099) - toJSON ServerErrorEnd = Number (-32000) - toJSON ServerNotInitialized = Number (-32002) - toJSON UnknownErrorCode = Number (-32001) - toJSON RequestCancelled = Number (-32800) - toJSON ContentModified = Number (-32801) - toJSON ServerCancelled = Number (-32802) - toJSON RequestFailed = Number (-32803) - toJSON (ErrorCodeCustom n) = Number (fromIntegral n) - -instance FromJSON ErrorCode where - parseJSON (Number (-32700)) = pure ParseError - parseJSON (Number (-32600)) = pure InvalidRequest - parseJSON (Number (-32601)) = pure MethodNotFound - parseJSON (Number (-32602)) = pure InvalidParams - parseJSON (Number (-32603)) = pure InternalError - parseJSON (Number (-32099)) = pure ServerErrorStart - parseJSON (Number (-32000)) = pure ServerErrorEnd - parseJSON (Number (-32002)) = pure ServerNotInitialized - parseJSON (Number (-32001)) = pure UnknownErrorCode - parseJSON (Number (-32800)) = pure RequestCancelled - parseJSON (Number (-32801)) = pure ContentModified - parseJSON (Number (-32802)) = pure ServerCancelled - parseJSON (Number (-32803)) = pure RequestFailed - parseJSON (Number n ) = case toBoundedInteger n of - Just i -> pure (ErrorCodeCustom i) - Nothing -> fail "Couldn't convert ErrorCode to bounded integer." - parseJSON _ = fail "Couldn't parse ErrorCode" - --- ------------------------------------- - -data ResponseError = - ResponseError - { _code :: ErrorCode - , _message :: Text - , _xdata :: Maybe Value - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''ResponseError - --- | Either result or error must be Just. -data ResponseMessage (m :: Method f Request) = - ResponseMessage - { _jsonrpc :: Text - , _id :: Maybe (LspId m) - , _result :: Either ResponseError (ResponseResult m) - } deriving Generic - -deriving instance Eq (ResponseResult m) => Eq (ResponseMessage m) -deriving instance Read (ResponseResult m) => Read (ResponseMessage m) -deriving instance Show (ResponseResult m) => Show (ResponseMessage m) - -instance (ToJSON (ResponseResult m)) => ToJSON (ResponseMessage m) where - toJSON ResponseMessage { _jsonrpc = jsonrpc, _id = lspid, _result = result } - = object - [ "jsonrpc" .= jsonrpc - , "id" .= lspid - , case result of - Left err -> "error" .= err - Right a -> "result" .= a - ] - -instance FromJSON (ResponseResult a) => FromJSON (ResponseMessage a) where - parseJSON = withObject "Response" $ \o -> do - _jsonrpc <- o .: "jsonrpc" - _id <- o .: "id" - -- It is important to use .:! so that "result = null" (without error) gets decoded as Just Null - _result <- o .:! "result" - _error <- o .:? "error" - result <- case (_error, _result) of - (Just err, Nothing) -> pure $ Left err - (Nothing, Just res) -> pure $ Right res - (Just _err, Just _res) -> fail $ "both error and result cannot be present: " ++ show o - (Nothing, Nothing) -> fail "both error and result cannot be Nothing" - return $ ResponseMessage _jsonrpc _id result - --- --------------------------------------------------------------------- --- Helper Type Families --- --------------------------------------------------------------------- - --- | Map a method to the Request/Notification type with the correct --- payload -type family Message (m :: Method f t) :: Type where - Message (CustomMethod :: Method f t) = CustomMessage f t - Message (m :: Method f Request) = RequestMessage m - Message (m :: Method f Notification) = NotificationMessage m - --- Some helpful type synonyms -type ClientMessage (m :: Method FromClient t) = Message m -type ServerMessage (m :: Method FromServer t) = Message m diff --git a/lsp-types/src/Language/LSP/Types/Method.hs b/lsp-types/src/Language/LSP/Types/Method.hs deleted file mode 100644 index 52baa796c..000000000 --- a/lsp-types/src/Language/LSP/Types/Method.hs +++ /dev/null @@ -1,455 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -module Language.LSP.Types.Method where - -import qualified Data.Aeson as A -import Data.Aeson.Types -import Data.Text (Text) -import Language.LSP.Types.Utils -import Data.Function (on) -import Control.Applicative -import Data.GADT.Compare -import Data.Type.Equality -import GHC.Exts (Int(..), dataToTag#) -import Unsafe.Coerce - --- --------------------------------------------------------------------- - -data From = FromServer | FromClient -data MethodType = Notification | Request - -data Method (f :: From) (t :: MethodType) where --- Client Methods - -- General - Initialize :: Method FromClient Request - Initialized :: Method FromClient Notification - Shutdown :: Method FromClient Request - Exit :: Method FromClient Notification - -- Workspace - WorkspaceDidChangeWorkspaceFolders :: Method FromClient Notification - WorkspaceDidChangeConfiguration :: Method FromClient Notification - WorkspaceDidChangeWatchedFiles :: Method FromClient Notification - WorkspaceSymbol :: Method FromClient Request - WorkspaceExecuteCommand :: Method FromClient Request - -- Document - TextDocumentDidOpen :: Method FromClient Notification - TextDocumentDidChange :: Method FromClient Notification - TextDocumentWillSave :: Method FromClient Notification - TextDocumentWillSaveWaitUntil :: Method FromClient Request - TextDocumentDidSave :: Method FromClient Notification - TextDocumentDidClose :: Method FromClient Notification - -- Completion - TextDocumentCompletion :: Method FromClient Request - CompletionItemResolve :: Method FromClient Request - -- LanguageQueries - TextDocumentHover :: Method FromClient Request - TextDocumentSignatureHelp :: Method FromClient Request - TextDocumentDeclaration :: Method FromClient Request - TextDocumentDefinition :: Method FromClient Request - TextDocumentTypeDefinition :: Method FromClient Request - TextDocumentImplementation :: Method FromClient Request - TextDocumentReferences :: Method FromClient Request - TextDocumentDocumentHighlight :: Method FromClient Request - TextDocumentDocumentSymbol :: Method FromClient Request - -- Code Action/Lens/Link - TextDocumentCodeAction :: Method FromClient Request - TextDocumentCodeLens :: Method FromClient Request - CodeLensResolve :: Method FromClient Request - TextDocumentDocumentLink :: Method FromClient Request - DocumentLinkResolve :: Method FromClient Request - -- Syntax highlighting/Coloring - TextDocumentDocumentColor :: Method FromClient Request - TextDocumentColorPresentation :: Method FromClient Request - -- Formatting - TextDocumentFormatting :: Method FromClient Request - TextDocumentRangeFormatting :: Method FromClient Request - TextDocumentOnTypeFormatting :: Method FromClient Request - -- Rename - TextDocumentRename :: Method FromClient Request - TextDocumentPrepareRename :: Method FromClient Request - -- FoldingRange - TextDocumentFoldingRange :: Method FromClient Request - TextDocumentSelectionRange :: Method FromClient Request - -- Call hierarchy - TextDocumentPrepareCallHierarchy :: Method FromClient Request - CallHierarchyIncomingCalls :: Method FromClient Request - CallHierarchyOutgoingCalls :: Method FromClient Request - -- SemanticTokens - TextDocumentSemanticTokens :: Method FromClient Request - TextDocumentSemanticTokensFull :: Method FromClient Request - TextDocumentSemanticTokensFullDelta :: Method FromClient Request - TextDocumentSemanticTokensRange :: Method FromClient Request - --- ServerMethods - -- Window - WindowShowMessage :: Method FromServer Notification - WindowShowMessageRequest :: Method FromServer Request - WindowShowDocument :: Method FromServer Request - WindowLogMessage :: Method FromServer Notification - WindowWorkDoneProgressCancel :: Method FromClient Notification - WindowWorkDoneProgressCreate :: Method FromServer Request - -- Progress - Progress :: Method FromServer Notification - -- Telemetry - TelemetryEvent :: Method FromServer Notification - -- Client - ClientRegisterCapability :: Method FromServer Request - ClientUnregisterCapability :: Method FromServer Request - -- Workspace - WorkspaceWorkspaceFolders :: Method FromServer Request - WorkspaceConfiguration :: Method FromServer Request - WorkspaceApplyEdit :: Method FromServer Request - WorkspaceSemanticTokensRefresh :: Method FromServer Request - -- Document - TextDocumentPublishDiagnostics :: Method FromServer Notification - --- Cancelling - CancelRequest :: Method f Notification - --- Custom - -- A custom message type. It is not enforced that this starts with $/. - CustomMethod :: Method f t - -data SMethod (m :: Method f t) where - SInitialize :: SMethod Initialize - SInitialized :: SMethod Initialized - SShutdown :: SMethod Shutdown - SExit :: SMethod Exit - SWorkspaceDidChangeWorkspaceFolders :: SMethod WorkspaceDidChangeWorkspaceFolders - SWorkspaceDidChangeConfiguration :: SMethod WorkspaceDidChangeConfiguration - SWorkspaceDidChangeWatchedFiles :: SMethod WorkspaceDidChangeWatchedFiles - SWorkspaceSymbol :: SMethod WorkspaceSymbol - SWorkspaceExecuteCommand :: SMethod WorkspaceExecuteCommand - STextDocumentDidOpen :: SMethod TextDocumentDidOpen - STextDocumentDidChange :: SMethod TextDocumentDidChange - STextDocumentWillSave :: SMethod TextDocumentWillSave - STextDocumentWillSaveWaitUntil :: SMethod TextDocumentWillSaveWaitUntil - STextDocumentDidSave :: SMethod TextDocumentDidSave - STextDocumentDidClose :: SMethod TextDocumentDidClose - STextDocumentCompletion :: SMethod TextDocumentCompletion - SCompletionItemResolve :: SMethod CompletionItemResolve - STextDocumentHover :: SMethod TextDocumentHover - STextDocumentSignatureHelp :: SMethod TextDocumentSignatureHelp - STextDocumentDeclaration :: SMethod TextDocumentDeclaration - STextDocumentDefinition :: SMethod TextDocumentDefinition - STextDocumentTypeDefinition :: SMethod TextDocumentTypeDefinition - STextDocumentImplementation :: SMethod TextDocumentImplementation - STextDocumentReferences :: SMethod TextDocumentReferences - STextDocumentDocumentHighlight :: SMethod TextDocumentDocumentHighlight - STextDocumentDocumentSymbol :: SMethod TextDocumentDocumentSymbol - STextDocumentCodeAction :: SMethod TextDocumentCodeAction - STextDocumentCodeLens :: SMethod TextDocumentCodeLens - SCodeLensResolve :: SMethod CodeLensResolve - STextDocumentDocumentLink :: SMethod TextDocumentDocumentLink - SDocumentLinkResolve :: SMethod DocumentLinkResolve - STextDocumentDocumentColor :: SMethod TextDocumentDocumentColor - STextDocumentColorPresentation :: SMethod TextDocumentColorPresentation - STextDocumentFormatting :: SMethod TextDocumentFormatting - STextDocumentRangeFormatting :: SMethod TextDocumentRangeFormatting - STextDocumentOnTypeFormatting :: SMethod TextDocumentOnTypeFormatting - STextDocumentRename :: SMethod TextDocumentRename - STextDocumentPrepareRename :: SMethod TextDocumentPrepareRename - STextDocumentFoldingRange :: SMethod TextDocumentFoldingRange - STextDocumentSelectionRange :: SMethod TextDocumentSelectionRange - STextDocumentPrepareCallHierarchy :: SMethod TextDocumentPrepareCallHierarchy - SCallHierarchyIncomingCalls :: SMethod CallHierarchyIncomingCalls - SCallHierarchyOutgoingCalls :: SMethod CallHierarchyOutgoingCalls - - STextDocumentSemanticTokens :: SMethod TextDocumentSemanticTokens - STextDocumentSemanticTokensFull :: SMethod TextDocumentSemanticTokensFull - STextDocumentSemanticTokensFullDelta :: SMethod TextDocumentSemanticTokensFullDelta - STextDocumentSemanticTokensRange :: SMethod TextDocumentSemanticTokensRange - SWorkspaceSemanticTokensRefresh :: SMethod WorkspaceSemanticTokensRefresh - - SWindowShowMessage :: SMethod WindowShowMessage - SWindowShowMessageRequest :: SMethod WindowShowMessageRequest - SWindowShowDocument :: SMethod WindowShowDocument - SWindowLogMessage :: SMethod WindowLogMessage - SWindowWorkDoneProgressCreate :: SMethod WindowWorkDoneProgressCreate - SWindowWorkDoneProgressCancel :: SMethod WindowWorkDoneProgressCancel - SProgress :: SMethod Progress - STelemetryEvent :: SMethod TelemetryEvent - SClientRegisterCapability :: SMethod ClientRegisterCapability - SClientUnregisterCapability :: SMethod ClientUnregisterCapability - SWorkspaceWorkspaceFolders :: SMethod WorkspaceWorkspaceFolders - SWorkspaceConfiguration :: SMethod WorkspaceConfiguration - SWorkspaceApplyEdit :: SMethod WorkspaceApplyEdit - STextDocumentPublishDiagnostics :: SMethod TextDocumentPublishDiagnostics - - SCancelRequest :: SMethod CancelRequest - SCustomMethod :: Text -> SMethod CustomMethod - --- This instance is written manually rather than derived to avoid a dependency --- on 'dependent-sum-template'. -instance GEq SMethod where - geq x y = case gcompare x y of - GLT -> Nothing - GEQ -> Just Refl - GGT -> Nothing - --- This instance is written manually rather than derived to avoid a dependency --- on 'dependent-sum-template'. -instance GCompare SMethod where - gcompare (SCustomMethod x) (SCustomMethod y) = case x `compare` y of - LT -> GLT - EQ -> GEQ - GT -> GGT - -- This is much more compact than matching on every pair of constructors, which - -- is what we would need to do for GHC to 'see' that this is correct. Nonetheless - -- it is safe: since there is only one constructor of 'SMethod' for each 'Method', - -- the argument types can only be equal if the constructor tag is equal. - gcompare x y = case I# (dataToTag# x) `compare` I# (dataToTag# y) of - LT -> GLT - EQ -> unsafeCoerce GEQ - GT -> GGT - -instance Eq (SMethod m) where - -- This defers to 'GEq', ensuring that this version is compatible. - (==) = defaultEq - -instance Ord (SMethod m) where - -- This defers to 'GCompare', ensuring that this version is compatible. - compare = defaultCompare - -deriving instance Show (SMethod m) - --- Some useful type synonyms -type SClientMethod (m :: Method FromClient t) = SMethod m -type SServerMethod (m :: Method FromServer t) = SMethod m - -data SomeClientMethod = forall t (m :: Method FromClient t). SomeClientMethod (SMethod m) -data SomeServerMethod = forall t (m :: Method FromServer t). SomeServerMethod (SMethod m) - -data SomeMethod where - SomeMethod :: forall m. SMethod m -> SomeMethod - -deriving instance Show SomeMethod -instance Eq SomeMethod where - (==) = (==) `on` toJSON -instance Ord SomeMethod where - compare = compare `on` (getString . toJSON) - where - getString (A.String t) = t - getString _ = error "ToJSON instance for some method isn't string" -deriving instance Show SomeClientMethod -instance Eq SomeClientMethod where - (==) = (==) `on` toJSON -instance Ord SomeClientMethod where - compare = compare `on` (getString . toJSON) - where - getString (A.String t) = t - getString _ = error "ToJSON instance for some method isn't string" -deriving instance Show SomeServerMethod -instance Eq SomeServerMethod where - (==) = (==) `on` toJSON -instance Ord SomeServerMethod where - compare = compare `on` (getString . toJSON) - where - getString (A.String t) = t - getString _ = error "ToJSON instance for some method isn't string" - --- --------------------------------------------------------------------- --- From JSON --- --------------------------------------------------------------------- - -instance FromJSON SomeMethod where - parseJSON v = client <|> server - where - client = do - c <- parseJSON v - case c of - -- Don't parse the client custom method so that we can still - -- parse the server methods - SomeClientMethod (SCustomMethod _) -> mempty - SomeClientMethod m -> pure $ SomeMethod m - server = do - c <- parseJSON v - case c of - SomeServerMethod m -> pure $ SomeMethod m - -instance FromJSON SomeClientMethod where - -- General - parseJSON (A.String "initialize") = pure $ SomeClientMethod SInitialize - parseJSON (A.String "initialized") = pure $ SomeClientMethod SInitialized - parseJSON (A.String "shutdown") = pure $ SomeClientMethod SShutdown - parseJSON (A.String "exit") = pure $ SomeClientMethod SExit - -- Workspace - parseJSON (A.String "workspace/didChangeWorkspaceFolders") = pure $ SomeClientMethod SWorkspaceDidChangeWorkspaceFolders - parseJSON (A.String "workspace/didChangeConfiguration") = pure $ SomeClientMethod SWorkspaceDidChangeConfiguration - parseJSON (A.String "workspace/didChangeWatchedFiles") = pure $ SomeClientMethod SWorkspaceDidChangeWatchedFiles - parseJSON (A.String "workspace/symbol") = pure $ SomeClientMethod SWorkspaceSymbol - parseJSON (A.String "workspace/executeCommand") = pure $ SomeClientMethod SWorkspaceExecuteCommand - -- Document - parseJSON (A.String "textDocument/didOpen") = pure $ SomeClientMethod STextDocumentDidOpen - parseJSON (A.String "textDocument/didChange") = pure $ SomeClientMethod STextDocumentDidChange - parseJSON (A.String "textDocument/willSave") = pure $ SomeClientMethod STextDocumentWillSave - parseJSON (A.String "textDocument/willSaveWaitUntil") = pure $ SomeClientMethod STextDocumentWillSaveWaitUntil - parseJSON (A.String "textDocument/didSave") = pure $ SomeClientMethod STextDocumentDidSave - parseJSON (A.String "textDocument/didClose") = pure $ SomeClientMethod STextDocumentDidClose - parseJSON (A.String "textDocument/completion") = pure $ SomeClientMethod STextDocumentCompletion - parseJSON (A.String "completionItem/resolve") = pure $ SomeClientMethod SCompletionItemResolve - parseJSON (A.String "textDocument/hover") = pure $ SomeClientMethod STextDocumentHover - parseJSON (A.String "textDocument/signatureHelp") = pure $ SomeClientMethod STextDocumentSignatureHelp - parseJSON (A.String "textDocument/declaration") = pure $ SomeClientMethod STextDocumentDeclaration - parseJSON (A.String "textDocument/definition") = pure $ SomeClientMethod STextDocumentDefinition - parseJSON (A.String "textDocument/typeDefinition") = pure $ SomeClientMethod STextDocumentTypeDefinition - parseJSON (A.String "textDocument/implementation") = pure $ SomeClientMethod STextDocumentImplementation - parseJSON (A.String "textDocument/references") = pure $ SomeClientMethod STextDocumentReferences - parseJSON (A.String "textDocument/documentHighlight") = pure $ SomeClientMethod STextDocumentDocumentHighlight - parseJSON (A.String "textDocument/documentSymbol") = pure $ SomeClientMethod STextDocumentDocumentSymbol - parseJSON (A.String "textDocument/codeAction") = pure $ SomeClientMethod STextDocumentCodeAction - parseJSON (A.String "textDocument/codeLens") = pure $ SomeClientMethod STextDocumentCodeLens - parseJSON (A.String "codeLens/resolve") = pure $ SomeClientMethod SCodeLensResolve - parseJSON (A.String "textDocument/documentLink") = pure $ SomeClientMethod STextDocumentDocumentLink - parseJSON (A.String "documentLink/resolve") = pure $ SomeClientMethod SDocumentLinkResolve - parseJSON (A.String "textDocument/documentColor") = pure $ SomeClientMethod STextDocumentDocumentColor - parseJSON (A.String "textDocument/colorPresentation") = pure $ SomeClientMethod STextDocumentColorPresentation - parseJSON (A.String "textDocument/formatting") = pure $ SomeClientMethod STextDocumentFormatting - parseJSON (A.String "textDocument/rangeFormatting") = pure $ SomeClientMethod STextDocumentRangeFormatting - parseJSON (A.String "textDocument/onTypeFormatting") = pure $ SomeClientMethod STextDocumentOnTypeFormatting - parseJSON (A.String "textDocument/rename") = pure $ SomeClientMethod STextDocumentRename - parseJSON (A.String "textDocument/prepareRename") = pure $ SomeClientMethod STextDocumentPrepareRename - parseJSON (A.String "textDocument/foldingRange") = pure $ SomeClientMethod STextDocumentFoldingRange - parseJSON (A.String "textDocument/selectionRange") = pure $ SomeClientMethod STextDocumentSelectionRange - parseJSON (A.String "textDocument/prepareCallHierarchy") = pure $ SomeClientMethod STextDocumentPrepareCallHierarchy - parseJSON (A.String "callHierarchy/incomingCalls") = pure $ SomeClientMethod SCallHierarchyIncomingCalls - parseJSON (A.String "callHierarchy/outgoingCalls") = pure $ SomeClientMethod SCallHierarchyOutgoingCalls - parseJSON (A.String "textDocument/semanticTokens") = pure $ SomeClientMethod STextDocumentSemanticTokens - parseJSON (A.String "textDocument/semanticTokens/full") = pure $ SomeClientMethod STextDocumentSemanticTokensFull - parseJSON (A.String "textDocument/semanticTokens/full/delta") = pure $ SomeClientMethod STextDocumentSemanticTokensFullDelta - parseJSON (A.String "textDocument/semanticTokens/range") = pure $ SomeClientMethod STextDocumentSemanticTokensRange - parseJSON (A.String "window/workDoneProgress/cancel") = pure $ SomeClientMethod SWindowWorkDoneProgressCancel --- Cancelling - parseJSON (A.String "$/cancelRequest") = pure $ SomeClientMethod SCancelRequest --- Custom - parseJSON (A.String m) = pure $ SomeClientMethod (SCustomMethod m) - parseJSON _ = fail "SomeClientMethod" - -instance A.FromJSON SomeServerMethod where --- Server - -- Window - parseJSON (A.String "window/showMessage") = pure $ SomeServerMethod SWindowShowMessage - parseJSON (A.String "window/showMessageRequest") = pure $ SomeServerMethod SWindowShowMessageRequest - parseJSON (A.String "window/showDocument") = pure $ SomeServerMethod SWindowShowDocument - parseJSON (A.String "window/logMessage") = pure $ SomeServerMethod SWindowLogMessage - parseJSON (A.String "window/workDoneProgress/create") = pure $ SomeServerMethod SWindowWorkDoneProgressCreate - parseJSON (A.String "$/progress") = pure $ SomeServerMethod SProgress - parseJSON (A.String "telemetry/event") = pure $ SomeServerMethod STelemetryEvent - -- Client - parseJSON (A.String "client/registerCapability") = pure $ SomeServerMethod SClientRegisterCapability - parseJSON (A.String "client/unregisterCapability") = pure $ SomeServerMethod SClientUnregisterCapability - -- Workspace - parseJSON (A.String "workspace/workspaceFolders") = pure $ SomeServerMethod SWorkspaceWorkspaceFolders - parseJSON (A.String "workspace/configuration") = pure $ SomeServerMethod SWorkspaceConfiguration - parseJSON (A.String "workspace/applyEdit") = pure $ SomeServerMethod SWorkspaceApplyEdit - parseJSON (A.String "workspace/semanticTokens/refresh") = pure $ SomeServerMethod SWorkspaceSemanticTokensRefresh - -- Document - parseJSON (A.String "textDocument/publishDiagnostics") = pure $ SomeServerMethod STextDocumentPublishDiagnostics - --- Cancelling - parseJSON (A.String "$/cancelRequest") = pure $ SomeServerMethod SCancelRequest - --- Custom - parseJSON (A.String m) = pure $ SomeServerMethod (SCustomMethod m) - parseJSON _ = fail "SomeServerMethod" - --- instance FromJSON (SMethod m) - --- --------------------------------------------------------------------- --- TO JSON --- --------------------------------------------------------------------- - -instance ToJSON SomeMethod where - toJSON (SomeMethod m) = toJSON m - -instance ToJSON SomeClientMethod where - toJSON (SomeClientMethod m) = toJSON m -instance ToJSON SomeServerMethod where - toJSON (SomeServerMethod m) = toJSON m - -instance A.ToJSON (SMethod m) where --- Client - -- General - toJSON SInitialize = A.String "initialize" - toJSON SInitialized = A.String "initialized" - toJSON SShutdown = A.String "shutdown" - toJSON SExit = A.String "exit" - -- Workspace - toJSON SWorkspaceDidChangeWorkspaceFolders = A.String "workspace/didChangeWorkspaceFolders" - toJSON SWorkspaceDidChangeConfiguration = A.String "workspace/didChangeConfiguration" - toJSON SWorkspaceDidChangeWatchedFiles = A.String "workspace/didChangeWatchedFiles" - toJSON SWorkspaceSymbol = A.String "workspace/symbol" - toJSON SWorkspaceExecuteCommand = A.String "workspace/executeCommand" - -- Document - toJSON STextDocumentDidOpen = A.String "textDocument/didOpen" - toJSON STextDocumentDidChange = A.String "textDocument/didChange" - toJSON STextDocumentWillSave = A.String "textDocument/willSave" - toJSON STextDocumentWillSaveWaitUntil = A.String "textDocument/willSaveWaitUntil" - toJSON STextDocumentDidSave = A.String "textDocument/didSave" - toJSON STextDocumentDidClose = A.String "textDocument/didClose" - toJSON STextDocumentCompletion = A.String "textDocument/completion" - toJSON SCompletionItemResolve = A.String "completionItem/resolve" - toJSON STextDocumentHover = A.String "textDocument/hover" - toJSON STextDocumentSignatureHelp = A.String "textDocument/signatureHelp" - toJSON STextDocumentReferences = A.String "textDocument/references" - toJSON STextDocumentDocumentHighlight = A.String "textDocument/documentHighlight" - toJSON STextDocumentDocumentSymbol = A.String "textDocument/documentSymbol" - toJSON STextDocumentDeclaration = A.String "textDocument/declaration" - toJSON STextDocumentDefinition = A.String "textDocument/definition" - toJSON STextDocumentTypeDefinition = A.String "textDocument/typeDefinition" - toJSON STextDocumentImplementation = A.String "textDocument/implementation" - toJSON STextDocumentCodeAction = A.String "textDocument/codeAction" - toJSON STextDocumentCodeLens = A.String "textDocument/codeLens" - toJSON SCodeLensResolve = A.String "codeLens/resolve" - toJSON STextDocumentDocumentColor = A.String "textDocument/documentColor" - toJSON STextDocumentColorPresentation = A.String "textDocument/colorPresentation" - toJSON STextDocumentFormatting = A.String "textDocument/formatting" - toJSON STextDocumentRangeFormatting = A.String "textDocument/rangeFormatting" - toJSON STextDocumentOnTypeFormatting = A.String "textDocument/onTypeFormatting" - toJSON STextDocumentRename = A.String "textDocument/rename" - toJSON STextDocumentPrepareRename = A.String "textDocument/prepareRename" - toJSON STextDocumentFoldingRange = A.String "textDocument/foldingRange" - toJSON STextDocumentSelectionRange = A.String "textDocument/selectionRange" - toJSON STextDocumentPrepareCallHierarchy = A.String "textDocument/prepareCallHierarchy" - toJSON SCallHierarchyIncomingCalls = A.String "callHierarchy/incomingCalls" - toJSON SCallHierarchyOutgoingCalls = A.String "callHierarchy/outgoingCalls" - toJSON STextDocumentSemanticTokens = A.String "textDocument/semanticTokens" - toJSON STextDocumentSemanticTokensFull = A.String "textDocument/semanticTokens/full" - toJSON STextDocumentSemanticTokensFullDelta = A.String "textDocument/semanticTokens/full/delta" - toJSON STextDocumentSemanticTokensRange = A.String "textDocument/semanticTokens/range" - toJSON STextDocumentDocumentLink = A.String "textDocument/documentLink" - toJSON SDocumentLinkResolve = A.String "documentLink/resolve" - toJSON SWindowWorkDoneProgressCancel = A.String "window/workDoneProgress/cancel" --- Server - -- Window - toJSON SWindowShowMessage = A.String "window/showMessage" - toJSON SWindowShowMessageRequest = A.String "window/showMessageRequest" - toJSON SWindowShowDocument = A.String "window/showDocument" - toJSON SWindowLogMessage = A.String "window/logMessage" - toJSON SWindowWorkDoneProgressCreate = A.String "window/workDoneProgress/create" - toJSON SProgress = A.String "$/progress" - toJSON STelemetryEvent = A.String "telemetry/event" - -- Client - toJSON SClientRegisterCapability = A.String "client/registerCapability" - toJSON SClientUnregisterCapability = A.String "client/unregisterCapability" - -- Workspace - toJSON SWorkspaceWorkspaceFolders = A.String "workspace/workspaceFolders" - toJSON SWorkspaceConfiguration = A.String "workspace/configuration" - toJSON SWorkspaceApplyEdit = A.String "workspace/applyEdit" - toJSON SWorkspaceSemanticTokensRefresh = A.String "workspace/semanticTokens/refresh" - -- Document - toJSON STextDocumentPublishDiagnostics = A.String "textDocument/publishDiagnostics" - -- Cancelling - toJSON SCancelRequest = A.String "$/cancelRequest" --- Custom - toJSON (SCustomMethod m) = A.String m - -makeSingletonFromJSON 'SomeMethod ''SMethod diff --git a/lsp-types/src/Language/LSP/Types/Parsing.hs b/lsp-types/src/Language/LSP/Types/Parsing.hs deleted file mode 100644 index 67316bc8c..000000000 --- a/lsp-types/src/Language/LSP/Types/Parsing.hs +++ /dev/null @@ -1,340 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE TypeInType #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Language.LSP.Types.Parsing where - -import Language.LSP.Types.LspId -import Language.LSP.Types.Method -import Language.LSP.Types.Message - -import Data.Aeson -import Data.Aeson.Types -import Data.GADT.Compare -import Data.Type.Equality -import Data.Function (on) - --- --------------------------------------------------------------------- --- Working with arbitrary messages --- --------------------------------------------------------------------- - -data FromServerMessage' a where - FromServerMess :: forall t (m :: Method FromServer t) a. SMethod m -> Message m -> FromServerMessage' a - FromServerRsp :: forall (m :: Method FromClient Request) a. a m -> ResponseMessage m -> FromServerMessage' a - -type FromServerMessage = FromServerMessage' SMethod - -instance Eq FromServerMessage where - (==) = (==) `on` toJSON -instance Show FromServerMessage where - show = show . toJSON - -instance ToJSON FromServerMessage where - toJSON (FromServerMess m p) = serverMethodJSON m (toJSON p) - toJSON (FromServerRsp m p) = clientResponseJSON m (toJSON p) - -fromServerNot :: forall (m :: Method FromServer Notification). - Message m ~ NotificationMessage m => NotificationMessage m -> FromServerMessage -fromServerNot m@NotificationMessage{_method=meth} = FromServerMess meth m - -fromServerReq :: forall (m :: Method FromServer Request). - Message m ~ RequestMessage m => RequestMessage m -> FromServerMessage -fromServerReq m@RequestMessage{_method=meth} = FromServerMess meth m - -data FromClientMessage' a where - FromClientMess :: forall t (m :: Method FromClient t) a. SMethod m -> Message m -> FromClientMessage' a - FromClientRsp :: forall (m :: Method FromServer Request) a. a m -> ResponseMessage m -> FromClientMessage' a - -type FromClientMessage = FromClientMessage' SMethod - -instance ToJSON FromClientMessage where - toJSON (FromClientMess m p) = clientMethodJSON m (toJSON p) - toJSON (FromClientRsp m p) = serverResponseJSON m (toJSON p) - -fromClientNot :: forall (m :: Method FromClient Notification). - Message m ~ NotificationMessage m => NotificationMessage m -> FromClientMessage -fromClientNot m@NotificationMessage{_method=meth} = FromClientMess meth m - -fromClientReq :: forall (m :: Method FromClient Request). - Message m ~ RequestMessage m => RequestMessage m -> FromClientMessage -fromClientReq m@RequestMessage{_method=meth} = FromClientMess meth m - --- --------------------------------------------------------------------- --- Parsing --- --------------------------------------------------------------------- - -type LookupFunc f a = forall (m :: Method f Request). LspId m -> Maybe (SMethod m, a m) - -{- -Message Types we must handle are the following - -Request | jsonrpc | id | method | params? -Response | jsonrpc | id | | | response? | error? -Notification | jsonrpc | | method | params? --} - -{-# INLINE parseServerMessage #-} -parseServerMessage :: LookupFunc FromClient a -> Value -> Parser (FromServerMessage' a) -parseServerMessage lookupId v@(Object o) = do - methMaybe <- o .:! "method" - idMaybe <- o .:! "id" - case methMaybe of - -- Request or Notification - Just (SomeServerMethod m) -> - case splitServerMethod m of - IsServerNot -> FromServerMess m <$> parseJSON v - IsServerReq -> FromServerMess m <$> parseJSON v - IsServerEither | SCustomMethod cm <- m -> do - case idMaybe of - -- Request - Just _ -> - let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromServer Request)) - in FromServerMess m' <$> parseJSON v - Nothing -> - let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromServer Notification)) - in FromServerMess m' <$> parseJSON v - Nothing -> do - case idMaybe of - Just i -> do - case lookupId i of - Just (m,res) -> clientResponseJSON m $ FromServerRsp res <$> parseJSON v - Nothing -> fail $ unwords ["Failed in looking up response type of", show v] - Nothing -> fail $ unwords ["Got unexpected message without method or id"] -parseServerMessage _ v = fail $ unwords ["parseServerMessage expected object, got:",show v] - -{-# INLINE parseClientMessage #-} -parseClientMessage :: LookupFunc FromServer a -> Value -> Parser (FromClientMessage' a) -parseClientMessage lookupId v@(Object o) = do - methMaybe <- o .:! "method" - idMaybe <- o .:! "id" - case methMaybe of - -- Request or Notification - Just (SomeClientMethod m) -> - case splitClientMethod m of - IsClientNot -> FromClientMess m <$> parseJSON v - IsClientReq -> FromClientMess m <$> parseJSON v - IsClientEither | SCustomMethod cm <- m -> do - case idMaybe of - -- Request - Just _ -> - let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromClient Request)) - in FromClientMess m' <$> parseJSON v - Nothing -> - let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromClient Notification)) - in FromClientMess m' <$> parseJSON v - Nothing -> do - case idMaybe of - Just i -> do - case lookupId i of - Just (m,res) -> serverResponseJSON m $ FromClientRsp res <$> parseJSON v - Nothing -> fail $ unwords ["Failed in looking up response type of", show v] - Nothing -> fail $ unwords ["Got unexpected message without method or id"] -parseClientMessage _ v = fail $ unwords ["parseClientMessage expected object, got:",show v] - --- --------------------------------------------------------------------- --- Helper Utilities --- --------------------------------------------------------------------- - -{-# INLINE clientResponseJSON #-} -clientResponseJSON :: SClientMethod m -> (HasJSON (ResponseMessage m) => x) -> x -clientResponseJSON m x = case splitClientMethod m of - IsClientReq -> x - IsClientEither -> x - -{-# INLINE serverResponseJSON #-} -serverResponseJSON :: SServerMethod m -> (HasJSON (ResponseMessage m) => x) -> x -serverResponseJSON m x = case splitServerMethod m of - IsServerReq -> x - IsServerEither -> x - -{-# INLINE clientMethodJSON#-} -clientMethodJSON :: SClientMethod m -> (ToJSON (ClientMessage m) => x) -> x -clientMethodJSON m x = - case splitClientMethod m of - IsClientNot -> x - IsClientReq -> x - IsClientEither -> x - -{-# INLINE serverMethodJSON #-} -serverMethodJSON :: SServerMethod m -> (ToJSON (ServerMessage m) => x) -> x -serverMethodJSON m x = - case splitServerMethod m of - IsServerNot -> x - IsServerReq -> x - IsServerEither -> x - -type HasJSON a = (ToJSON a,FromJSON a,Eq a) - --- Reify universal properties about Client/Server Messages - -data ClientNotOrReq (m :: Method FromClient t) where - IsClientNot - :: ( HasJSON (ClientMessage m) - , Message m ~ NotificationMessage m) - => ClientNotOrReq (m :: Method FromClient Notification) - IsClientReq - :: forall (m :: Method FromClient Request). - ( HasJSON (ClientMessage m) - , HasJSON (ResponseMessage m) - , Message m ~ RequestMessage m) - => ClientNotOrReq m - IsClientEither - :: ClientNotOrReq CustomMethod - -data ServerNotOrReq (m :: Method FromServer t) where - IsServerNot - :: ( HasJSON (ServerMessage m) - , Message m ~ NotificationMessage m) - => ServerNotOrReq (m :: Method FromServer Notification) - IsServerReq - :: forall (m :: Method FromServer Request). - ( HasJSON (ServerMessage m) - , HasJSON (ResponseMessage m) - , Message m ~ RequestMessage m) - => ServerNotOrReq m - IsServerEither - :: ServerNotOrReq CustomMethod - -{-# INLINE splitClientMethod #-} -splitClientMethod :: SClientMethod m -> ClientNotOrReq m -splitClientMethod SInitialize = IsClientReq -splitClientMethod SInitialized = IsClientNot -splitClientMethod SShutdown = IsClientReq -splitClientMethod SExit = IsClientNot -splitClientMethod SWorkspaceDidChangeWorkspaceFolders = IsClientNot -splitClientMethod SWorkspaceDidChangeConfiguration = IsClientNot -splitClientMethod SWorkspaceDidChangeWatchedFiles = IsClientNot -splitClientMethod SWorkspaceSymbol = IsClientReq -splitClientMethod SWorkspaceExecuteCommand = IsClientReq -splitClientMethod SWindowWorkDoneProgressCancel = IsClientNot -splitClientMethod STextDocumentDidOpen = IsClientNot -splitClientMethod STextDocumentDidChange = IsClientNot -splitClientMethod STextDocumentWillSave = IsClientNot -splitClientMethod STextDocumentWillSaveWaitUntil = IsClientReq -splitClientMethod STextDocumentDidSave = IsClientNot -splitClientMethod STextDocumentDidClose = IsClientNot -splitClientMethod STextDocumentCompletion = IsClientReq -splitClientMethod SCompletionItemResolve = IsClientReq -splitClientMethod STextDocumentHover = IsClientReq -splitClientMethod STextDocumentSignatureHelp = IsClientReq -splitClientMethod STextDocumentDeclaration = IsClientReq -splitClientMethod STextDocumentDefinition = IsClientReq -splitClientMethod STextDocumentTypeDefinition = IsClientReq -splitClientMethod STextDocumentImplementation = IsClientReq -splitClientMethod STextDocumentReferences = IsClientReq -splitClientMethod STextDocumentDocumentHighlight = IsClientReq -splitClientMethod STextDocumentDocumentSymbol = IsClientReq -splitClientMethod STextDocumentCodeAction = IsClientReq -splitClientMethod STextDocumentCodeLens = IsClientReq -splitClientMethod SCodeLensResolve = IsClientReq -splitClientMethod STextDocumentDocumentLink = IsClientReq -splitClientMethod SDocumentLinkResolve = IsClientReq -splitClientMethod STextDocumentDocumentColor = IsClientReq -splitClientMethod STextDocumentColorPresentation = IsClientReq -splitClientMethod STextDocumentFormatting = IsClientReq -splitClientMethod STextDocumentRangeFormatting = IsClientReq -splitClientMethod STextDocumentOnTypeFormatting = IsClientReq -splitClientMethod STextDocumentRename = IsClientReq -splitClientMethod STextDocumentPrepareRename = IsClientReq -splitClientMethod STextDocumentFoldingRange = IsClientReq -splitClientMethod STextDocumentSelectionRange = IsClientReq -splitClientMethod STextDocumentPrepareCallHierarchy = IsClientReq -splitClientMethod SCallHierarchyIncomingCalls = IsClientReq -splitClientMethod SCallHierarchyOutgoingCalls = IsClientReq -splitClientMethod STextDocumentSemanticTokens = IsClientReq -splitClientMethod STextDocumentSemanticTokensFull = IsClientReq -splitClientMethod STextDocumentSemanticTokensFullDelta = IsClientReq -splitClientMethod STextDocumentSemanticTokensRange = IsClientReq -splitClientMethod SCancelRequest = IsClientNot -splitClientMethod SCustomMethod{} = IsClientEither - -{-# INLINE splitServerMethod #-} -splitServerMethod :: SServerMethod m -> ServerNotOrReq m --- Window -splitServerMethod SWindowShowMessage = IsServerNot -splitServerMethod SWindowShowMessageRequest = IsServerReq -splitServerMethod SWindowShowDocument = IsServerReq -splitServerMethod SWindowLogMessage = IsServerNot -splitServerMethod SWindowWorkDoneProgressCreate = IsServerReq -splitServerMethod SProgress = IsServerNot -splitServerMethod STelemetryEvent = IsServerNot --- Client -splitServerMethod SClientRegisterCapability = IsServerReq -splitServerMethod SClientUnregisterCapability = IsServerReq --- Workspace -splitServerMethod SWorkspaceWorkspaceFolders = IsServerReq -splitServerMethod SWorkspaceConfiguration = IsServerReq -splitServerMethod SWorkspaceApplyEdit = IsServerReq -splitServerMethod SWorkspaceSemanticTokensRefresh = IsServerReq --- Document -splitServerMethod STextDocumentPublishDiagnostics = IsServerNot --- Cancelling -splitServerMethod SCancelRequest = IsServerNot --- Custom -splitServerMethod SCustomMethod{} = IsServerEither - --- | Given a witness that two custom methods are of the same type, produce a witness that the methods are the same -data CustomEq m1 m2 where - CustomEq - :: (m1 ~ (CustomMethod :: Method f t1), m2 ~ (CustomMethod :: Method f t2)) - => { runCustomEq :: (t1 ~ t2 => m1 :~~: m2) } - -> CustomEq m1 m2 - -runEq :: (t1 ~ t2) - => (SMethod m1 -> SMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))) - -> SMethod (m1 :: Method f t1) - -> SMethod (m2 :: Method f t2) - -> Maybe (m1 :~~: m2) -runEq f m1 m2 = do - res <- f m1 m2 - pure $ case res of - Right eq -> eq - Left ceq -> runCustomEq ceq - --- | Heterogeneous equality on singleton server methods -mEqServer :: SServerMethod m1 -> SServerMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2)) -mEqServer m1 m2 = go (splitServerMethod m1) (splitServerMethod m2) - where - go IsServerNot IsServerNot = do - Refl <- geq m1 m2 - pure $ Right HRefl - go IsServerReq IsServerReq = do - Refl <- geq m1 m2 - pure $ Right HRefl - go IsServerEither IsServerEither - | SCustomMethod c1 <- m1 - , SCustomMethod c2 <- m2 - , c1 == c2 - = Just $ Left $ CustomEq HRefl - go _ _ = Nothing - --- | Heterogeneous equality on singleton client methods -mEqClient :: SClientMethod m1 -> SClientMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2)) -mEqClient m1 m2 = go (splitClientMethod m1) (splitClientMethod m2) - where - go IsClientNot IsClientNot = do - Refl <- geq m1 m2 - pure $ Right HRefl - go IsClientReq IsClientReq = do - Refl <- geq m1 m2 - pure $ Right HRefl - go IsClientEither IsClientEither - | SCustomMethod c1 <- m1 - , SCustomMethod c2 <- m2 - , c1 == c2 - = Just $ Left $ CustomEq HRefl - go _ _ = Nothing diff --git a/lsp-types/src/Language/LSP/Types/Progress.hs b/lsp-types/src/Language/LSP/Types/Progress.hs deleted file mode 100644 index e9929de31..000000000 --- a/lsp-types/src/Language/LSP/Types/Progress.hs +++ /dev/null @@ -1,214 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE OverloadedStrings #-} - -module Language.LSP.Types.Progress where - -import Control.Monad (unless) -import qualified Data.Aeson as A -import Data.Aeson.TH -import Data.Maybe (catMaybes) -import Data.Text (Text) -import Language.LSP.Types.Common -import Language.LSP.Types.Utils - --- | A token used to report progress back or return partial results for a --- specific request. --- @since 0.17.0.0 -data ProgressToken - = ProgressNumericToken Int32 - | ProgressTextToken Text - deriving (Show, Read, Eq, Ord) - -deriveJSON lspOptionsUntagged ''ProgressToken - --- | Parameters for a $/progress notification. -data ProgressParams t = - ProgressParams { - _token :: ProgressToken - , _value :: t - } deriving (Show, Read, Eq, Functor) - -deriveJSON lspOptions ''ProgressParams - --- | Parameters for 'WorkDoneProgressBeginNotification'. --- --- @since 0.10.0.0 -data WorkDoneProgressBeginParams = - WorkDoneProgressBeginParams { - -- | Mandatory title of the progress operation. - -- Used to briefly inform about the kind of operation being - -- performed. Examples: "Indexing" or "Linking dependencies". - _title :: Text - -- | Controls if a cancel button should show to allow the user to cancel the - -- long running operation. Clients that don't support cancellation are allowed - -- to ignore the setting. - , _cancellable :: Maybe Bool - -- | Optional, more detailed associated progress - -- message. Contains complementary information to the - -- '_title'. Examples: "3/25 files", - -- "project/src/module2", "node_modules/some_dep". If - -- unset, the previous progress message (if any) is - -- still valid. - , _message :: Maybe Text - -- | Optional progress percentage to display (value 100 is considered 100%). - -- If not provided infinite progress is assumed and clients are allowed - -- to ignore the '_percentage' value in subsequent in report notifications. - -- - -- The value should be steadily rising. Clients are free to ignore values - -- that are not following this rule. - , _percentage :: Maybe UInt - } deriving (Show, Read, Eq) - -instance A.ToJSON WorkDoneProgressBeginParams where - toJSON WorkDoneProgressBeginParams{..} = - A.object $ catMaybes - [ Just $ "kind" A..= ("begin" :: Text) - , Just $ "title" A..= _title - , ("cancellable" A..=) <$> _cancellable - , ("message" A..=) <$> _message - , ("percentage" A..=) <$> _percentage - ] - -instance A.FromJSON WorkDoneProgressBeginParams where - parseJSON = A.withObject "WorkDoneProgressBegin" $ \o -> do - kind <- o A..: "kind" - unless (kind == ("begin" :: Text)) $ fail $ "Expected kind \"begin\" but got " ++ show kind - _title <- o A..: "title" - _cancellable <- o A..:? "cancellable" - _message <- o A..:? "message" - _percentage <- o A..:? "percentage" - pure WorkDoneProgressBeginParams{..} - --- The $/progress begin notification is sent from the server to the --- client to ask the client to start progress. --- --- @since 0.10.0.0 - --- | Parameters for 'WorkDoneProgressReportNotification' --- --- @since 0.10.0.0 -data WorkDoneProgressReportParams = - WorkDoneProgressReportParams { - _cancellable :: Maybe Bool - -- | Optional, more detailed associated progress - -- message. Contains complementary information to the - -- '_title'. Examples: "3/25 files", - -- "project/src/module2", "node_modules/some_dep". If - -- unset, the previous progress message (if any) is - -- still valid. - , _message :: Maybe Text - -- | Optional progress percentage to display (value 100 is considered 100%). - -- If infinite progress was indicated in the start notification client - -- are allowed to ignore the value. In addition the value should be steadily - -- rising. Clients are free to ignore values that are not following this rule. - , _percentage :: Maybe UInt - } deriving (Show, Read, Eq) - -instance A.ToJSON WorkDoneProgressReportParams where - toJSON WorkDoneProgressReportParams{..} = - A.object $ catMaybes - [ Just $ "kind" A..= ("report" :: Text) - , ("cancellable" A..=) <$> _cancellable - , ("message" A..=) <$> _message - , ("percentage" A..=) <$> _percentage - ] - -instance A.FromJSON WorkDoneProgressReportParams where - parseJSON = A.withObject "WorkDoneProgressReport" $ \o -> do - kind <- o A..: "kind" - unless (kind == ("report" :: Text)) $ fail $ "Expected kind \"report\" but got " ++ show kind - _cancellable <- o A..:? "cancellable" - _message <- o A..:? "message" - _percentage <- o A..:? "percentage" - pure WorkDoneProgressReportParams{..} - --- The workdone $/progress report notification is sent from the server to the --- client to report progress for a previously started progress. --- --- @since 0.10.0.0 - --- | Parameters for 'WorkDoneProgressEndNotification'. --- --- @since 0.10.0.0 -data WorkDoneProgressEndParams = - WorkDoneProgressEndParams { - _message :: Maybe Text - } deriving (Show, Read, Eq) - -instance A.ToJSON WorkDoneProgressEndParams where - toJSON WorkDoneProgressEndParams{..} = - A.object $ catMaybes - [ Just $ "kind" A..= ("end" :: Text) - , ("message" A..=) <$> _message - ] - -instance A.FromJSON WorkDoneProgressEndParams where - parseJSON = A.withObject "WorkDoneProgressEnd" $ \o -> do - kind <- o A..: "kind" - unless (kind == ("end" :: Text)) $ fail $ "Expected kind \"end\" but got " ++ show kind - _message <- o A..:? "message" - pure WorkDoneProgressEndParams{..} - --- The $/progress end notification is sent from the server to the --- client to stop a previously started progress. --- --- @since 0.10.0.0 - --- | Parameters for 'WorkDoneProgressCancelNotification'. --- --- @since 0.10.0.0 -data WorkDoneProgressCancelParams = - WorkDoneProgressCancelParams { - -- | A unique identifier to associate multiple progress - -- notifications with the same progress. - _token :: ProgressToken - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''WorkDoneProgressCancelParams - --- The window/workDoneProgress/cancel notification is sent from the client to the server --- to inform the server that the user has pressed the cancel button on the progress UX. --- A server receiving a cancel request must still close a progress using the done notification. --- --- @since 0.10.0.0 - -data WorkDoneProgressCreateParams = - WorkDoneProgressCreateParams { - _token :: ProgressToken - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''WorkDoneProgressCreateParams - -data WorkDoneProgressOptions = - WorkDoneProgressOptions - { _workDoneProgress :: Maybe Bool - } - deriving (Read, Show, Eq) - -deriveJSON lspOptions ''WorkDoneProgressOptions - -data WorkDoneProgressParams = - WorkDoneProgressParams - { -- | An optional token that a server can use to report work done progress - _workDoneToken :: Maybe ProgressToken - } deriving (Read,Show,Eq) -deriveJSON lspOptions ''WorkDoneProgressParams - -data SomeProgressParams - = Begin WorkDoneProgressBeginParams - | Report WorkDoneProgressReportParams - | End WorkDoneProgressEndParams - deriving Eq - -deriveJSON lspOptionsUntagged ''SomeProgressParams - -data PartialResultParams = - PartialResultParams - { -- | An optional token that a server can use to report partial results - -- (e.g. streaming) to the client. - _partialResultToken :: Maybe ProgressToken - } deriving (Read,Show,Eq) -deriveJSON lspOptions ''PartialResultParams diff --git a/lsp-types/src/Language/LSP/Types/References.hs b/lsp-types/src/Language/LSP/Types/References.hs deleted file mode 100644 index 9700d674e..000000000 --- a/lsp-types/src/Language/LSP/Types/References.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} --- | Find References Request --- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#textDocument_references -module Language.LSP.Types.References where - -import Data.Aeson.TH - -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Progress -import Language.LSP.Types.Utils - -data ReferencesClientCapabilities = - ReferencesClientCapabilities - { -- | Whether references supports dynamic registration. - _dynamicRegistration :: Maybe Bool - } deriving (Show, Read, Eq) -deriveJSON lspOptions ''ReferencesClientCapabilities - -makeExtendingDatatype "ReferenceOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''ReferenceOptions - -makeExtendingDatatype "ReferenceRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''ReferenceOptions - ] - [] -deriveJSON lspOptions ''ReferenceRegistrationOptions - -data ReferenceContext = - ReferenceContext - { -- | Include the declaration of the current symbol. - _includeDeclaration :: Bool - } deriving (Read,Show,Eq) -deriveJSON lspOptions ''ReferenceContext - -makeExtendingDatatype "ReferenceParams" - [ ''TextDocumentPositionParams - , ''WorkDoneProgressParams - , ''PartialResultParams - ] - [("_context", [t| ReferenceContext |])] -deriveJSON lspOptions ''ReferenceParams diff --git a/lsp-types/src/Language/LSP/Types/Registration.hs b/lsp-types/src/Language/LSP/Types/Registration.hs deleted file mode 100644 index 60e72ad24..000000000 --- a/lsp-types/src/Language/LSP/Types/Registration.hs +++ /dev/null @@ -1,179 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilyDependencies #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeInType #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} - -{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -{-# OPTIONS_GHC -Werror=incomplete-patterns #-} - -module Language.LSP.Types.Registration where - -import Data.Aeson -import Data.Aeson.TH -import Data.Text (Text) -import Data.Function (on) -import Data.Kind -import Data.Void (Void) -import GHC.Generics -import Language.LSP.Types.CallHierarchy -import Language.LSP.Types.CodeAction -import Language.LSP.Types.CodeLens -import Language.LSP.Types.Command -import Language.LSP.Types.Common -import Language.LSP.Types.Completion -import Language.LSP.Types.Declaration -import Language.LSP.Types.Definition -import Language.LSP.Types.DocumentColor -import Language.LSP.Types.DocumentHighlight -import Language.LSP.Types.DocumentLink -import Language.LSP.Types.DocumentSymbol -import Language.LSP.Types.FoldingRange -import Language.LSP.Types.Formatting -import Language.LSP.Types.Hover -import Language.LSP.Types.Implementation -import Language.LSP.Types.Method -import Language.LSP.Types.References -import Language.LSP.Types.Rename -import Language.LSP.Types.SignatureHelp -import Language.LSP.Types.SelectionRange -import Language.LSP.Types.SemanticTokens -import Language.LSP.Types.TextDocument -import Language.LSP.Types.TypeDefinition -import Language.LSP.Types.Utils -import Language.LSP.Types.WatchedFiles -import Language.LSP.Types.WorkspaceSymbol - - --- --------------------------------------------------------------------- - --- | Matches up the registration options for a specific method -type family RegistrationOptions (m :: Method FromClient t) :: Type where - -- Workspace - RegistrationOptions WorkspaceDidChangeWorkspaceFolders = Empty - RegistrationOptions WorkspaceDidChangeConfiguration = Empty - RegistrationOptions WorkspaceDidChangeWatchedFiles = DidChangeWatchedFilesRegistrationOptions - RegistrationOptions WorkspaceSymbol = WorkspaceSymbolRegistrationOptions - RegistrationOptions WorkspaceExecuteCommand = ExecuteCommandRegistrationOptions - - -- Text synchronisation - RegistrationOptions TextDocumentDidOpen = TextDocumentRegistrationOptions - RegistrationOptions TextDocumentDidChange = TextDocumentChangeRegistrationOptions - RegistrationOptions TextDocumentWillSave = TextDocumentRegistrationOptions - RegistrationOptions TextDocumentWillSaveWaitUntil = TextDocumentRegistrationOptions - RegistrationOptions TextDocumentDidSave = TextDocumentSaveRegistrationOptions - RegistrationOptions TextDocumentDidClose = TextDocumentRegistrationOptions - - -- Language features - RegistrationOptions TextDocumentCompletion = CompletionRegistrationOptions - RegistrationOptions TextDocumentHover = HoverRegistrationOptions - RegistrationOptions TextDocumentSignatureHelp = SignatureHelpRegistrationOptions - RegistrationOptions TextDocumentDeclaration = DeclarationRegistrationOptions - RegistrationOptions TextDocumentDefinition = DefinitionRegistrationOptions - RegistrationOptions TextDocumentTypeDefinition = TypeDefinitionRegistrationOptions - RegistrationOptions TextDocumentImplementation = ImplementationRegistrationOptions - RegistrationOptions TextDocumentReferences = ReferenceRegistrationOptions - RegistrationOptions TextDocumentDocumentHighlight = DocumentHighlightRegistrationOptions - RegistrationOptions TextDocumentDocumentSymbol = DocumentSymbolRegistrationOptions - RegistrationOptions TextDocumentCodeAction = CodeActionRegistrationOptions - RegistrationOptions TextDocumentCodeLens = CodeLensRegistrationOptions - RegistrationOptions TextDocumentDocumentLink = DocumentLinkRegistrationOptions - RegistrationOptions TextDocumentDocumentColor = DocumentColorRegistrationOptions - RegistrationOptions TextDocumentFormatting = DocumentFormattingRegistrationOptions - RegistrationOptions TextDocumentRangeFormatting = DocumentRangeFormattingRegistrationOptions - RegistrationOptions TextDocumentOnTypeFormatting = DocumentOnTypeFormattingRegistrationOptions - RegistrationOptions TextDocumentRename = RenameRegistrationOptions - RegistrationOptions TextDocumentFoldingRange = FoldingRangeRegistrationOptions - RegistrationOptions TextDocumentSelectionRange = SelectionRangeRegistrationOptions - RegistrationOptions TextDocumentPrepareCallHierarchy = CallHierarchyRegistrationOptions - RegistrationOptions TextDocumentSemanticTokens = SemanticTokensRegistrationOptions - RegistrationOptions m = Void - -data Registration (m :: Method FromClient t) = - 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 :: SClientMethod m - -- | Options necessary for the registration. - -- Make this strict to aid the pattern matching exhaustiveness checker - , _registerOptions :: !(Maybe (RegistrationOptions m)) - } - deriving Generic - -deriving instance Eq (RegistrationOptions m) => Eq (Registration m) -deriving instance Show (RegistrationOptions m) => Show (Registration m) - --- This generates the function --- regHelper :: SMethod m --- -> (( Show (RegistrationOptions m) --- , ToJSON (RegistrationOptions m) --- , FromJSON ($regOptTcon m) --- => x) --- -> x -makeRegHelper ''RegistrationOptions - -instance ToJSON (Registration m) where - toJSON x@(Registration _ m _) = regHelper m (genericToJSON lspOptions x) - -data SomeRegistration = forall t (m :: Method FromClient t). SomeRegistration (Registration m) - -instance ToJSON SomeRegistration where - toJSON (SomeRegistration r) = toJSON r - -instance FromJSON SomeRegistration where - parseJSON = withObject "Registration" $ \o -> do - SomeClientMethod m <- o .: "method" - r <- Registration <$> o .: "id" <*> pure m <*> regHelper m (o .:? "registerOptions") - pure (SomeRegistration r) - -instance Eq SomeRegistration where - (==) = (==) `on` toJSON - -instance Show SomeRegistration where - show (SomeRegistration r@(Registration _ m _)) = regHelper m (show r) - -data RegistrationParams = - RegistrationParams { _registrations :: List SomeRegistration } - deriving (Show, Eq) - -deriveJSON lspOptions ''RegistrationParams - - --- --------------------------------------------------------------------- - --- | General parameters to unregister a capability. -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 :: SomeClientMethod - } deriving (Show, Eq) - -deriveJSON lspOptions ''Unregistration - -data UnregistrationParams = - UnregistrationParams - { -- | This should correctly be named @unregistrations@. However changing this - -- is a breaking change and needs to wait until we deliver a 4.x version - -- of the specification. - _unregisterations :: List Unregistration - } deriving (Show, Eq) - -deriveJSON lspOptions ''UnregistrationParams diff --git a/lsp-types/src/Language/LSP/Types/Rename.hs b/lsp-types/src/Language/LSP/Types/Rename.hs deleted file mode 100644 index c7aa22391..000000000 --- a/lsp-types/src/Language/LSP/Types/Rename.hs +++ /dev/null @@ -1,85 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} - -module Language.LSP.Types.Rename where - -import Data.Aeson -import Data.Aeson.TH -import Data.Text (Text) -import Data.Scientific (Scientific) - -import Language.LSP.Types.Location -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Progress -import Language.LSP.Types.Utils - -data PrepareSupportDefaultBehavior = - PsIdentifier | - PsUnknown Scientific - deriving (Read, Show, Eq) - -instance ToJSON PrepareSupportDefaultBehavior where - toJSON PsIdentifier = Number 1 - toJSON (PsUnknown i) = Number i - -instance FromJSON PrepareSupportDefaultBehavior where - parseJSON (Number 1) = pure PsIdentifier - parseJSON _ = fail "PrepareSupportDefaultBehavior" - -data RenameClientCapabilities = - RenameClientCapabilities - { -- | Whether rename supports dynamic registration. - _dynamicRegistration :: Maybe Bool - -- | Client supports testing for validity of rename operations - -- before execution. - -- - -- Since LSP 3.12.0 - , _prepareSupport :: Maybe Bool - -- | Client supports the default behavior result - -- (`{ defaultBehavior: boolean }`). - -- - -- The value indicates the default behavior used by the client. - -- - -- @since 3.16.0 - , prepareSupportDefaultBehavior :: Maybe PrepareSupportDefaultBehavior - -- | Whether the client honors the change annotations in - -- text edits and resource operations returned via the - -- rename request's workspace edit by for example presenting - -- the workspace edit in the user interface and asking - -- for confirmation. - -- - -- @since 3.16.0 - , honorsChangeAnnotations :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''RenameClientCapabilities - -makeExtendingDatatype "RenameOptions" [''WorkDoneProgressOptions] - [("_prepareProvider", [t| Maybe Bool |])] -deriveJSON lspOptions ''RenameOptions - -makeExtendingDatatype "RenameRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''RenameOptions - ] [] -deriveJSON lspOptions ''RenameRegistrationOptions - -makeExtendingDatatype "RenameParams" - [ ''TextDocumentPositionParams - , ''WorkDoneProgressParams - ] - [("_newName", [t| Text |])] -deriveJSON lspOptions ''RenameParams - --- ----------------------------------------- - -makeExtendingDatatype "PrepareRenameParams" [''TextDocumentPositionParams] [] -deriveJSON lspOptions ''PrepareRenameParams - -data RangeWithPlaceholder = - RangeWithPlaceholder - { - _range :: Range - , _placeholder :: Text - } deriving Eq -deriveJSON lspOptions ''RangeWithPlaceholder diff --git a/lsp-types/src/Language/LSP/Types/SelectionRange.hs b/lsp-types/src/Language/LSP/Types/SelectionRange.hs deleted file mode 100644 index dd72fb313..000000000 --- a/lsp-types/src/Language/LSP/Types/SelectionRange.hs +++ /dev/null @@ -1,54 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} - -module Language.LSP.Types.SelectionRange where - -import Data.Aeson.TH -import Language.LSP.Types.Common -import Language.LSP.Types.Location -import Language.LSP.Types.Progress -import Language.LSP.Types.StaticRegistrationOptions -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils - -data SelectionRangeClientCapabilities = SelectionRangeClientCapabilities - { -- | Whether implementation supports dynamic registration for selection range providers. If this is set to 'True' - -- the client supports the new 'SelectionRangeRegistrationOptions' return value for the corresponding server - -- capability as well. - _dynamicRegistration :: Maybe Bool - } - deriving (Read, Show, Eq) - -deriveJSON lspOptions ''SelectionRangeClientCapabilities - -makeExtendingDatatype "SelectionRangeOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''SelectionRangeOptions - -makeExtendingDatatype - "SelectionRangeRegistrationOptions" - [ ''SelectionRangeOptions, - ''TextDocumentRegistrationOptions, - ''StaticRegistrationOptions - ] - [] -deriveJSON lspOptions ''SelectionRangeRegistrationOptions - -makeExtendingDatatype - "SelectionRangeParams" - [ ''WorkDoneProgressParams, - ''PartialResultParams - ] - [ ("_textDocument", [t|TextDocumentIdentifier|]), - ("_positions", [t|List Position|]) - ] -deriveJSON lspOptions ''SelectionRangeParams - -data SelectionRange = SelectionRange - { -- | The 'range' of this selection range. - _range :: Range, - -- | The parent selection range containing this range. Therefore @parent.range@ must contain @this.range@. - _parent :: Maybe SelectionRange - } - deriving (Read, Show, Eq) - -deriveJSON lspOptions ''SelectionRange diff --git a/lsp-types/src/Language/LSP/Types/SemanticTokens.hs b/lsp-types/src/Language/LSP/Types/SemanticTokens.hs deleted file mode 100644 index 4a6b76960..000000000 --- a/lsp-types/src/Language/LSP/Types/SemanticTokens.hs +++ /dev/null @@ -1,500 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -module Language.LSP.Types.SemanticTokens where - -import qualified Data.Aeson as A -import Data.Aeson.TH -import Data.Text (Text) - -import Control.Monad.Except - -import Language.LSP.Types.Common -import Language.LSP.Types.Location -import Language.LSP.Types.Progress -import Language.LSP.Types.StaticRegistrationOptions -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils - -import qualified Data.Algorithm.Diff as Diff -import qualified Data.Bits as Bits -import qualified Data.DList as DList -import Data.Default -import Data.Foldable hiding (length) -import qualified Data.Map as Map -import Data.Maybe (fromMaybe, - maybeToList) -import Data.String - -data SemanticTokenTypes = - SttNamespace - | SttType - | SttClass - | SttEnum - | SttInterface - | SttStruct - | SttTypeParameter - | SttParameter - | SttVariable - | SttProperty - | SttEnumMember - | SttEvent - | SttFunction - | SttMethod - | SttMacro - | SttKeyword - | SttModifier - | SttComment - | SttString - | SttNumber - | SttRegexp - | SttOperator - | SttUnknown Text - deriving (Show, Read, Eq, Ord) - -instance A.ToJSON SemanticTokenTypes where - toJSON SttNamespace = A.String "namespace" - toJSON SttType = A.String "type" - toJSON SttClass = A.String "class" - toJSON SttEnum = A.String "enum" - toJSON SttInterface = A.String "interface" - toJSON SttStruct = A.String "struct" - toJSON SttTypeParameter = A.String "typeParameter" - toJSON SttParameter = A.String "parameter" - toJSON SttVariable = A.String "variable" - toJSON SttProperty = A.String "property" - toJSON SttEnumMember = A.String "enumMember" - toJSON SttEvent = A.String "event" - toJSON SttFunction = A.String "function" - toJSON SttMethod = A.String "method" - toJSON SttMacro = A.String "macro" - toJSON SttKeyword = A.String "keyword" - toJSON SttModifier = A.String "modifier" - toJSON SttComment = A.String "comment" - toJSON SttString = A.String "string" - toJSON SttNumber = A.String "number" - toJSON SttRegexp = A.String "regexp" - toJSON SttOperator = A.String "operator" - toJSON (SttUnknown t) = A.String t - -instance A.FromJSON SemanticTokenTypes where - parseJSON (A.String "namespace") = pure SttNamespace - parseJSON (A.String "type") = pure SttType - parseJSON (A.String "class") = pure SttClass - parseJSON (A.String "enum") = pure SttEnum - parseJSON (A.String "interface") = pure SttInterface - parseJSON (A.String "struct") = pure SttStruct - parseJSON (A.String "typeParameter") = pure SttTypeParameter - parseJSON (A.String "parameter") = pure SttParameter - parseJSON (A.String "variable") = pure SttVariable - parseJSON (A.String "property") = pure SttProperty - parseJSON (A.String "enumMember") = pure SttEnumMember - parseJSON (A.String "event") = pure SttEvent - parseJSON (A.String "function") = pure SttFunction - parseJSON (A.String "method") = pure SttMethod - parseJSON (A.String "macro") = pure SttMacro - parseJSON (A.String "keyword") = pure SttKeyword - parseJSON (A.String "modifier") = pure SttModifier - parseJSON (A.String "comment") = pure SttComment - parseJSON (A.String "string") = pure SttString - parseJSON (A.String "number") = pure SttNumber - parseJSON (A.String "regexp") = pure SttRegexp - parseJSON (A.String "operator") = pure SttOperator - parseJSON (A.String t) = pure $ SttUnknown t - parseJSON _ = mempty - --- | The set of semantic token types which are "known" (i.e. listed in the LSP spec). -knownSemanticTokenTypes :: [SemanticTokenTypes] -knownSemanticTokenTypes = [ - SttNamespace - , SttType - , SttClass - , SttEnum - , SttInterface - , SttStruct - , SttTypeParameter - , SttParameter - , SttVariable - , SttProperty - , SttEnumMember - , SttEvent - , SttFunction - , SttMethod - , SttMacro - , SttKeyword - , SttModifier - , SttComment - , SttString - , SttNumber - , SttRegexp - , SttOperator - ] - -data SemanticTokenModifiers = - StmDeclaration - | StmDefinition - | StmReadonly - | StmStatic - | StmDeprecated - | StmAbstract - | StmAsync - | StmModification - | StmDocumentation - | StmDefaultLibrary - | StmUnknown Text - deriving (Show, Read, Eq, Ord) - -instance A.ToJSON SemanticTokenModifiers where - toJSON StmDeclaration = A.String "declaration" - toJSON StmDefinition = A.String "definition" - toJSON StmReadonly = A.String "readonly" - toJSON StmStatic = A.String "static" - toJSON StmDeprecated = A.String "deprecated" - toJSON StmAbstract = A.String "abstract" - toJSON StmAsync = A.String "async" - toJSON StmModification = A.String "modification" - toJSON StmDocumentation = A.String "documentation" - toJSON StmDefaultLibrary = A.String "defaultLibrary" - toJSON (StmUnknown t) = A.String t - -instance A.FromJSON SemanticTokenModifiers where - parseJSON (A.String "declaration") = pure StmDeclaration - parseJSON (A.String "definition") = pure StmDefinition - parseJSON (A.String "readonly") = pure StmReadonly - parseJSON (A.String "static") = pure StmStatic - parseJSON (A.String "deprecated") = pure StmDeprecated - parseJSON (A.String "abstract") = pure StmAbstract - parseJSON (A.String "async") = pure StmAsync - parseJSON (A.String "modification") = pure StmModification - parseJSON (A.String "documentation") = pure StmDocumentation - parseJSON (A.String "defaultLibrary") = pure StmDefaultLibrary - parseJSON (A.String t) = pure $ StmUnknown t - parseJSON _ = mempty - --- | The set of semantic token modifiers which are "known" (i.e. listed in the LSP spec). -knownSemanticTokenModifiers :: [SemanticTokenModifiers] -knownSemanticTokenModifiers = [ - StmDeclaration - , StmDefinition - , StmReadonly - , StmStatic - , StmDeprecated - , StmAbstract - , StmAsync - , StmModification - , StmDocumentation - , StmDefaultLibrary - ] - -data TokenFormat = TokenFormatRelative - deriving (Show, Read, Eq) - -instance A.ToJSON TokenFormat where - toJSON TokenFormatRelative = A.String "relative" - -instance A.FromJSON TokenFormat where - parseJSON (A.String "relative") = pure TokenFormatRelative - parseJSON _ = mempty - -data SemanticTokensLegend = SemanticTokensLegend { - -- | The token types a server uses. - _tokenTypes :: List SemanticTokenTypes, - -- | The token modifiers a server uses. - _tokenModifiers :: List SemanticTokenModifiers -} deriving (Show, Read, Eq) -deriveJSON lspOptions ''SemanticTokensLegend - --- We give a default legend which just lists the "known" types and modifiers in the order they're listed. -instance Default SemanticTokensLegend where - def = SemanticTokensLegend (List knownSemanticTokenTypes) (List knownSemanticTokenModifiers) - -data SemanticTokensRangeClientCapabilities = SemanticTokensRangeBool Bool | SemanticTokensRangeObj A.Value - deriving (Show, Read, Eq) -deriveJSON lspOptionsUntagged ''SemanticTokensRangeClientCapabilities - -data SemanticTokensDeltaClientCapabilities = SemanticTokensDeltaClientCapabilities { - -- | The client will send the `textDocument/semanticTokens/full/delta` - -- request if the server provides a corresponding handler. - _delta :: Maybe Bool -} deriving (Show, Read, Eq) -deriveJSON lspOptions ''SemanticTokensDeltaClientCapabilities - -data SemanticTokensFullClientCapabilities = SemanticTokensFullBool Bool | SemanticTokensFullDelta SemanticTokensDeltaClientCapabilities - deriving (Show, Read, Eq) -deriveJSON lspOptionsUntagged ''SemanticTokensFullClientCapabilities - -data SemanticTokensRequestsClientCapabilities = SemanticTokensRequestsClientCapabilities { - -- | The client will send the `textDocument/semanticTokens/range` request - -- if the server provides a corresponding handler. - _range :: Maybe SemanticTokensRangeClientCapabilities, - -- | The client will send the `textDocument/semanticTokens/full` request - -- if the server provides a corresponding handler. - _full :: Maybe SemanticTokensFullClientCapabilities -} deriving (Show, Read, Eq) -deriveJSON lspOptions ''SemanticTokensRequestsClientCapabilities - -data SemanticTokensClientCapabilities = SemanticTokensClientCapabilities { - -- | Whether implementation supports dynamic registration. If this is set to - -- `true` the client supports the new `(TextDocumentRegistrationOptions & - -- StaticRegistrationOptions)` return value for the corresponding server - -- capability as well. - _dynamicRegistration :: Maybe Bool, - - -- | Which requests the client supports and might send to the server - -- depending on the server's capability. Please note that clients might not - -- show semantic tokens or degrade some of the user experience if a range - -- or full request is advertised by the client but not provided by the - -- server. If for example the client capability `requests.full` and - -- `request.range` are both set to true but the server only provides a - -- range provider the client might not render a minimap correctly or might - -- even decide to not show any semantic tokens at all. - _requests :: SemanticTokensRequestsClientCapabilities, - - -- | The token types that the client supports. - _tokenTypes :: List SemanticTokenTypes, - - -- | The token modifiers that the client supports. - _tokenModifiers :: List SemanticTokenModifiers, - - -- | The formats the clients supports. - _formats :: List TokenFormat, - - -- | Whether the client supports tokens that can overlap each other. - _overlappingTokenSupport :: Maybe Bool, - - -- | Whether the client supports tokens that can span multiple lines. - _multilineTokenSupport :: Maybe Bool -} deriving (Show, Read, Eq) -deriveJSON lspOptions ''SemanticTokensClientCapabilities - -makeExtendingDatatype "SemanticTokensOptions" [''WorkDoneProgressOptions] - [ ("_legend", [t| SemanticTokensLegend |]) - , ("_range", [t| Maybe SemanticTokensRangeClientCapabilities |]) - , ("_full", [t| Maybe SemanticTokensFullClientCapabilities |]) - ] -deriveJSON lspOptions ''SemanticTokensOptions - -makeExtendingDatatype "SemanticTokensRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''SemanticTokensOptions - , ''StaticRegistrationOptions] [] -deriveJSON lspOptions ''SemanticTokensRegistrationOptions - -makeExtendingDatatype "SemanticTokensParams" - [''WorkDoneProgressParams - , ''PartialResultParams] - [ ("_textDocument", [t| TextDocumentIdentifier |]) ] -deriveJSON lspOptions ''SemanticTokensParams - -data SemanticTokens = SemanticTokens { - -- | An optional result id. If provided and clients support delta updating - -- the client will include the result id in the next semantic token request. - -- A server can then instead of computing all semantic tokens again simply - -- send a delta. - _resultId :: Maybe Text, - - -- | The actual tokens. - _xdata :: List UInt -} deriving (Show, Read, Eq) -deriveJSON lspOptions ''SemanticTokens - -data SemanticTokensPartialResult = SemanticTokensPartialResult { - _xdata :: List UInt -} -deriveJSON lspOptions ''SemanticTokensPartialResult - -makeExtendingDatatype "SemanticTokensDeltaParams" - [''WorkDoneProgressParams - , ''PartialResultParams] - [ ("_textDocument", [t| TextDocumentIdentifier |]) - , ("_previousResultId", [t| Text |]) - ] -deriveJSON lspOptions ''SemanticTokensDeltaParams - -data SemanticTokensEdit = SemanticTokensEdit { - -- | The start offset of the edit. - _start :: UInt, - -- | The count of elements to remove. - _deleteCount :: UInt, - -- | The elements to insert. - _xdata :: Maybe (List UInt) -} deriving (Show, Read, Eq) -deriveJSON lspOptions ''SemanticTokensEdit - -data SemanticTokensDelta = SemanticTokensDelta { - _resultId :: Maybe Text, - -- | The semantic token edits to transform a previous result into a new - -- result. - _edits :: List SemanticTokensEdit -} deriving (Show, Read, Eq) -deriveJSON lspOptions ''SemanticTokensDelta - -data SemanticTokensDeltaPartialResult = SemantictokensDeltaPartialResult { - _edits :: List SemanticTokensEdit -} deriving (Show, Read, Eq) -deriveJSON lspOptions ''SemanticTokensDeltaPartialResult - -makeExtendingDatatype "SemanticTokensRangeParams" - [''WorkDoneProgressParams - , ''PartialResultParams] - [ ("_textDocument", [t| TextDocumentIdentifier |]) - , ("_range", [t| Range |]) - ] -deriveJSON lspOptions ''SemanticTokensRangeParams - -data SemanticTokensWorkspaceClientCapabilities = SemanticTokensWorkspaceClientCapabilities { - -- | Whether the client implementation supports a refresh request sent from - -- the server to the client. - -- - -- Note that this event is global and will force the client to refresh all - -- semantic tokens currently shown. It should be used with absolute care - -- and is useful for situation where a server for example detect a project - -- wide change that requires such a calculation. - _refreshSupport :: Maybe Bool -} deriving (Show, Read, Eq) -deriveJSON lspOptions ''SemanticTokensWorkspaceClientCapabilities - ----------------------------------------------------------- --- Tools for working with semantic tokens. ----------------------------------------------------------- - --- | A single 'semantic token' as described in the LSP specification, using absolute positions. --- This is the kind of token that is usually easiest for editors to produce. -data SemanticTokenAbsolute = SemanticTokenAbsolute { - line :: UInt, - startChar :: UInt, - length :: UInt, - tokenType :: SemanticTokenTypes, - tokenModifiers :: [SemanticTokenModifiers] -} deriving (Show, Read, Eq, Ord) --- Note: we want the Ord instance to sort the tokens textually: this is achieved due to the --- order of the constructors - --- | A single 'semantic token' as described in the LSP specification, using relative positions. -data SemanticTokenRelative = SemanticTokenRelative { - deltaLine :: UInt, - deltaStartChar :: UInt, - length :: UInt, - tokenType :: SemanticTokenTypes, - tokenModifiers :: [SemanticTokenModifiers] -} deriving (Show, Read, Eq, Ord) --- Note: we want the Ord instance to sort the tokens textually: this is achieved due to the --- order of the constructors - --- | Turn a list of absolutely-positioned tokens into a list of relatively-positioned tokens. The tokens are assumed to be in the --- order that they appear in the document! -relativizeTokens :: [SemanticTokenAbsolute] -> [SemanticTokenRelative] -relativizeTokens xs = DList.toList $ go 0 0 xs mempty - where - -- Pass an accumulator to make this tail-recursive - go :: UInt -> UInt -> [SemanticTokenAbsolute] -> DList.DList SemanticTokenRelative -> DList.DList SemanticTokenRelative - go _ _ [] acc = acc - go lastLine lastChar (SemanticTokenAbsolute l c len ty mods:ts) acc = - let - lastCharInLine = if l == lastLine then lastChar else 0 - dl = l - lastLine - dc = c - lastCharInLine - in go l c ts (DList.snoc acc (SemanticTokenRelative dl dc len ty mods)) - --- | Turn a list of relatively-positioned tokens into a list of absolutely-positioned tokens. The tokens are assumed to be in the --- order that they appear in the document! -absolutizeTokens :: [SemanticTokenRelative] -> [SemanticTokenAbsolute] -absolutizeTokens xs = DList.toList $ go 0 0 xs mempty - where - -- Pass an accumulator to make this tail-recursive - go :: UInt -> UInt -> [SemanticTokenRelative] -> DList.DList SemanticTokenAbsolute -> DList.DList SemanticTokenAbsolute - go _ _ [] acc = acc - go lastLine lastChar (SemanticTokenRelative dl dc len ty mods:ts) acc = - let - lastCharInLine = if dl == 0 then lastChar else 0 - l = lastLine + dl - c = lastCharInLine + dc - in go l c ts (DList.snoc acc (SemanticTokenAbsolute l c len ty mods)) - --- | Encode a series of relatively-positioned semantic tokens into an integer array following the given legend. -encodeTokens :: SemanticTokensLegend -> [SemanticTokenRelative] -> Either Text [UInt] -encodeTokens SemanticTokensLegend{_tokenTypes=List tts,_tokenModifiers=List tms} sts = - DList.toList . DList.concat <$> traverse encodeToken sts - where - -- Note that there's no "fast" version of these (e.g. backed by an IntMap or similar) - -- in general, due to the possibility of unknown token types which are only identified by strings. - tyMap :: Map.Map SemanticTokenTypes UInt - tyMap = Map.fromList $ zip tts [0..] - modMap :: Map.Map SemanticTokenModifiers Int - modMap = Map.fromList $ zip tms [0..] - - lookupTy :: SemanticTokenTypes -> Either Text UInt - lookupTy ty = case Map.lookup ty tyMap of - Just tycode -> pure tycode - Nothing -> throwError $ "Semantic token type " <> fromString (show ty) <> " did not appear in the legend" - lookupMod :: SemanticTokenModifiers -> Either Text Int - lookupMod modifier = case Map.lookup modifier modMap of - Just modcode -> pure modcode - Nothing -> throwError $ "Semantic token modifier " <> fromString (show modifier) <> " did not appear in the legend" - - -- Use a DList here for better efficiency when concatenating all these together - encodeToken :: SemanticTokenRelative -> Either Text (DList.DList UInt) - encodeToken (SemanticTokenRelative dl dc len ty mods) = do - tycode <- lookupTy ty - modcodes <- traverse lookupMod mods - let combinedModcode :: Int = foldl' Bits.setBit Bits.zeroBits modcodes - - pure [dl, dc, len, tycode, fromIntegral combinedModcode ] - --- This is basically 'SemanticTokensEdit', but slightly easier to work with. --- | An edit to a buffer of items. -data Edit a = Edit { editStart :: UInt, editDeleteCount :: UInt, editInsertions :: [a] } - deriving (Read, Show, Eq, Ord) - --- | Compute a list of edits that will turn the first list into the second list. -computeEdits :: Eq a => [a] -> [a] -> [Edit a] -computeEdits l r = DList.toList $ go 0 Nothing (Diff.getGroupedDiff l r) mempty - where - {- - Strategy: traverse the list of diffs, keeping the current index and (maybe) an in-progress 'Edit'. - Whenever we see a 'Diff' that's only one side or the other, we can bundle that in to our in-progress - 'Edit'. We only have to stop if we see a 'Diff' that's on both sides (i.e. unchanged), then we - dump the 'Edit' into the accumulator. - We need the index, because 'Edit's need to say where they start. - -} - go :: UInt -> Maybe (Edit a) -> [Diff.Diff [a]] -> DList.DList (Edit a) -> DList.DList (Edit a) - -- No more diffs: append the current edit if there is one and return - go _ e [] acc = acc <> DList.fromList (maybeToList e) - - -- Items only on the left (i.e. deletions): increment the current index, and record the count of deletions, - -- starting a new edit if necessary. - go ix e (Diff.First ds : rest) acc = - let - deleteCount = fromIntegral $ Prelude.length ds - edit = fromMaybe (Edit ix 0 []) e - in go (ix + deleteCount) (Just (edit{editDeleteCount=editDeleteCount edit + deleteCount})) rest acc - -- Items only on the right (i.e. insertions): don't increment the current index, and record the insertions, - -- starting a new edit if necessary. - go ix e (Diff.Second as : rest) acc = - let edit = fromMaybe (Edit ix 0 []) e - in go ix (Just (edit{editInsertions=editInsertions edit <> as})) rest acc - - -- Items on both sides: increment the current index appropriately (since the items appear on the left), - -- and append the current edit (if there is one) to our list of edits (since we can't continue it with a break). - go ix e (Diff.Both bs _bs : rest) acc = - let bothCount = fromIntegral $ Prelude.length bs - in go (ix + bothCount) Nothing rest (acc <> DList.fromList (maybeToList e)) - --- | Convenience method for making a 'SemanticTokens' from a list of 'SemanticTokenAbsolute's. An error may be returned if - --- The resulting 'SemanticTokens' lacks a result ID, which must be set separately if you are using that. -makeSemanticTokens :: SemanticTokensLegend -> [SemanticTokenAbsolute] -> Either Text SemanticTokens -makeSemanticTokens legend sts = do - encoded <- encodeTokens legend $ relativizeTokens sts - pure $ SemanticTokens Nothing (List encoded) - --- | Convenience function for making a 'SemanticTokensDelta' from a previous and current 'SemanticTokens'. --- The resulting 'SemanticTokensDelta' lacks a result ID, which must be set separately if you are using that. -makeSemanticTokensDelta :: SemanticTokens -> SemanticTokens -> SemanticTokensDelta -makeSemanticTokensDelta SemanticTokens{_xdata=List prevTokens} SemanticTokens{_xdata=List curTokens} = - let edits = computeEdits prevTokens curTokens - stEdits = fmap (\(Edit s ds as) -> SemanticTokensEdit s ds (Just $ List as)) edits - in SemanticTokensDelta Nothing (List stEdits) - diff --git a/lsp-types/src/Language/LSP/Types/ServerCapabilities.hs b/lsp-types/src/Language/LSP/Types/ServerCapabilities.hs deleted file mode 100644 index 70fb50233..000000000 --- a/lsp-types/src/Language/LSP/Types/ServerCapabilities.hs +++ /dev/null @@ -1,137 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE DuplicateRecordFields #-} - -module Language.LSP.Types.ServerCapabilities where - -import Data.Aeson -import Data.Aeson.TH -import Data.Text (Text) -import Language.LSP.Types.CallHierarchy -import Language.LSP.Types.CodeAction -import Language.LSP.Types.CodeLens -import Language.LSP.Types.Command -import Language.LSP.Types.Common -import Language.LSP.Types.Completion -import Language.LSP.Types.Declaration -import Language.LSP.Types.Definition -import Language.LSP.Types.DocumentColor -import Language.LSP.Types.DocumentHighlight -import Language.LSP.Types.DocumentLink -import Language.LSP.Types.DocumentSymbol -import Language.LSP.Types.FoldingRange -import Language.LSP.Types.Formatting -import Language.LSP.Types.Hover -import Language.LSP.Types.Implementation -import Language.LSP.Types.References -import Language.LSP.Types.Rename -import Language.LSP.Types.SelectionRange -import Language.LSP.Types.SemanticTokens -import Language.LSP.Types.SignatureHelp -import Language.LSP.Types.TextDocument -import Language.LSP.Types.TypeDefinition -import Language.LSP.Types.Utils -import Language.LSP.Types.WorkspaceSymbol - --- --------------------------------------------------------------------- - -data WorkspaceFoldersServerCapabilities = - WorkspaceFoldersServerCapabilities - { -- | The server has support for workspace folders - _supported :: Maybe Bool - -- | Whether the server wants to receive workspace folder - -- change notifications. - -- If a strings is provided the string is treated as a ID - -- under which the notification is registered on the client - -- side. The ID can be used to unregister for these events - -- using the `client/unregisterCapability` request. - , _changeNotifications :: Maybe (Text |? Bool) - } - deriving (Show, Read, Eq) - -deriveJSON lspOptions ''WorkspaceFoldersServerCapabilities - -data WorkspaceServerCapabilities = - WorkspaceServerCapabilities - { -- | The server supports workspace folder. Since LSP 3.6 - -- - -- @since 0.7.0.0 - _workspaceFolders :: Maybe WorkspaceFoldersServerCapabilities - } - deriving (Show, Read, Eq) -deriveJSON lspOptions ''WorkspaceServerCapabilities - -data ServerCapabilities = - ServerCapabilities - { -- | Defines how text documents are synced. Is either a detailed structure - -- defining each notification or for backwards compatibility the - -- 'TextDocumentSyncKind' number. - -- If omitted it defaults to 'TdSyncNone'. - _textDocumentSync :: Maybe (TextDocumentSyncOptions |? TextDocumentSyncKind) - -- | The server provides hover support. - , _hoverProvider :: Maybe (Bool |? HoverOptions) - -- | The server provides completion support. - , _completionProvider :: Maybe CompletionOptions - -- | The server provides signature help support. - , _signatureHelpProvider :: Maybe SignatureHelpOptions - -- | The server provides go to declaration support. - -- - -- Since LSP 3.14.0 - , _declarationProvider :: Maybe (Bool |? DeclarationOptions |? DeclarationRegistrationOptions) - -- | The server provides goto definition support. - , _definitionProvider :: Maybe (Bool |? DefinitionOptions) - -- | The server provides Goto Type Definition support. Since LSP 3.6 - -- - -- @since 0.7.0.0 - , _typeDefinitionProvider :: Maybe (Bool |? TypeDefinitionOptions |? TypeDefinitionRegistrationOptions) - -- | The server provides Goto Implementation support. Since LSP 3.6 - -- - -- @since 0.7.0.0 - , _implementationProvider :: Maybe (Bool |? ImplementationOptions |? ImplementationRegistrationOptions) - -- | The server provides find references support. - , _referencesProvider :: Maybe (Bool |? ReferenceOptions) - -- | The server provides document highlight support. - , _documentHighlightProvider :: Maybe (Bool |? DocumentHighlightOptions) - -- | The server provides document symbol support. - , _documentSymbolProvider :: Maybe (Bool |? DocumentSymbolOptions) - -- | The server provides code actions. - , _codeActionProvider :: Maybe (Bool |? CodeActionOptions) - -- | The server provides code lens. - , _codeLensProvider :: Maybe CodeLensOptions - -- | The server provides document link support. - , _documentLinkProvider :: Maybe DocumentLinkOptions - -- | The server provides color provider support. Since LSP 3.6 - -- - -- @since 0.7.0.0 - , _colorProvider :: Maybe (Bool |? DocumentColorOptions |? DocumentColorRegistrationOptions) - -- | The server provides document formatting. - , _documentFormattingProvider :: Maybe (Bool |? DocumentFormattingOptions) - -- | The server provides document range formatting. - , _documentRangeFormattingProvider :: Maybe (Bool |? DocumentRangeFormattingOptions) - -- | The server provides document formatting on typing. - , _documentOnTypeFormattingProvider :: Maybe DocumentOnTypeFormattingOptions - -- | The server provides rename support. - , _renameProvider :: Maybe (Bool |? RenameOptions) - -- | The server provides folding provider support. Since LSP 3.10 - -- - -- @since 0.7.0.0 - , _foldingRangeProvider :: Maybe (Bool |? FoldingRangeOptions |? FoldingRangeRegistrationOptions) - -- | The server provides execute command support. - , _executeCommandProvider :: Maybe ExecuteCommandOptions - -- | The server provides selection range support. Since LSP 3.15 - , _selectionRangeProvider :: Maybe (Bool |? SelectionRangeOptions |? SelectionRangeRegistrationOptions) - -- | The server provides call hierarchy support. - , _callHierarchyProvider :: Maybe (Bool |? CallHierarchyOptions |? CallHierarchyRegistrationOptions) - -- | The server provides semantic tokens support. - -- - -- @since 3.16.0 - , _semanticTokensProvider :: Maybe (SemanticTokensOptions |? SemanticTokensRegistrationOptions) - -- | The server provides workspace symbol support. - , _workspaceSymbolProvider :: Maybe (Bool |? WorkspaceSymbolOptions) - -- | Workspace specific server capabilities - , _workspace :: Maybe WorkspaceServerCapabilities - -- | Experimental server capabilities. - , _experimental :: Maybe Value - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''ServerCapabilities diff --git a/lsp-types/src/Language/LSP/Types/SignatureHelp.hs b/lsp-types/src/Language/LSP/Types/SignatureHelp.hs deleted file mode 100644 index 4d7955957..000000000 --- a/lsp-types/src/Language/LSP/Types/SignatureHelp.hs +++ /dev/null @@ -1,207 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} --- | Signature Help Request --- https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#signature-help-request -module Language.LSP.Types.SignatureHelp where - -import Data.Aeson -import Data.Aeson.TH -import Data.Text (Text) -import Language.LSP.Types.Common -import Language.LSP.Types.MarkupContent -import Language.LSP.Types.Progress -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils -import Control.Applicative (Alternative((<|>))) - --- ------------------------------------- - -data SignatureHelpParameterInformation = - SignatureHelpParameterInformation - { -- | The client supports processing label offsets instead of a simple - -- label string. - -- - -- @since 3.14.0 - _labelOffsetSupport :: Maybe Bool - } - deriving (Read, Show, Eq) -deriveJSON lspOptions ''SignatureHelpParameterInformation - -data SignatureHelpSignatureInformation = - SignatureHelpSignatureInformation - { -- | Client supports the follow content formats for the documentation - -- property. The order describes the preferred format of the client. - _documentationFormat :: Maybe (List MarkupKind) - -- | Client capabilities specific to parameter information. - , _parameterInformation :: Maybe SignatureHelpParameterInformation - -- | The client supports the `activeParameter` property on - -- 'SignatureInformation' literal. - -- - -- @since 3.16.0 - , _activeParameterSuport :: Maybe Bool - } - deriving (Show, Read, Eq) - -deriveJSON lspOptions ''SignatureHelpSignatureInformation - -data SignatureHelpClientCapabilities = - SignatureHelpClientCapabilities - { -- | Whether signature help supports dynamic registration. - _dynamicRegistration :: Maybe Bool - -- | The client supports the following 'SignatureInformation' - -- specific properties. - , _signatureInformation :: Maybe SignatureHelpSignatureInformation - -- | The client supports to send additional context information for a - -- @textDocument/signatureHelp@ request. A client that opts into - -- contextSupport will also support the '_retriggerCharacters' on - -- 'SignatureHelpOptions'. - -- - -- @since 3.15.0 - , _contextSupport :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''SignatureHelpClientCapabilities - --- ------------------------------------- - -makeExtendingDatatype "SignatureHelpOptions" [''WorkDoneProgressOptions] - [ ("_triggerCharacters", [t| Maybe (List Text) |]) - , ("_retriggerCharacters", [t| Maybe (List Text) |]) - ] -deriveJSON lspOptions ''SignatureHelpOptions - -makeExtendingDatatype "SignatureHelpRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''SignatureHelpOptions - ] [] -deriveJSON lspOptions ''SignatureHelpRegistrationOptions - --- ------------------------------------- - -data SignatureHelpDoc = SignatureHelpDocString Text | SignatureHelpDocMarkup MarkupContent - deriving (Read,Show,Eq) - -deriveJSON lspOptionsUntagged ''SignatureHelpDoc - --- ------------------------------------- - -data ParameterLabel = ParameterLabelString Text | ParameterLabelOffset UInt UInt - deriving (Read,Show,Eq) - -instance ToJSON ParameterLabel where - toJSON (ParameterLabelString t) = toJSON t - toJSON (ParameterLabelOffset l h) = toJSON [l, h] - -instance FromJSON ParameterLabel where - parseJSON x = ParameterLabelString <$> parseJSON x <|> parseInterval x - where - parseInterval v@(Array _) = do - is <- parseJSON v - case is of - [l, h] -> pure $ ParameterLabelOffset l h - _ -> fail "ParameterLabel" - parseInterval _ = fail "ParameterLabel" - --- ------------------------------------- - -{-| -Represents a parameter of a callable-signature. A parameter can -have a label and a doc-comment. --} -data ParameterInformation = - ParameterInformation - { _label :: ParameterLabel -- ^ The label of this parameter information. - , _documentation :: Maybe SignatureHelpDoc -- ^ The human-readable doc-comment of this parameter. - } deriving (Read,Show,Eq) -deriveJSON lspOptions ''ParameterInformation - --- ------------------------------------- - -{-| -Represents the signature of something callable. A signature -can have a label, like a function-name, a doc-comment, and -a set of parameters. --} -data SignatureInformation = - SignatureInformation - { _label :: Text -- ^ The label of the signature. - , _documentation :: Maybe SignatureHelpDoc -- ^ The human-readable doc-comment of this signature. - , _parameters :: Maybe (List ParameterInformation) -- ^ The parameters of this signature. - , _activeParameter :: Maybe UInt -- ^ The index of the active parameter. - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''SignatureInformation - - -{-| -Signature help represents the signature of something -callable. There can be multiple signature but only one -active and only one active parameter. --} -data SignatureHelp = - SignatureHelp - { _signatures :: List SignatureInformation -- ^ One or more signatures. - , _activeSignature :: Maybe UInt -- ^ The active signature. - , _activeParameter :: Maybe UInt -- ^ The active parameter of the active signature. - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''SignatureHelp - --- ------------------------------------- - --- | How a signature help was triggered. --- --- @since 3.15.0 -data SignatureHelpTriggerKind = SHTKInvoked -- ^ Signature help was invoked manually by the user or by a command. - | SHTKTriggerCharacter -- ^ Signature help was triggered by a trigger character. - | SHTKContentChange -- ^ Signature help was triggered by the cursor moving or by the document content changing. - deriving (Read,Show,Eq) - -instance ToJSON SignatureHelpTriggerKind where - toJSON SHTKInvoked = Number 1 - toJSON SHTKTriggerCharacter = Number 2 - toJSON SHTKContentChange = Number 3 - -instance FromJSON SignatureHelpTriggerKind where - parseJSON (Number 1) = pure SHTKInvoked - parseJSON (Number 2) = pure SHTKTriggerCharacter - parseJSON (Number 3) = pure SHTKContentChange - parseJSON _ = fail "SignatureHelpTriggerKind" - --- | Additional information about the context in which a signature help request --- was triggered. --- --- @since 3.15.0 -data SignatureHelpContext = - SignatureHelpContext - { -- | Action that caused signature help to be triggered. - _triggerKind :: SignatureHelpTriggerKind - -- | Character that caused signature help to be triggered. This is - -- undefined when @triggerKind !== - -- SignatureHelpTriggerKind.TriggerCharacter@ - , _triggerCharacter :: Maybe Text - -- | 'True' if signature help was already showing when it was triggered. - -- - -- Retriggers occur when the signature help is already active and can be - -- caused by actions such as typing a trigger character, a cursor move, or - -- document content changes. - , _isRetrigger :: Bool - -- | The currently active 'SignatureHelp'. - -- - -- The '_activeSignatureHelp' has its @SignatureHelp.activeSignature@ - -- field updated based on the user navigating through available - -- signatures. - , _activeSignatureHelp :: Maybe SignatureHelp - } - deriving (Read,Show,Eq) -deriveJSON lspOptions ''SignatureHelpContext - -makeExtendingDatatype "SignatureHelpParams" - [ ''TextDocumentPositionParams - , ''WorkDoneProgressParams - ] - [ ("_context", [t| Maybe SignatureHelpContext |]) - ] -deriveJSON lspOptions ''SignatureHelpParams - - diff --git a/lsp-types/src/Language/LSP/Types/StaticRegistrationOptions.hs b/lsp-types/src/Language/LSP/Types/StaticRegistrationOptions.hs deleted file mode 100644 index e32bd6e3a..000000000 --- a/lsp-types/src/Language/LSP/Types/StaticRegistrationOptions.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} --- Cyclic dependencies mean we have to put poor StaticRegistrationOptions on its own -module Language.LSP.Types.StaticRegistrationOptions where - -import Data.Aeson.TH -import Data.Text (Text) -import Language.LSP.Types.Utils - -data StaticRegistrationOptions = - StaticRegistrationOptions - { _id :: Maybe Text - } deriving (Read,Show,Eq) -deriveJSON lspOptions ''StaticRegistrationOptions diff --git a/lsp-types/src/Language/LSP/Types/TextDocument.hs b/lsp-types/src/Language/LSP/Types/TextDocument.hs deleted file mode 100644 index 69bbe0470..000000000 --- a/lsp-types/src/Language/LSP/Types/TextDocument.hs +++ /dev/null @@ -1,264 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeOperators #-} -module Language.LSP.Types.TextDocument where - -import Data.Aeson -import Data.Aeson.TH -import Data.Default -import Data.Text ( Text ) - -import Language.LSP.Types.Common -import Language.LSP.Types.DocumentFilter -import Language.LSP.Types.Location -import Language.LSP.Types.Uri -import Language.LSP.Types.Utils - --- --------------------------------------------------------------------- - -data TextDocumentIdentifier = - TextDocumentIdentifier - { _uri :: Uri - } deriving (Show, Read, Eq) -deriveJSON lspOptions ''TextDocumentIdentifier - -type TextDocumentVersion = Maybe Int32 - -makeExtendingDatatype "VersionedTextDocumentIdentifier" [''TextDocumentIdentifier] - [ ("_version", [t| TextDocumentVersion |])] -deriveJSON lspOptions ''VersionedTextDocumentIdentifier - -data TextDocumentItem = - TextDocumentItem { - _uri :: Uri - , _languageId :: Text - , _version :: Int32 - , _text :: Text - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''TextDocumentItem - --- --------------------------------------------------------------------- - -data TextDocumentPositionParams = - TextDocumentPositionParams - { -- | The text document. - _textDocument :: TextDocumentIdentifier - , -- | The position inside the text document. - _position :: Position - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''TextDocumentPositionParams - --- ------------------------------------- - --- Text document synchronisation - - -data TextDocumentSyncClientCapabilities = - TextDocumentSyncClientCapabilities - { -- | 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 ''TextDocumentSyncClientCapabilities - -instance Default TextDocumentSyncClientCapabilities where - def = TextDocumentSyncClientCapabilities def def def def - --- ------------------------------------- - -data SaveOptions = - SaveOptions - { -- | The client is supposed to include the content on save. - _includeText :: Maybe Bool - } deriving (Show, Read, Eq) -deriveJSON lspOptions ''SaveOptions - --- ------------------------------------- - --- | Defines how the host (editor) should sync document changes to the language server. -data TextDocumentSyncKind - = -- | Documents should not be synced at all. - TdSyncNone - | -- | Documents are synced by always sending the full content of the document. - TdSyncFull - | -- | Documents are synced by sending the full content on open. After that only incremental updates to the document are send. - TdSyncIncremental - deriving (Read, Eq, Show) - -instance ToJSON TextDocumentSyncKind where - toJSON TdSyncNone = Number 0 - toJSON TdSyncFull = Number 1 - toJSON TdSyncIncremental = Number 2 - -instance FromJSON TextDocumentSyncKind where - parseJSON (Number 0) = pure TdSyncNone - parseJSON (Number 1) = pure TdSyncFull - parseJSON (Number 2) = pure TdSyncIncremental - parseJSON _ = fail "TextDocumentSyncKind" - -data TextDocumentSyncOptions = - TextDocumentSyncOptions - { -- | Open and close notifications are sent to the server. If omitted open - -- close notification should not be sent. - _openClose :: Maybe Bool - , -- | Change notifications are sent to the server. See - -- TextDocumentSyncKind.None, TextDocumentSyncKind.Full - -- and TextDocumentSyncKind.Incremental. If omitted it defaults to - -- TextDocumentSyncKind.None. - _change :: Maybe TextDocumentSyncKind - -- | If present will save notifications are sent to the server. If omitted the notification should not be - -- sent. - , _willSave :: Maybe Bool - -- | If present will save wait until requests are sent to the server. If omitted the request should not be - -- sent. - , _willSaveWaitUntil :: Maybe Bool - -- | If present save notifications are sent to the server. If omitted the - -- notification should not be sent. - , _save :: Maybe (Bool |? SaveOptions) - } deriving (Show, Read, Eq) -deriveJSON lspOptions ''TextDocumentSyncOptions - --- ------------------------------------- - -{- -Since most of the registration options require to specify a document selector -there is a base interface that can be used. --} - -data TextDocumentRegistrationOptions = - TextDocumentRegistrationOptions - { _documentSelector :: Maybe DocumentSelector - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''TextDocumentRegistrationOptions - --- ------------------------------------- - -data DidOpenTextDocumentParams = - DidOpenTextDocumentParams - { -- | The document that was opened. - _textDocument :: TextDocumentItem - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''DidOpenTextDocumentParams - --- ------------------------------------- - -makeExtendingDatatype "TextDocumentChangeRegistrationOptions" - [''TextDocumentRegistrationOptions] - [("_syncKind", [t| TextDocumentSyncKind |])] - -deriveJSON lspOptions ''TextDocumentChangeRegistrationOptions - -data TextDocumentContentChangeEvent = - TextDocumentContentChangeEvent - { -- | The range of the document that changed. - _range :: Maybe Range - -- | The optional length of the range that got replaced. - -- Deprecated, use _range instead - , _rangeLength :: Maybe UInt - -- | The new text for the provided range, if provided. - -- Otherwise the new text of the whole document. - , _text :: Text - } - deriving (Read,Show,Eq) - -deriveJSON lspOptions ''TextDocumentContentChangeEvent - --- ------------------------------------- - -data DidChangeTextDocumentParams = - 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. The content changes describe single state changes - -- to the document. So if there are two content changes c1 (at array index 0) and - -- c2 (at array index 1) for a document in state S then c1 moves the document from - -- S to S' and c2 from S' to S''. So c1 is computed on the state S and c2 is computed - -- on the state S'. - -- - -- To mirror the content of a document using change events use the following approach: - -- - start with the same initial content - -- - apply the 'textDocument/didChange' notifications in the order you recevie them. - -- - apply the `TextDocumentContentChangeEvent`s in a single notification in the order - -- you receive them. - , _contentChanges :: List TextDocumentContentChangeEvent - } deriving (Show,Read,Eq) - -deriveJSON lspOptions ''DidChangeTextDocumentParams - --- ------------------------------------- - -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 ToJSON TextDocumentSaveReason where - toJSON SaveManual = Number 1 - toJSON SaveAfterDelay = Number 2 - toJSON SaveFocusOut = Number 3 - -instance FromJSON TextDocumentSaveReason where - parseJSON (Number 1) = pure SaveManual - parseJSON (Number 2) = pure SaveAfterDelay - parseJSON (Number 3) = pure SaveFocusOut - parseJSON _ = fail "TextDocumentSaveReason" - -data WillSaveTextDocumentParams = - WillSaveTextDocumentParams - { -- | The document that will be saved. - _textDocument :: TextDocumentIdentifier - -- | The 'TextDocumentSaveReason'. - , _reason :: TextDocumentSaveReason - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''WillSaveTextDocumentParams - --- ------------------------------------- - - -makeExtendingDatatype "TextDocumentSaveRegistrationOptions" - [''TextDocumentRegistrationOptions] - [("_includeText", [t| Maybe Bool |])] - -deriveJSON lspOptions ''TextDocumentSaveRegistrationOptions - -data DidSaveTextDocumentParams = - DidSaveTextDocumentParams - { -- | The document that was saved. - _textDocument :: TextDocumentIdentifier - -- | Optional the content when saved. Depends on the includeText value - -- when the save notification was requested. - , _text :: Maybe Text - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''DidSaveTextDocumentParams - --- ------------------------------------- - -data DidCloseTextDocumentParams = - DidCloseTextDocumentParams - { -- | The document that was closed. - _textDocument :: TextDocumentIdentifier - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''DidCloseTextDocumentParams diff --git a/lsp-types/src/Language/LSP/Types/TypeDefinition.hs b/lsp-types/src/Language/LSP/Types/TypeDefinition.hs deleted file mode 100644 index 7eef8676d..000000000 --- a/lsp-types/src/Language/LSP/Types/TypeDefinition.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} - -module Language.LSP.Types.TypeDefinition where - -import Data.Aeson.TH -import Language.LSP.Types.Progress -import Language.LSP.Types.StaticRegistrationOptions -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Utils - -data TypeDefinitionClientCapabilities = TypeDefinitionClientCapabilities - { -- | Whether implementation supports dynamic registration. If this is set - -- to 'True' - -- the client supports the new 'TypeDefinitionRegistrationOptions' return - -- value for the corresponding server capability as well. - _dynamicRegistration :: Maybe Bool, - -- | The client supports additional metadata in the form of definition links. - -- - -- Since LSP 3.14.0 - _linkSupport :: Maybe Bool - } - deriving (Read, Show, Eq) - -deriveJSON lspOptions ''TypeDefinitionClientCapabilities - -makeExtendingDatatype "TypeDefinitionOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''TypeDefinitionOptions - -makeExtendingDatatype "TypeDefinitionRegistrationOptions" - [ ''TextDocumentRegistrationOptions - , ''TypeDefinitionOptions - , ''StaticRegistrationOptions - ] [] -deriveJSON lspOptions ''TypeDefinitionRegistrationOptions - -makeExtendingDatatype "TypeDefinitionParams" - [ ''TextDocumentPositionParams - , ''WorkDoneProgressParams - , ''PartialResultParams - ] [] -deriveJSON lspOptions ''TypeDefinitionParams diff --git a/lsp-types/src/Language/LSP/Types/WatchedFiles.hs b/lsp-types/src/Language/LSP/Types/WatchedFiles.hs deleted file mode 100644 index 38a16bf6d..000000000 --- a/lsp-types/src/Language/LSP/Types/WatchedFiles.hs +++ /dev/null @@ -1,113 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} - -module Language.LSP.Types.WatchedFiles where - -import Data.Aeson -import Data.Aeson.TH -import Data.Bits -import Data.Scientific -import Language.LSP.Types.Common -import Language.LSP.Types.Uri -import Language.LSP.Types.Utils -import Data.Text (Text) - --- ------------------------------------- - -data DidChangeWatchedFilesClientCapabilities = DidChangeWatchedFilesClientCapabilities - { -- | Did change watched files notification supports dynamic - -- registration. - _dynamicRegistration :: Maybe Bool - } - deriving (Show, Read, Eq) -deriveJSON lspOptions ''DidChangeWatchedFilesClientCapabilities - --- | Describe options to be used when registering for file system change events. -data DidChangeWatchedFilesRegistrationOptions = - DidChangeWatchedFilesRegistrationOptions - { -- | The watchers to register. - _watchers :: List FileSystemWatcher - } deriving (Show, Read, Eq) - -data FileSystemWatcher = - FileSystemWatcher - { -- | The glob pattern to watch. - -- Glob patterns can have the following syntax: - -- - @*@ to match one or more characters in a path segment - -- - @?@ to match on one character in a path segment - -- - @**@ to match any number of path segments, including none - -- - @{}@ to group conditions (e.g. @**​/*.{ts,js}@ matches all TypeScript and JavaScript files) - -- - @[]@ to declare a range of characters to match in a path segment (e.g., @example.[0-9]@ to match on @example.0@, @example.1@, …) - -- - @[!...]@ to negate a range of characters to match in a path segment (e.g., @example.[!0-9]@ to match on @example.a@, @example.b@, but not @example.0@) - _globPattern :: Text, - -- | The kind of events of interest. If omitted it defaults - -- to WatchKind.Create | WatchKind.Change | WatchKind.Delete - -- which is 7. - _kind :: Maybe WatchKind - } deriving (Show, Read, Eq) - -data WatchKind = - WatchKind { - -- | Watch for create events - _watchCreate :: Bool, - -- | Watch for change events - _watchChange :: Bool, - -- | Watch for delete events - _watchDelete :: Bool - } deriving (Show, Read, Eq) - -instance ToJSON WatchKind where - toJSON wk = Number (createNum + changeNum + deleteNum) - where - createNum = if _watchCreate wk then 0x1 else 0x0 - changeNum = if _watchChange wk then 0x2 else 0x0 - deleteNum = if _watchDelete wk then 0x4 else 0x0 - -instance FromJSON WatchKind where - parseJSON (Number n) - | Right i <- floatingOrInteger n :: Either Double Int - , 0 <= i && i <= 7 = - pure $ WatchKind (testBit i 0x0) (testBit i 0x1) (testBit i 0x2) - | otherwise = fail "WatchKind" - parseJSON _ = fail "WatchKind" - -deriveJSON lspOptions ''FileSystemWatcher -deriveJSON lspOptions ''DidChangeWatchedFilesRegistrationOptions --- | The file event type. -data FileChangeType = FcCreated -- ^ The file got created. - | FcChanged -- ^ The file got changed. - | FcDeleted -- ^ The file got deleted. - deriving (Read,Show,Eq) - -instance ToJSON FileChangeType where - toJSON FcCreated = Number 1 - toJSON FcChanged = Number 2 - toJSON FcDeleted = Number 3 - -instance FromJSON FileChangeType where - parseJSON (Number 1) = pure FcCreated - parseJSON (Number 2) = pure FcChanged - parseJSON (Number 3) = pure FcDeleted - parseJSON _ = fail "FileChangetype" - - --- ------------------------------------- - --- | An event describing a file change. -data FileEvent = - FileEvent - { -- | The file's URI. - _uri :: Uri - -- | The change type. - , _xtype :: FileChangeType - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''FileEvent - -data DidChangeWatchedFilesParams = - DidChangeWatchedFilesParams - { -- | The actual file events. - _changes :: List FileEvent - } deriving (Read,Show,Eq) - -deriveJSON lspOptions ''DidChangeWatchedFilesParams diff --git a/lsp-types/src/Language/LSP/Types/Window.hs b/lsp-types/src/Language/LSP/Types/Window.hs deleted file mode 100644 index eeb20862d..000000000 --- a/lsp-types/src/Language/LSP/Types/Window.hs +++ /dev/null @@ -1,114 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -module Language.LSP.Types.Window where - -import qualified Data.Aeson as A -import Data.Aeson.TH -import Data.Text (Text) -import Language.LSP.Types.Utils -import Language.LSP.Types.Uri -import Language.LSP.Types.Location - --- --------------------------------------------------------------------- - -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 _ = fail "MessageType" - --- --------------------------------------- - - -data ShowMessageParams = - ShowMessageParams { - _xtype :: MessageType - , _message :: Text - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''ShowMessageParams - --- --------------------------------------------------------------------- - -data MessageActionItem = - MessageActionItem - { _title :: Text - } deriving (Show,Read,Eq) - -deriveJSON lspOptions ''MessageActionItem - - -data ShowMessageRequestParams = - ShowMessageRequestParams - { _xtype :: MessageType - , _message :: Text - , _actions :: Maybe [MessageActionItem] - } deriving (Show,Read,Eq) - -deriveJSON lspOptions ''ShowMessageRequestParams - --- --------------------------------------------------------------------- - --- | Params to show a document. --- --- @since 3.16.0 -data ShowDocumentParams = - ShowDocumentParams { - -- | The document uri to show. - _uri :: Uri - - -- | Indicates to show the resource in an external program. - -- To show for example `https://code.visualstudio.com/` - -- in the default WEB browser set `external` to `true`. - , _external :: Maybe Bool - - -- | An optional property to indicate whether the editor - -- showing the document should take focus or not. - -- Clients might ignore this property if an external - -- program is started. - , _takeFocus :: Maybe Bool - - -- | An optional selection range if the document is a text - -- document. Clients might ignore the property if an - -- external program is started or the file is not a text - -- file. - , _selection :: Maybe Range - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''ShowDocumentParams - --- | The result of an show document request. --- --- @since 3.16.0 -data ShowDocumentResult = - ShowDocumentResult { - -- | A boolean indicating if the show was successful. - _success :: Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''ShowDocumentResult - --- --------------------------------------------------------------------- - -data LogMessageParams = - LogMessageParams { - _xtype :: MessageType - , _message :: Text - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''LogMessageParams diff --git a/lsp-types/src/Language/LSP/Types/WorkspaceEdit.hs b/lsp-types/src/Language/LSP/Types/WorkspaceEdit.hs deleted file mode 100644 index ecd01ad9b..000000000 --- a/lsp-types/src/Language/LSP/Types/WorkspaceEdit.hs +++ /dev/null @@ -1,404 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Language.LSP.Types.WorkspaceEdit where - -import Control.Monad (unless) -import Data.Aeson -import Data.Aeson.TH -import qualified Data.HashMap.Strict as H -import Data.Maybe (catMaybes) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Hashable - -import Language.LSP.Types.Common -import Language.LSP.Types.Location -import Language.LSP.Types.TextDocument -import Language.LSP.Types.Uri -import Language.LSP.Types.Utils - --- --------------------------------------------------------------------- - -data TextEdit = - TextEdit - { _range :: Range - , _newText :: Text - } deriving (Show,Read,Eq) - -deriveJSON lspOptions ''TextEdit - --- --------------------------------------------------------------------- - -{-| -Additional information that describes document changes. - -@since 3.16.0 --} -data ChangeAnnotation = - ChangeAnnotation - { -- | A human-readable string describing the actual change. The string - -- is rendered prominent in the user interface. - _label :: Text - -- | A flag which indicates that user confirmation is needed - -- before applying the change. - , _needsConfirmation :: Maybe Bool - -- | A human-readable string which is rendered less prominent in - -- the user interface. - , _description :: Maybe Text - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''ChangeAnnotation - -{-| -An identifier referring to a change annotation managed by a workspace -edit. - -@since 3.16.0 --} -newtype ChangeAnnotationIdentifier = ChangeAnnotationIdentifierId Text - deriving (Show, Read, Eq, FromJSON, ToJSON, ToJSONKey, FromJSONKey, Hashable) - -makeExtendingDatatype "AnnotatedTextEdit" [''TextEdit] - [("_annotationId", [t| ChangeAnnotationIdentifier |]) ] -deriveJSON lspOptions ''AnnotatedTextEdit - --- --------------------------------------------------------------------- - -data TextDocumentEdit = - TextDocumentEdit - { _textDocument :: VersionedTextDocumentIdentifier - , _edits :: List (TextEdit |? AnnotatedTextEdit) - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''TextDocumentEdit - --- --------------------------------------------------------------------- - --- | Options to create a file. -data CreateFileOptions = - CreateFileOptions - { -- | Overwrite existing file. Overwrite wins over `ignoreIfExists` - _overwrite :: Maybe Bool - -- | Ignore if exists. - , _ignoreIfExists :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''CreateFileOptions - --- | Create file operation -data CreateFile = - CreateFile - { -- | The resource to create. - _uri :: Uri - -- | Additional options - , _options :: Maybe CreateFileOptions - -- | An optional annotation identifer describing the operation. - -- - -- @since 3.16.0 - , _annotationId :: Maybe ChangeAnnotationIdentifier - } deriving (Show, Read, Eq) - -instance ToJSON CreateFile where - toJSON CreateFile{..} = - object $ catMaybes - [ Just $ "kind" .= ("create" :: Text) - , Just $ "uri" .= _uri - , ("options" .=) <$> _options - , ("annotationId" .=) <$> _annotationId - ] - -instance FromJSON CreateFile where - parseJSON = withObject "CreateFile" $ \o -> do - kind <- o .: "kind" - unless (kind == ("create" :: Text)) - $ fail $ "Expected kind \"create\" but got " ++ show kind - _uri <- o .: "uri" - _options <- o .:? "options" - _annotationId <- o .:? "annotationId" - pure CreateFile{..} - --- Rename file options -data RenameFileOptions = - RenameFileOptions - { -- | Overwrite target if existing. Overwrite wins over `ignoreIfExists` - _overwrite :: Maybe Bool - -- | Ignores if target exists. - , _ignoreIfExists :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''RenameFileOptions - --- | Rename file operation -data RenameFile = - RenameFile - { -- | The old (existing) location. - _oldUri :: Uri - -- | The new location. - , _newUri :: Uri - -- | Rename options. - , _options :: Maybe RenameFileOptions - -- | An optional annotation identifer describing the operation. - -- - -- @since 3.16.0 - , _annotationId :: Maybe ChangeAnnotationIdentifier - } deriving (Show, Read, Eq) - -instance ToJSON RenameFile where - toJSON RenameFile{..} = - object $ catMaybes - [ Just $ "kind" .= ("rename" :: Text) - , Just $ "oldUri" .= _oldUri - , Just $ "newUri" .= _newUri - , ("options" .=) <$> _options - , ("annotationId" .=) <$> _annotationId - ] - -instance FromJSON RenameFile where - parseJSON = withObject "RenameFile" $ \o -> do - kind <- o .: "kind" - unless (kind == ("rename" :: Text)) - $ fail $ "Expected kind \"rename\" but got " ++ show kind - _oldUri <- o .: "oldUri" - _newUri <- o .: "newUri" - _options <- o .:? "options" - _annotationId <- o .:? "annotationId" - pure RenameFile{..} - --- Delete file options -data DeleteFileOptions = - DeleteFileOptions - { -- | Delete the content recursively if a folder is denoted. - _recursive :: Maybe Bool - -- | Ignore the operation if the file doesn't exist. - , _ignoreIfNotExists :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''DeleteFileOptions - --- | Delete file operation -data DeleteFile = - DeleteFile - { -- | The file to delete. - _uri :: Uri - -- | Delete options. - , _options :: Maybe DeleteFileOptions - -- | An optional annotation identifer describing the operation. - -- - -- @since 3.16.0 - , _annotationId :: Maybe ChangeAnnotationIdentifier - } deriving (Show, Read, Eq) - -instance ToJSON DeleteFile where - toJSON DeleteFile{..} = - object $ catMaybes - [ Just $ "kind" .= ("delete" :: Text) - , Just $ "uri" .= _uri - , ("options" .=) <$> _options - , ("annotationId" .=) <$> _annotationId - ] - -instance FromJSON DeleteFile where - parseJSON = withObject "DeleteFile" $ \o -> do - kind <- o .: "kind" - unless (kind == ("delete" :: Text)) - $ fail $ "Expected kind \"delete\" but got " ++ show kind - _uri <- o .: "uri" - _options <- o .:? "options" - _annotationId <- o .:? "annotationId" - pure DeleteFile{..} - --- --------------------------------------------------------------------- - --- | `TextDocumentEdit |? CreateFile |? RenameFile |? DeleteFile` is a bit mouthful, here's the synonym -type DocumentChange = TextDocumentEdit |? CreateFile |? RenameFile |? DeleteFile - --- --------------------------------------------------------------------- - -type WorkspaceEditMap = H.HashMap Uri (List TextEdit) -type ChangeAnnotationMap = H.HashMap ChangeAnnotationIdentifier ChangeAnnotation - -data WorkspaceEdit = - WorkspaceEdit - { - -- | Holds changes to existing resources. - _changes :: Maybe WorkspaceEditMap - -- | Depending on the client capability - -- `workspace.workspaceEdit.resourceOperations` document changes are either - -- an array of `TextDocumentEdit`s to express changes to n different text - -- documents where each text document edit addresses a specific version of - -- a text document. Or it can contain above `TextDocumentEdit`s mixed with - -- create, rename and delete file / folder operations. - -- - -- Whether a client supports versioned document edits is expressed via - -- `workspace.workspaceEdit.documentChanges` client capability. - -- - -- If a client neither supports `documentChanges` nor - -- `workspace.workspaceEdit.resourceOperations` then only plain `TextEdit`s - -- using the `changes` property are supported. - , _documentChanges :: Maybe (List DocumentChange) - -- | A map of change annotations that can be referenced in - -- `AnnotatedTextEdit`s or create, rename and delete file / folder - -- operations. - -- - -- Whether clients honor this property depends on the client capability - -- `workspace.changeAnnotationSupport`. - -- - -- @since 3.16.0 - , _changeAnnotations :: Maybe ChangeAnnotationMap - } deriving (Show, Read, Eq) - -instance Semigroup WorkspaceEdit where - (WorkspaceEdit a b c) <> (WorkspaceEdit a' b' c') = WorkspaceEdit (a <> a') (b <> b') (c <> c') -instance Monoid WorkspaceEdit where - mempty = WorkspaceEdit Nothing Nothing Nothing - -deriveJSON lspOptions ''WorkspaceEdit - --- ------------------------------------- - -data ResourceOperationKind - = ResourceOperationCreate -- ^ Supports creating new files and folders. - | ResourceOperationRename -- ^ Supports renaming existing files and folders. - | ResourceOperationDelete -- ^ Supports deleting existing files and folders. - deriving (Read, Show, Eq) - -instance ToJSON ResourceOperationKind where - toJSON ResourceOperationCreate = String "create" - toJSON ResourceOperationRename = String "rename" - toJSON ResourceOperationDelete = String "delete" - -instance FromJSON ResourceOperationKind where - parseJSON (String "create") = pure ResourceOperationCreate - parseJSON (String "rename") = pure ResourceOperationRename - parseJSON (String "delete") = pure ResourceOperationDelete - parseJSON _ = fail "ResourceOperationKind" - -data FailureHandlingKind - = FailureHandlingAbort -- ^ Applying the workspace change is simply aborted if one of the changes provided fails. All operations executed before the failing operation stay executed. - | FailureHandlingTransactional -- ^ All operations are executed transactional. That means they either all succeed or no changes at all are applied to the workspace. - | FailureHandlingTextOnlyTransactional -- ^ If the workspace edit contains only textual file changes they are executed transactional. If resource changes (create, rename or delete file) are part of the change the failure handling strategy is abort. - | FailureHandlingUndo -- ^ The client tries to undo the operations already executed. But there is no guarantee that this is succeeding. - deriving (Read, Show, Eq) - -instance ToJSON FailureHandlingKind where - toJSON FailureHandlingAbort = String "abort" - toJSON FailureHandlingTransactional = String "transactional" - toJSON FailureHandlingTextOnlyTransactional = String "textOnlyTransactional" - toJSON FailureHandlingUndo = String "undo" - -instance FromJSON FailureHandlingKind where - parseJSON (String "abort") = pure FailureHandlingAbort - parseJSON (String "transactional") = pure FailureHandlingTransactional - parseJSON (String "textOnlyTransactional") = pure FailureHandlingTextOnlyTransactional - parseJSON (String "undo") = pure FailureHandlingUndo - parseJSON _ = fail "FailureHandlingKind" - -data WorkspaceEditChangeAnnotationClientCapabilities = - WorkspaceEditChangeAnnotationClientCapabilities - { - -- | Whether the client groups edits with equal labels into tree nodes, - -- for instance all edits labelled with "Changes in Strings" would - -- be a tree node. - groupsOnLabel :: Maybe Bool - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''WorkspaceEditChangeAnnotationClientCapabilities - -data WorkspaceEditClientCapabilities = - WorkspaceEditClientCapabilities - { _documentChanges :: Maybe Bool -- ^The client supports versioned document - -- changes in 'WorkspaceEdit's - -- | The resource operations the client supports. Clients should at least - -- support @create@, @rename@ and @delete@ files and folders. - , _resourceOperations :: Maybe (List ResourceOperationKind) - -- | The failure handling strategy of a client if applying the workspace edit - -- fails. - , _failureHandling :: Maybe FailureHandlingKind - -- | Whether the client normalizes line endings to the client specific - -- setting. - -- - -- If set to `true` the client will normalize line ending characters - -- in a workspace edit to the client specific new line character(s). - -- - -- @since 3.16.0 - , _normalizesLineEndings :: Maybe Bool - -- | Whether the client in general supports change annotations on text edits, - -- create file, rename file and delete file changes. - -- - -- @since 3.16.0 - , _changeAnnotationSupport :: Maybe WorkspaceEditChangeAnnotationClientCapabilities - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''WorkspaceEditClientCapabilities - --- --------------------------------------------------------------------- - -data ApplyWorkspaceEditParams = - ApplyWorkspaceEditParams - { -- | An optional label of the workspace edit. This label is - -- presented in the user interface for example on an undo - -- stack to undo the workspace edit. - _label :: Maybe Text - -- | The edits to apply - , _edit :: WorkspaceEdit - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''ApplyWorkspaceEditParams - -data ApplyWorkspaceEditResponseBody = - ApplyWorkspaceEditResponseBody - { -- | Indicates whether the edit was applied or not. - _applied :: Bool - -- | An optional textual description for why the edit was not applied. - -- This may be used may be used by the server for diagnostic - -- logging or to provide a suitable error for a request that - -- triggered the edit. - , _failureReason :: Maybe Text - -- | Depending on the client's failure handling strategy `failedChange` - -- might contain the index of the change that failed. This property is - -- only available if the client signals a `failureHandling` strategy - -- in its client capabilities. - , _failedChange :: Maybe UInt - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''ApplyWorkspaceEditResponseBody - --- --------------------------------------------------------------------- - --- | Applies a 'TextEdit' to some 'Text'. --- >>> applyTextEdit (TextEdit (Range (Position 0 1) (Position 0 2)) "i") "foo" --- "fio" -applyTextEdit :: TextEdit -> Text -> Text -applyTextEdit (TextEdit (Range sp ep) newText) oldText = - let (_, afterEnd) = splitAtPos ep oldText - (beforeStart, _) = splitAtPos sp oldText - in mconcat [beforeStart, newText, afterEnd] - where - splitAtPos :: Position -> Text -> (Text, Text) - splitAtPos (Position sl sc) t = - -- If we are looking for a line beyond the end of the text, this will give us an index - -- past the end. Fortunately, T.splitAt is fine with this, and just gives us the whole - -- string and an empty string, which is what we want. - let index = sc + startLineIndex sl t - in T.splitAt (fromIntegral index) t - - -- The index of the first character of line 'line' - startLineIndex :: UInt -> Text -> UInt - startLineIndex 0 _ = 0 - startLineIndex line t' = - case T.findIndex (== '\n') t' of - Just i -> fromIntegral i + 1 + startLineIndex (line - 1) (T.drop (i + 1) t') - -- i != 0, and there are no newlines, so this is a line beyond the end of the text. - -- In this case give the "start index" as the end, so we will at least append the text. - Nothing -> fromIntegral $ T.length t' - --- | 'editTextEdit' @outer@ @inner@ applies @inner@ to the text inside @outer@. -editTextEdit :: TextEdit -> TextEdit -> TextEdit -editTextEdit (TextEdit origRange origText) innerEdit = - let newText = applyTextEdit innerEdit origText - in TextEdit origRange newText diff --git a/lsp-types/src/Language/LSP/Types/WorkspaceFolders.hs b/lsp-types/src/Language/LSP/Types/WorkspaceFolders.hs deleted file mode 100644 index faee28fd2..000000000 --- a/lsp-types/src/Language/LSP/Types/WorkspaceFolders.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TemplateHaskell #-} -module Language.LSP.Types.WorkspaceFolders where - -import Data.Aeson.TH -import Data.Text ( Text ) - -import Language.LSP.Types.Common -import Language.LSP.Types.Utils - -data WorkspaceFolder = - WorkspaceFolder - { -- | The URI of the workspace folder. - _uri :: Text - -- | The name of the workspace folder. Defaults to the uri's basename. - , _name :: Text - } deriving (Read, Show, Eq) - -deriveJSON lspOptions ''WorkspaceFolder - --- | The workspace folder change event. -data WorkspaceFoldersChangeEvent = - WorkspaceFoldersChangeEvent - { _added :: List WorkspaceFolder -- ^ The array of added workspace folders - , _removed :: List WorkspaceFolder -- ^ The array of the removed workspace folders - } deriving (Read, Show, Eq) - -deriveJSON lspOptions ''WorkspaceFoldersChangeEvent - -data DidChangeWorkspaceFoldersParams = - DidChangeWorkspaceFoldersParams - { _event :: WorkspaceFoldersChangeEvent - -- ^ The actual workspace folder change event. - } deriving (Read, Show, Eq) - -deriveJSON lspOptions ''DidChangeWorkspaceFoldersParams - diff --git a/lsp-types/src/Language/LSP/Types/WorkspaceSymbol.hs b/lsp-types/src/Language/LSP/Types/WorkspaceSymbol.hs deleted file mode 100644 index 6ee360483..000000000 --- a/lsp-types/src/Language/LSP/Types/WorkspaceSymbol.hs +++ /dev/null @@ -1,91 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} - -module Language.LSP.Types.WorkspaceSymbol where - -import Data.Aeson.TH -import Data.Default -import Language.LSP.Types.Common -import Language.LSP.Types.DocumentSymbol -import Language.LSP.Types.Progress -import Language.LSP.Types.Utils -import Data.Text (Text) - -data WorkspaceSymbolKindClientCapabilities = - WorkspaceSymbolKindClientCapabilities - { -- | The symbol kind values the client supports. When this - -- property exists the client also guarantees that it will - -- handle values outside its set gracefully and falls back - -- to a default value when unknown. - -- - -- If this property is not present the client only supports - -- the symbol kinds from `File` to `Array` as defined in - -- the initial version of the protocol. - _valueSet :: Maybe (List SymbolKind) - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''WorkspaceSymbolKindClientCapabilities - -data WorkspaceSymbolTagClientCapabilities = - WorkspaceSymbolTagClientCapabilities - { -- | The tags supported by the client. - _valueSet :: Maybe (List SymbolTag) - } - deriving (Show, Read, Eq) - -deriveJSON lspOptions ''WorkspaceSymbolTagClientCapabilities - -instance Default WorkspaceSymbolKindClientCapabilities where - def = WorkspaceSymbolKindClientCapabilities (Just $ List allKinds) - where allKinds = [ SkFile - , SkModule - , SkNamespace - , SkPackage - , SkClass - , SkMethod - , SkProperty - , SkField - , SkConstructor - , SkEnum - , SkInterface - , SkFunction - , SkVariable - , SkConstant - , SkString - , SkNumber - , SkBoolean - , SkArray - ] - -data WorkspaceSymbolClientCapabilities = - WorkspaceSymbolClientCapabilities - { _dynamicRegistration :: Maybe Bool -- ^Symbol request supports dynamic - -- registration. - , _symbolKind :: Maybe WorkspaceSymbolKindClientCapabilities -- ^ Specific capabilities for the `SymbolKind`. - -- | The client supports tags on `SymbolInformation`. - -- Clients supporting tags have to handle unknown tags gracefully. - -- - -- @since 3.16.0 - , _tagSupport :: Maybe WorkspaceSymbolTagClientCapabilities - } deriving (Show, Read, Eq) - -deriveJSON lspOptions ''WorkspaceSymbolClientCapabilities - --- ------------------------------------- - -makeExtendingDatatype "WorkspaceSymbolOptions" [''WorkDoneProgressOptions] [] -deriveJSON lspOptions ''WorkspaceSymbolOptions - -makeExtendingDatatype "WorkspaceSymbolRegistrationOptions" - [''WorkspaceSymbolOptions] [] -deriveJSON lspOptions ''WorkspaceSymbolRegistrationOptions - --- ------------------------------------- - -makeExtendingDatatype "WorkspaceSymbolParams" - [ ''WorkDoneProgressParams - , ''PartialResultParams - ] - [("_query", [t| Text |])] - -deriveJSON lspOptions ''WorkspaceSymbolParams diff --git a/lsp-types/test/CapabilitiesSpec.hs b/lsp-types/test/CapabilitiesSpec.hs index a91e23019..0836bc4d1 100644 --- a/lsp-types/test/CapabilitiesSpec.hs +++ b/lsp-types/test/CapabilitiesSpec.hs @@ -1,16 +1,19 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module CapabilitiesSpec where -import Language.LSP.Types -import Language.LSP.Types.Capabilities -import Test.Hspec +import Language.LSP.Protocol.Types +import Language.LSP.Protocol.Capabilities +import Test.Hspec spec :: Spec spec = describe "capabilities" $ do it "gives 3.10 capabilities" $ - let ClientCapabilities _ (Just tdcs) _ _ _ = capsForVersion (LSPVersion 3 10) - Just (DocumentSymbolClientCapabilities _ _ mHierarchical _ _ ) = _documentSymbol tdcs + let ClientCapabilities{_textDocument=Just tdcs} = capsForVersion (LSPVersion 3 10) + Just (DocumentSymbolClientCapabilities{_hierarchicalDocumentSymbolSupport=mHierarchical}) = _documentSymbol tdcs in mHierarchical `shouldBe` Just True it "gives pre 3.10 capabilities" $ - let ClientCapabilities _ (Just tdcs) _ _ _ = capsForVersion (LSPVersion 3 9) - Just (DocumentSymbolClientCapabilities _ _ mHierarchical _ _) = _documentSymbol tdcs + let ClientCapabilities{_textDocument=Just tdcs} = capsForVersion (LSPVersion 3 9) + Just (DocumentSymbolClientCapabilities{_hierarchicalDocumentSymbolSupport=mHierarchical}) = _documentSymbol tdcs in mHierarchical `shouldBe` Nothing diff --git a/lsp-types/test/JsonSpec.hs b/lsp-types/test/JsonSpec.hs index 8e57708c0..be1075e58 100644 --- a/lsp-types/test/JsonSpec.hs +++ b/lsp-types/test/JsonSpec.hs @@ -1,23 +1,34 @@ -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeInType #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} --- For the use of MarkedString +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeOperators #-} + +-- we're using some deprecated stuff from the LSP spec, that's fine {-# OPTIONS_GHC -fno-warn-deprecations #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Test for JSON serialization module JsonSpec where -import Language.LSP.Types +import Language.LSP.Protocol.Types +import Language.LSP.Protocol.Message -import qualified Data.Aeson as J -import Data.List(isPrefixOf) +import qualified Data.Aeson as J +import Data.List (isPrefixOf) +import qualified Data.Row as R +import qualified Data.Row.Records as R +import Data.Void import Test.Hspec import Test.Hspec.QuickCheck -import Test.QuickCheck hiding (Success) -import Test.QuickCheck.Instances () +import Test.QuickCheck hiding (Success) +import Test.QuickCheck.Instances () -- import Debug.Trace -- --------------------------------------------------------------------- @@ -38,19 +49,14 @@ jsonSpec :: Spec jsonSpec = do describe "General JSON instances round trip" $ do -- DataTypesJSON - prop "LanguageString" (propertyJsonRoundtrip :: LanguageString -> Property) prop "MarkedString" (propertyJsonRoundtrip :: MarkedString -> Property) prop "MarkupContent" (propertyJsonRoundtrip :: MarkupContent -> Property) - prop "HoverContents" (propertyJsonRoundtrip :: HoverContents -> Property) - prop "ResponseError" (propertyJsonRoundtrip :: ResponseError -> Property) prop "WatchedFiles" (propertyJsonRoundtrip :: DidChangeWatchedFilesRegistrationOptions -> Property) - prop "ResponseMessage Initialize" - (propertyJsonRoundtrip :: ResponseMessage 'TextDocumentHover -> Property) - -- prop "ResponseMessage JSON value" - -- (propertyJsonRoundtrip :: ResponseMessage J.Value -> Property) + prop "ResponseMessage Hover" + (propertyJsonRoundtrip :: TResponseMessage 'Method_TextDocumentHover -> Property) describe "JSON decoding regressions" $ it "CompletionItem" $ - (J.decode "{\"jsonrpc\":\"2.0\",\"result\":[{\"label\":\"raisebox\"}],\"id\":1}" :: Maybe (ResponseMessage 'TextDocumentCompletion)) + (J.decode "{\"jsonrpc\":\"2.0\",\"result\":[{\"label\":\"raisebox\"}],\"id\":1}" :: Maybe (TResponseMessage 'Method_TextDocumentCompletion)) `shouldNotBe` Nothing @@ -60,18 +66,18 @@ responseMessageSpec = do it "decodes result = null" $ do let input = "{\"jsonrpc\": \"2.0\", \"id\": 123, \"result\": null}" in J.decode input `shouldBe` Just - ((ResponseMessage "2.0" (Just (IdInt 123)) (Right J.Null)) :: ResponseMessage 'WorkspaceExecuteCommand) + ((TResponseMessage "2.0" (Just (IdInt 123)) (Right $ InR Null)) :: TResponseMessage 'Method_WorkspaceExecuteCommand) it "handles missing params field" $ do J.eitherDecode "{ \"jsonrpc\": \"2.0\", \"id\": 15, \"method\": \"shutdown\"}" - `shouldBe` Right (RequestMessage "2.0" (IdInt 15) SShutdown Empty) + `shouldBe` Right (TRequestMessage "2.0" (IdInt 15) SMethod_Shutdown Nothing) describe "invalid JSON" $ do it "throws if neither result nor error is present" $ do - (J.eitherDecode "{\"jsonrpc\":\"2.0\",\"id\":1}" :: Either String (ResponseMessage 'Initialize)) + (J.eitherDecode "{\"jsonrpc\":\"2.0\",\"id\":1}" :: Either String (TResponseMessage 'Method_Initialize)) `shouldBe` Left ("Error in $: both error and result cannot be Nothing") it "throws if both result and error are present" $ do (J.eitherDecode - "{\"jsonrpc\":\"2.0\",\"id\": 1,\"result\":{\"capabilities\": {}},\"error\":{\"code\":-32700,\"message\":\"\",\"data\":null}}" - :: Either String (ResponseMessage 'Initialize)) + "{\"jsonrpc\":\"2.0\",\"id\": 1,\"result\":{\"capabilities\": {}},\"error\":{\"code\":-32700,\"message\":\"\",\"data\":{ \"retry\":false}}}" + :: Either String (TResponseMessage 'Method_Initialize)) `shouldSatisfy` (either (\err -> "Error in $: both error and result cannot be present" `isPrefixOf` err) (\_ -> False)) @@ -82,22 +88,22 @@ propertyJsonRoundtrip a = J.Success a === J.fromJSON (J.toJSON a) -- --------------------------------------------------------------------- -instance Arbitrary LanguageString where - arbitrary = LanguageString <$> arbitrary <*> arbitrary +instance (Arbitrary a, Arbitrary b) => Arbitrary (a |? b) where + arbitrary = oneof [InL <$> arbitrary, InR <$> arbitrary] + +instance Arbitrary Null where + arbitrary = pure Null + +instance (R.AllUniqueLabels r, R.Forall r Arbitrary) => Arbitrary (R.Rec r) where + arbitrary = R.fromLabelsA @Arbitrary $ \_l -> arbitrary -instance Arbitrary MarkedString where - arbitrary = oneof [PlainString <$> arbitrary, CodeString <$> arbitrary] +deriving newtype instance Arbitrary MarkedString instance Arbitrary MarkupContent where arbitrary = MarkupContent <$> arbitrary <*> arbitrary instance Arbitrary MarkupKind where - arbitrary = oneof [pure MkPlainText,pure MkMarkdown] - -instance Arbitrary HoverContents where - arbitrary = oneof [ HoverContentsMS <$> arbitrary - , HoverContents <$> arbitrary - ] + arbitrary = oneof [pure MarkupKind_PlainText,pure MarkupKind_Markdown] instance Arbitrary UInt where arbitrary = fromInteger <$> arbitrary @@ -105,6 +111,17 @@ instance Arbitrary UInt where instance Arbitrary Uri where arbitrary = Uri <$> arbitrary +--deriving newtype instance Arbitrary URI + +instance Arbitrary WorkspaceFolder where + arbitrary = WorkspaceFolder <$> arbitrary <*> arbitrary + +instance Arbitrary RelativePattern where + arbitrary = RelativePattern <$> arbitrary <*> arbitrary + +deriving newtype instance Arbitrary Pattern +deriving newtype instance Arbitrary GlobPattern + instance Arbitrary Position where arbitrary = Position <$> arbitrary <*> arbitrary @@ -117,48 +134,30 @@ instance Arbitrary Range where instance Arbitrary Hover where arbitrary = Hover <$> arbitrary <*> arbitrary -instance Arbitrary (ResponseResult m) => Arbitrary (ResponseMessage m) where - arbitrary = - oneof - [ ResponseMessage - <$> arbitrary - <*> arbitrary - <*> (Right <$> arbitrary) - , ResponseMessage - <$> arbitrary - <*> arbitrary - <*> (Left <$> arbitrary) - ] +instance {-# OVERLAPPING #-} Arbitrary (Maybe Void) where + arbitrary = pure Nothing + +instance (ErrorData m ~ Maybe Void) => Arbitrary (TResponseError m) where + arbitrary = TResponseError <$> arbitrary <*> arbitrary <*> pure Nothing + +instance (Arbitrary (MessageResult m), ErrorData m ~ Maybe Void) => Arbitrary (TResponseMessage m) where + arbitrary = TResponseMessage <$> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary (LspId m) where arbitrary = oneof [IdInt <$> arbitrary, IdString <$> arbitrary] -instance Arbitrary ResponseError where - arbitrary = ResponseError <$> arbitrary <*> arbitrary <*> pure Nothing - -instance Arbitrary ErrorCode where +instance Arbitrary ErrorCodes where arbitrary = elements - [ ParseError - , InvalidRequest - , MethodNotFound - , InvalidParams - , InternalError - , ServerErrorStart - , ServerErrorEnd - , ServerNotInitialized - , UnknownErrorCode - , RequestCancelled - , ContentModified + [ ErrorCodes_ParseError + , ErrorCodes_InvalidRequest + , ErrorCodes_MethodNotFound + , ErrorCodes_InvalidParams + , ErrorCodes_InternalError + , ErrorCodes_ServerNotInitialized + , ErrorCodes_UnknownErrorCode ] --- | make lists of maximum length 3 for test performance -smallList :: Gen a -> Gen [a] -smallList = resize 3 . listOf - -instance (Arbitrary a) => Arbitrary (List a) where - arbitrary = List <$> arbitrary - -- --------------------------------------------------------------------- instance Arbitrary DidChangeWatchedFilesRegistrationOptions where @@ -167,7 +166,8 @@ instance Arbitrary DidChangeWatchedFilesRegistrationOptions where instance Arbitrary FileSystemWatcher where arbitrary = FileSystemWatcher <$> arbitrary <*> arbitrary +-- TODO: watchKind is weird instance Arbitrary WatchKind where - arbitrary = WatchKind <$> arbitrary <*> arbitrary <*> arbitrary + arbitrary = oneof [pure WatchKind_Change, pure WatchKind_Create, pure WatchKind_Delete] -- --------------------------------------------------------------------- diff --git a/lsp-types/test/LocationSpec.hs b/lsp-types/test/LocationSpec.hs index 2b1c92750..295f047ff 100644 --- a/lsp-types/test/LocationSpec.hs +++ b/lsp-types/test/LocationSpec.hs @@ -2,7 +2,7 @@ module LocationSpec where -import Language.LSP.Types +import Language.LSP.Protocol.Types import Test.Hspec main :: IO () diff --git a/lsp-types/test/Main.hs b/lsp-types/test/Main.hs index 0dabfb276..bbbfdc372 100644 --- a/lsp-types/test/Main.hs +++ b/lsp-types/test/Main.hs @@ -1,7 +1,7 @@ module Main where -import Test.Hspec.Runner import qualified Spec +import Test.Hspec.Runner main :: IO () main = hspec Spec.spec diff --git a/lsp-types/test/MethodSpec.hs b/lsp-types/test/MethodSpec.hs index 84eb18716..ac086ea07 100644 --- a/lsp-types/test/MethodSpec.hs +++ b/lsp-types/test/MethodSpec.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE OverloadedStrings, DataKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} module MethodSpec where import Control.Monad -import qualified Data.Aeson as J -import qualified Language.LSP.Types as J +import qualified Data.Aeson as J +import qualified Data.Text as T +import qualified Language.LSP.Protocol.Message as J import Test.Hspec -import qualified Data.Text as T -- --------------------------------------------------------------------- @@ -31,7 +32,6 @@ clientMethods = [ ,"workspace/didChangeWatchedFiles" ,"workspace/symbol" ,"workspace/executeCommand" - ,"workspace/semanticTokens/refresh" -- Document ,"textDocument/didOpen" ,"textDocument/didChange" @@ -61,7 +61,8 @@ clientMethods = [ ,"callHierarchy/incomingCalls" ,"callHierarchy/outgoingCalls" - ,"textDocument/semanticTokens" + -- FIXME: weird method + -- ,"textDocument/semanticTokens" ,"textDocument/semanticTokens/full" ,"textDocument/semanticTokens/full/delta" ,"textDocument/semanticTokens/range" @@ -79,6 +80,7 @@ serverMethods = [ ,"client/unregisterCapability" -- Workspace ,"workspace/applyEdit" + ,"workspace/semanticTokens/refresh" -- Document ,"textDocument/publishDiagnostics" ] diff --git a/lsp-types/test/SemanticTokensSpec.hs b/lsp-types/test/SemanticTokensSpec.hs index 89feeb36d..77498166a 100644 --- a/lsp-types/test/SemanticTokensSpec.hs +++ b/lsp-types/test/SemanticTokensSpec.hs @@ -1,33 +1,37 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeApplications #-} module SemanticTokensSpec where -import Test.Hspec -import Language.LSP.Types -import Data.List (unfoldr) -import Data.Either (isRight) +import Data.Either (isRight) +import Data.List (unfoldr) +import Language.LSP.Protocol.Types hiding (context) +import Test.Hspec spec :: Spec spec = do - let exampleLegend = SemanticTokensLegend (List [SttProperty, SttType, SttClass]) (List [StmUnknown "private", StmStatic]) + let + allMods = [SemanticTokenModifiers_Abstract, SemanticTokenModifiers_Static] + exampleLegend = SemanticTokensLegend + (fmap toEnumBaseType [SemanticTokenTypes_Property, SemanticTokenTypes_Type, SemanticTokenTypes_Class]) + (fmap toEnumBaseType allMods) exampleTokens1 = [ - SemanticTokenAbsolute 2 5 3 SttProperty [StmUnknown "private", StmStatic] - , SemanticTokenAbsolute 2 10 4 SttType [] - , SemanticTokenAbsolute 5 2 7 SttClass [] + SemanticTokenAbsolute 2 5 3 SemanticTokenTypes_Property allMods + , SemanticTokenAbsolute 2 10 4 SemanticTokenTypes_Type [] + , SemanticTokenAbsolute 5 2 7 SemanticTokenTypes_Class [] ] exampleTokens2 = [ - SemanticTokenAbsolute 3 5 3 SttProperty [StmUnknown "private", StmStatic] - , SemanticTokenAbsolute 3 10 4 SttType [] - , SemanticTokenAbsolute 6 2 7 SttClass [] + SemanticTokenAbsolute 3 5 3 SemanticTokenTypes_Property allMods + , SemanticTokenAbsolute 3 10 4 SemanticTokenTypes_Type [] + , SemanticTokenAbsolute 6 2 7 SemanticTokenTypes_Class [] ] bigNumber :: UInt bigNumber = 100000 bigTokens = - unfoldr (\i -> if i == bigNumber then Nothing else Just (SemanticTokenAbsolute i 1 1 SttType [StmUnknown "private", StmStatic], i+1)) 0 + unfoldr (\i -> if i == bigNumber then Nothing else Just (SemanticTokenAbsolute i 1 1 SemanticTokenTypes_Type allMods, i+1)) 0 -- Relativized version of bigTokens bigTokensRel = - unfoldr (\i -> if i == bigNumber then Nothing else Just (SemanticTokenRelative (if i == 0 then 0 else 1) 1 1 SttType [StmUnknown "private", StmStatic], i+1)) 0 + unfoldr (\i -> if i == bigNumber then Nothing else Just (SemanticTokenRelative (if i == 0 then 0 else 1) 1 1 SemanticTokenTypes_Type allMods, i+1)) 0 -- One more order of magnitude makes diffing more-or-less hang - possibly we need a better diffing algorithm, since this is only ~= 200 tokens at 5 ints per token -- (I checked and it is the diffing that's slow, not turning it into edits) diff --git a/lsp-types/test/ServerCapabilitiesSpec.hs b/lsp-types/test/ServerCapabilitiesSpec.hs index c18e439e9..e6c5adccd 100644 --- a/lsp-types/test/ServerCapabilitiesSpec.hs +++ b/lsp-types/test/ServerCapabilitiesSpec.hs @@ -1,40 +1,43 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module ServerCapabilitiesSpec where -import Control.Lens.Operators -import Data.Aeson -import Language.LSP.Types -import Language.LSP.Types.Capabilities -import Language.LSP.Types.Lens -import Test.Hspec +import Control.Lens.Operators +import Data.Aeson hiding (Null) +import Data.Row +import Data.Maybe (fromJust) +import Language.LSP.Protocol.Types +import Language.LSP.Protocol.Message +import Test.Hspec spec :: Spec spec = describe "server capabilities" $ do describe "folding range options" $ do describe "decodes" $ do it "just id" $ - let input = "{\"id\": \"abc123\"}" - in decode input `shouldBe` Just (FoldingRangeRegistrationOptions Nothing Nothing (Just "abc123")) + let input = "{\"id\": \"abc123\", \"documentSelector\": null}" + in decode input `shouldBe` Just (FoldingRangeRegistrationOptions (InR Null) Nothing (Just "abc123")) it "id and document selector" $ let input = "{\"id\": \"foo\", \"documentSelector\": " <> documentFiltersJson <> "}" - in decode input `shouldBe` Just (FoldingRangeRegistrationOptions (Just documentFilters) Nothing (Just "foo")) + in decode input `shouldBe` Just (FoldingRangeRegistrationOptions (InL documentFilters) Nothing (Just "foo")) it "static boolean" $ let input = "true" in decode input `shouldBe` Just True describe "encodes" $ it "just id" $ - encode (FoldingRangeRegistrationOptions Nothing Nothing (Just "foo")) `shouldBe` "{\"id\":\"foo\"}" + encode (FoldingRangeRegistrationOptions (InR Null) Nothing (Just "foo")) `shouldBe` "{\"documentSelector\":null,\"id\":\"foo\"}" it "decodes" $ let input = "{\"hoverProvider\": true, \"colorProvider\": {\"id\": \"abc123\", \"documentSelector\": " <> documentFiltersJson <> "}}" - Just caps = decode input :: Maybe ServerCapabilities - in caps ^. colorProvider `shouldBe` Just (InR $ InR $ DocumentColorRegistrationOptions (Just documentFilters) (Just "abc123") Nothing) + caps :: ServerCapabilities = fromJust $ decode input + in caps ^. colorProvider `shouldBe` Just (InR $ InR $ DocumentColorRegistrationOptions (InL documentFilters) Nothing (Just "abc123")) describe "client/registerCapability" $ it "allows empty registerOptions" $ let input = "{\"registrations\":[{\"registerOptions\":{},\"method\":\"workspace/didChangeConfiguration\",\"id\":\"4a56f5ca-7188-4f4c-a366-652d6f9d63aa\"}]}" - Just registrationParams = decode input :: Maybe RegistrationParams + registrationParams :: RegistrationParams = fromJust $ decode input in registrationParams ^. registrations `shouldBe` - List [SomeRegistration $ Registration "4a56f5ca-7188-4f4c-a366-652d6f9d63aa" - SWorkspaceDidChangeConfiguration (Just Empty)] + [toUntypedRegistration $ TRegistration "4a56f5ca-7188-4f4c-a366-652d6f9d63aa" + SMethod_WorkspaceDidChangeConfiguration (Just $ DidChangeConfigurationRegistrationOptions Nothing)] where - documentFilters = List [DocumentFilter (Just "haskell") Nothing Nothing] + documentFilters = DocumentSelector [DocumentFilter $ InL $ TextDocumentFilter $ InL $ #language .== "haskell" .+ #scheme .== Nothing .+ #pattern .== Nothing] documentFiltersJson = "[{\"language\": \"haskell\"}]" diff --git a/lsp-types/test/TypesSpec.hs b/lsp-types/test/TypesSpec.hs index b34d209ad..d35cfa393 100644 --- a/lsp-types/test/TypesSpec.hs +++ b/lsp-types/test/TypesSpec.hs @@ -1,30 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} module TypesSpec where -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J import Test.Hspec --- --------------------------------------------------------------------- - -main :: IO () -main = hspec spec - spec :: Spec -spec = diagnosticsSpec - --- --------------------------------------------------------------------- - -diagnosticsSpec :: Spec -diagnosticsSpec = do +spec = do describe "MarkupContent" $ do it "appends two plainstrings" $ do - J.unmarkedUpContent "string1\n" <> J.unmarkedUpContent "string2\n" - `shouldBe` J.unmarkedUpContent "string1\nstring2\n" + J.mkPlainText "string1\n" <> J.mkPlainText "string2\n" + `shouldBe` J.mkPlainText "string1\nstring2\n" it "appends a marked up and a plain string" $ do - J.markedUpContent "haskell" "foo :: Int" <> J.unmarkedUpContent "string2\nstring3\n" - `shouldBe` J.MarkupContent J.MkMarkdown "\n```haskell\nfoo :: Int\n```\nstring2 \nstring3 \n" + J.mkMarkdownCodeBlock "haskell" "foo :: Int" <> J.mkPlainText "string2\nstring3\n" + `shouldBe` J.MarkupContent J.MarkupKind_Markdown "\n```haskell\nfoo :: Int\n```\nstring2 \nstring3 \n" it "appends a plain string and a marked up string" $ do - J.unmarkedUpContent "string2\n" <> J.markedUpContent "haskell" "foo :: Int" - `shouldBe` J.MarkupContent J.MkMarkdown "string2 \n\n```haskell\nfoo :: Int\n```\n" - --- --------------------------------------------------------------------- + J.mkPlainText "string2\n" <> J.mkMarkdownCodeBlock "haskell" "foo :: Int" + `shouldBe` J.MarkupContent J.MarkupKind_Markdown "string2 \n\n```haskell\nfoo :: Int\n```\n" diff --git a/lsp-types/test/URIFilePathSpec.hs b/lsp-types/test/URIFilePathSpec.hs index f1c2bdfeb..8f15c8ab8 100644 --- a/lsp-types/test/URIFilePathSpec.hs +++ b/lsp-types/test/URIFilePathSpec.hs @@ -2,7 +2,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +-- We're testing our own deprecated function here! +{-# OPTIONS_GHC -Wno-deprecations #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + #if MIN_VERSION_filepath(1,4,100) + #define OS_PATH #endif @@ -15,10 +20,8 @@ import qualified System.OsPath as OsPath import Control.Monad (when) import Data.List import Data.Text (Text, pack) -import Language.LSP.Types +import Language.LSP.Protocol.Types hiding (uri, start) -import Control.Exception (IOException, throwIO) -import Data.Maybe (fromJust) import GHC.IO.Encoding (setFileSystemEncoding) import Network.URI import System.FilePath (normalise) @@ -89,12 +92,12 @@ platformAwareUriFilePathSpec = do it "converts a Windows file path to a URI" $ do let theFilePath = platformAwareFilePathToUri windowsOS "c:/Functional.hs" - theFilePath `shouldBe` (Uri "file:///c:/Functional.hs") + theFilePath `shouldBe` Uri "file:///c:/Functional.hs" it "converts a POSIX file path to a URI and back" $ do let theFilePath = platformAwareFilePathToUri "posix" "./Functional.hs" - theFilePath `shouldBe` (Uri "file://./Functional.hs") - let Just (URI scheme' auth' path' query' frag') = parseURI "file://./Functional.hs" + theFilePath `shouldBe` Uri "file://./Functional.hs" + let Just (URI scheme' auth' path' query' frag') = parseURI "file://./Functional.hs" (scheme',auth',path',query',frag') `shouldBe` ("file:" ,Just (URIAuth {uriUserInfo = "", uriRegName = ".", uriPort = ""}) -- AZ: Seems odd @@ -201,8 +204,8 @@ uriFilePathSpec = do it "converts a file path with initial current dir to a URI and back" $ do let uri = filePathToUri withInitialCurrentDirFilePath - uri `shouldBe` (Uri (pack withInitialCurrentDirUriStr)) - let Just (URI scheme' auth' path' query' frag') = parseURI withInitialCurrentDirUriStr + uri `shouldBe` Uri (pack withInitialCurrentDirUriStr) + let Just (URI scheme' auth' path' query' frag') = parseURI withInitialCurrentDirUriStr (scheme',auth',path',query',frag') `shouldBe` withInitialCurrentDirUriParts Just "Functional.hs" `shouldBe` uriToFilePath uri diff --git a/lsp-types/test/WorkspaceEditSpec.hs b/lsp-types/test/WorkspaceEditSpec.hs index 6779ecc3e..911e7c1fa 100644 --- a/lsp-types/test/WorkspaceEditSpec.hs +++ b/lsp-types/test/WorkspaceEditSpec.hs @@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module WorkspaceEditSpec where -import Test.Hspec -import Language.LSP.Types +import Language.LSP.Protocol.Types +import Test.Hspec spec :: Spec spec = do diff --git a/lsp/ChangeLog.md b/lsp/ChangeLog.md index fa03f3e4f..2b9ece7cf 100644 --- a/lsp/ChangeLog.md +++ b/lsp/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for lsp +## 2.0.0.0 + +* Support `lsp-types-2.0.0.0`. + ## 1.6.0.0 * Pinned to lsp-types 1.6 diff --git a/lsp/example/Reactor.hs b/lsp/example/Reactor.hs index 28d69c433..dddfa831f 100644 --- a/lsp/example/Reactor.hs +++ b/lsp/example/Reactor.hs @@ -45,8 +45,8 @@ import Language.LSP.Server import System.IO import Language.LSP.Diagnostics import Language.LSP.Logging (defaultClientLogger) -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as LSP +import qualified Language.LSP.Protocol.Message as LSP import Language.LSP.VFS import System.Exit import Control.Concurrent @@ -119,19 +119,19 @@ run = flip E.catches handlers $ do -- --------------------------------------------------------------------- -syncOptions :: J.TextDocumentSyncOptions -syncOptions = J.TextDocumentSyncOptions - { J._openClose = Just True - , J._change = Just J.TdSyncIncremental - , J._willSave = Just False - , J._willSaveWaitUntil = Just False - , J._save = Just $ J.InR $ J.SaveOptions $ Just False +syncOptions :: LSP.TextDocumentSyncOptions +syncOptions = LSP.TextDocumentSyncOptions + { LSP._openClose = Just True + , LSP._change = Just LSP.TextDocumentSyncKind_Incremental + , LSP._willSave = Just False + , LSP._willSaveWaitUntil = Just False + , LSP._save = Just $ LSP.InR $ LSP.SaveOptions $ Just False } lspOptions :: Options lspOptions = defaultOptions - { textDocumentSync = Just syncOptions - , executeCommandCommands = Just ["lsp-hello-command"] + { optTextDocumentSync = Just syncOptions + , optExecuteCommandCommands = Just ["lsp-hello-command"] } -- --------------------------------------------------------------------- @@ -145,17 +145,19 @@ newtype ReactorInput -- | Analyze the file and send any diagnostics to the client in a -- "textDocument/publishDiagnostics" notification -sendDiagnostics :: J.NormalizedUri -> Maybe Int32 -> LspM Config () +sendDiagnostics :: LSP.NormalizedUri -> Maybe Int32 -> LspM Config () sendDiagnostics fileUri version = do let - diags = [J.Diagnostic - (J.Range (J.Position 0 1) (J.Position 0 5)) - (Just J.DsWarning) -- severity + diags = [LSP.Diagnostic + (LSP.Range (LSP.Position 0 1) (LSP.Position 0 5)) + (Just LSP.DiagnosticSeverity_Warning) -- severity Nothing -- code + Nothing (Just "lsp-hello") -- source "Example diagnostic message" Nothing -- tags - (Just (J.List [])) + (Just []) + Nothing ] publishDiagnostics 100 fileUri version (partitionBySource diags) @@ -176,12 +178,12 @@ reactor logger inp = do lspHandlers :: (m ~ LspM Config) => L.LogAction m (WithSeverity T.Text) -> TChan ReactorInput -> Handlers m lspHandlers logger rin = mapHandlers goReq goNot (handle logger) where - goReq :: forall (a :: J.Method J.FromClient J.Request). Handler (LspM Config) a -> Handler (LspM Config) a + goReq :: forall (a :: LSP.Method LSP.ClientToServer LSP.Request). Handler (LspM Config) a -> Handler (LspM Config) a goReq f = \msg k -> do env <- getLspEnv liftIO $ atomically $ writeTChan rin $ ReactorAction (runLspT env $ f msg k) - goNot :: forall (a :: J.Method J.FromClient J.Notification). Handler (LspM Config) a -> Handler (LspM Config) a + goNot :: forall (a :: LSP.Method LSP.ClientToServer LSP.Notification). Handler (LspM Config) a -> Handler (LspM Config) a goNot f = \msg -> do env <- getLspEnv liftIO $ atomically $ writeTChan rin $ ReactorAction (runLspT env $ f msg) @@ -189,49 +191,49 @@ lspHandlers logger rin = mapHandlers goReq goNot (handle logger) -- | Where the actual logic resides for handling requests and notifications. handle :: (m ~ LspM Config) => L.LogAction m (WithSeverity T.Text) -> Handlers m handle logger = mconcat - [ notificationHandler J.SInitialized $ \_msg -> do + [ notificationHandler LSP.SMethod_Initialized $ \_msg -> do logger <& "Processing the Initialized notification" `WithSeverity` Info -- We're initialized! Lets send a showMessageRequest now - let params = J.ShowMessageRequestParams - J.MtWarning + let params = LSP.ShowMessageRequestParams + LSP.MessageType_Warning "What's your favourite language extension?" - (Just [J.MessageActionItem "Rank2Types", J.MessageActionItem "NPlusKPatterns"]) + (Just [LSP.MessageActionItem "Rank2Types", LSP.MessageActionItem "NPlusKPatterns"]) - void $ sendRequest J.SWindowShowMessageRequest params $ \res -> + void $ sendRequest LSP.SMethod_WindowShowMessageRequest params $ \res -> case res of Left e -> logger <& ("Got an error: " <> T.pack (show e)) `WithSeverity` Error Right _ -> do - sendNotification J.SWindowShowMessage (J.ShowMessageParams J.MtInfo "Excellent choice") + sendNotification LSP.SMethod_WindowShowMessage (LSP.ShowMessageParams LSP.MessageType_Info "Excellent choice") -- We can dynamically register a capability once the user accepts it - sendNotification J.SWindowShowMessage (J.ShowMessageParams J.MtInfo "Turning on code lenses dynamically") + sendNotification LSP.SMethod_WindowShowMessage (LSP.ShowMessageParams LSP.MessageType_Info "Turning on code lenses dynamically") - let regOpts = J.CodeLensRegistrationOptions Nothing Nothing (Just False) + let regOpts = LSP.CodeLensRegistrationOptions (LSP.InR LSP.Null) Nothing (Just False) - void $ registerCapability J.STextDocumentCodeLens regOpts $ \_req responder -> do + void $ registerCapability LSP.SMethod_TextDocumentCodeLens regOpts $ \_req responder -> do logger <& "Processing a textDocument/codeLens request" `WithSeverity` Info - let cmd = J.Command "Say hello" "lsp-hello-command" Nothing - rsp = J.List [J.CodeLens (J.mkRange 0 0 0 100) (Just cmd) Nothing] - responder (Right rsp) + let cmd = LSP.Command "Say hello" "lsp-hello-command" Nothing + rsp = [LSP.CodeLens (LSP.mkRange 0 0 0 100) (Just cmd) Nothing] + responder (Right $ LSP.InL rsp) - , notificationHandler J.STextDocumentDidOpen $ \msg -> do - let doc = msg ^. J.params . J.textDocument . J.uri - fileName = J.uriToFilePath doc + , notificationHandler LSP.SMethod_TextDocumentDidOpen $ \msg -> do + let doc = msg ^. LSP.params . LSP.textDocument . LSP.uri + fileName = LSP.uriToFilePath doc logger <& ("Processing DidOpenTextDocument for: " <> T.pack (show fileName)) `WithSeverity` Info - sendDiagnostics (J.toNormalizedUri doc) (Just 0) + sendDiagnostics (LSP.toNormalizedUri doc) (Just 0) - , notificationHandler J.SWorkspaceDidChangeConfiguration $ \msg -> do + , notificationHandler LSP.SMethod_WorkspaceDidChangeConfiguration $ \msg -> do cfg <- getConfig logger L.<& ("Configuration changed: " <> T.pack (show (msg,cfg))) `WithSeverity` Info - sendNotification J.SWindowShowMessage $ - J.ShowMessageParams J.MtInfo $ "Wibble factor set to " <> T.pack (show (wibbleFactor cfg)) - - , notificationHandler J.STextDocumentDidChange $ \msg -> do - let doc = msg ^. J.params - . J.textDocument - . J.uri - . to J.toNormalizedUri + sendNotification LSP.SMethod_WindowShowMessage $ + LSP.ShowMessageParams LSP.MessageType_Info $ "Wibble factor set to " <> T.pack (show (wibbleFactor cfg)) + + , notificationHandler LSP.SMethod_TextDocumentDidChange $ \msg -> do + let doc = msg ^. LSP.params + . LSP.textDocument + . LSP.uri + . to LSP.toNormalizedUri logger <& ("Processing DidChangeTextDocument for: " <> T.pack (show doc)) `WithSeverity` Info mdoc <- getVirtualFile doc case mdoc of @@ -240,73 +242,72 @@ handle logger = mconcat Nothing -> do logger <& ("Didn't find anything in the VFS for: " <> T.pack (show doc)) `WithSeverity` Info - , notificationHandler J.STextDocumentDidSave $ \msg -> do - let doc = msg ^. J.params . J.textDocument . J.uri - fileName = J.uriToFilePath doc + , notificationHandler LSP.SMethod_TextDocumentDidSave $ \msg -> do + let doc = msg ^. LSP.params . LSP.textDocument . LSP.uri + fileName = LSP.uriToFilePath doc logger <& ("Processing DidSaveTextDocument for: " <> T.pack (show fileName)) `WithSeverity` Info - sendDiagnostics (J.toNormalizedUri doc) Nothing + sendDiagnostics (LSP.toNormalizedUri doc) Nothing - , requestHandler J.STextDocumentRename $ \req responder -> do + , requestHandler LSP.SMethod_TextDocumentRename $ \req responder -> do logger <& "Processing a textDocument/rename request" `WithSeverity` Info - let params = req ^. J.params - J.Position l c = params ^. J.position - newName = params ^. J.newName - vdoc <- getVersionedTextDoc (params ^. J.textDocument) + let params = req ^. LSP.params + LSP.Position l c = params ^. LSP.position + newName = params ^. LSP.newName + vdoc <- getVersionedTextDoc (params ^. LSP.textDocument) -- Replace some text at the position with what the user entered - let edit = J.InL $ J.TextEdit (J.mkRange l c l (c + fromIntegral (T.length newName))) newName - tde = J.TextDocumentEdit vdoc (J.List [edit]) + let edit = LSP.InL $ LSP.TextEdit (LSP.mkRange l c l (c + fromIntegral (T.length newName))) newName + tde = LSP.TextDocumentEdit (LSP._versionedTextDocumentIdentifier # vdoc) [edit] -- "documentChanges" field is preferred over "changes" - rsp = J.WorkspaceEdit Nothing (Just (J.List [J.InL tde])) Nothing - responder (Right rsp) + rsp = LSP.WorkspaceEdit Nothing (Just [LSP.InL tde]) Nothing + responder (Right $ LSP.InL rsp) - , requestHandler J.STextDocumentHover $ \req responder -> do + , requestHandler LSP.SMethod_TextDocumentHover $ \req responder -> do logger <& "Processing a textDocument/hover request" `WithSeverity` Info - let J.HoverParams _doc pos _workDone = req ^. J.params - J.Position _l _c' = pos - rsp = J.Hover ms (Just range) - ms = J.HoverContents $ J.markedUpContent "lsp-hello" "Your type info here!" - range = J.Range pos pos - responder (Right $ Just rsp) - - , requestHandler J.STextDocumentDocumentSymbol $ \req responder -> do + let LSP.HoverParams _doc pos _workDone = req ^. LSP.params + LSP.Position _l _c' = pos + rsp = LSP.Hover ms (Just range) + ms = LSP.InL $ LSP.mkMarkdown "Your type info here!" + range = LSP.Range pos pos + responder (Right $ LSP.InL rsp) + + , requestHandler LSP.SMethod_TextDocumentDocumentSymbol $ \req responder -> do logger <& "Processing a textDocument/documentSymbol request" `WithSeverity` Info - let J.DocumentSymbolParams _ _ doc = req ^. J.params - loc = J.Location (doc ^. J.uri) (J.Range (J.Position 0 0) (J.Position 0 0)) - sym = J.SymbolInformation "lsp-hello" J.SkFunction Nothing Nothing loc Nothing - rsp = J.InR (J.List [sym]) - responder (Right rsp) + let LSP.DocumentSymbolParams _ _ doc = req ^. LSP.params + loc = LSP.Location (doc ^. LSP.uri) (LSP.Range (LSP.Position 0 0) (LSP.Position 0 0)) + rsp = [LSP.SymbolInformation "lsp-hello" LSP.SymbolKind_Function Nothing Nothing Nothing loc] + responder (Right $ LSP.InL rsp) - , requestHandler J.STextDocumentCodeAction $ \req responder -> do + , requestHandler LSP.SMethod_TextDocumentCodeAction $ \req responder -> do logger <& "Processing a textDocument/codeAction request" `WithSeverity` Info - let params = req ^. J.params - doc = params ^. J.textDocument - (J.List diags) = params ^. J.context . J.diagnostics + let params = req ^. LSP.params + doc = params ^. LSP.textDocument + diags = params ^. LSP.context . LSP.diagnostics -- makeCommand only generates commands for diagnostics whose source is us - makeCommand (J.Diagnostic (J.Range s _) _s _c (Just "lsp-hello") _m _t _l) = [J.Command title cmd cmdparams] - where - title = "Apply LSP hello command:" <> head (T.lines _m) + makeCommand d | (LSP.Range s _) <- d ^. LSP.range, (Just "lsp-hello") <- d ^. LSP.source = + let + title = "Apply LSP hello command:" <> head (T.lines $ d ^. LSP.message) -- 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.List - [ J.object [("file", J.object [("textDocument",J.toJSON doc)])] - , J.object [("start_pos",J.object [("position", J.toJSON s)])] - ] + args = [ J.object [("file", J.object [("textDocument",J.toJSON doc)])] + , J.object [("start_pos",J.object [("position", J.toJSON s)])] + ] cmdparams = Just args - makeCommand (J.Diagnostic _r _s _c _source _m _t _l) = [] - rsp = J.List $ map J.InL $ concatMap makeCommand diags - responder (Right rsp) + in [LSP.Command title cmd cmdparams] + makeCommand _ = [] + rsp = map LSP.InL $ concatMap makeCommand diags + responder (Right $ LSP.InL rsp) - , requestHandler J.SWorkspaceExecuteCommand $ \req responder -> do + , requestHandler LSP.SMethod_WorkspaceExecuteCommand $ \req responder -> do logger <& "Processing a workspace/executeCommand request" `WithSeverity` Info - let params = req ^. J.params - margs = params ^. J.arguments + let params = req ^. LSP.params + margs = params ^. LSP.arguments logger <& ("The arguments are: " <> T.pack (show margs)) `WithSeverity` Debug - responder (Right (J.Object mempty)) -- respond to the request + responder (Right $ LSP.InL (J.Object mempty)) -- respond to the request void $ withProgress "Executing some long running command" Cancellable $ \update -> - forM [(0 :: J.UInt)..10] $ \i -> do + forM [(0 :: LSP.UInt)..10] $ \i -> do update (ProgressAmount (Just (i * 10)) (Just "Doing stuff")) liftIO $ threadDelay (1 * 1000000) ] diff --git a/lsp/example/Simple.hs b/lsp/example/Simple.hs index f05eac06f..e833a5d25 100644 --- a/lsp/example/Simple.hs +++ b/lsp/example/Simple.hs @@ -1,37 +1,39 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DuplicateRecordFields #-} import Language.LSP.Server -import Language.LSP.Types +import Language.LSP.Protocol.Types hiding (range) +import Language.LSP.Protocol.Message hiding (params) import Control.Monad.IO.Class import qualified Data.Text as T handlers :: Handlers (LspM ()) handlers = mconcat - [ notificationHandler SInitialized $ \_not -> do - let params = ShowMessageRequestParams MtInfo "Turn on code lenses?" + [ notificationHandler SMethod_Initialized $ \_not -> do + let params = ShowMessageRequestParams MessageType_Info "Turn on code lenses?" (Just [MessageActionItem "Turn on", MessageActionItem "Don't"]) - _ <- sendRequest SWindowShowMessageRequest params $ \case - Right (Just (MessageActionItem "Turn on")) -> do - let regOpts = CodeLensRegistrationOptions Nothing Nothing (Just False) + _ <- sendRequest SMethod_WindowShowMessageRequest params $ \case + Right (InL (MessageActionItem "Turn on")) -> do + let regOpts = CodeLensRegistrationOptions (InR Null) Nothing (Just False) - _ <- registerCapability STextDocumentCodeLens regOpts $ \_req responder -> do + _ <- registerCapability SMethod_TextDocumentCodeLens regOpts $ \_req responder -> do let cmd = Command "Say hello" "lsp-hello-command" Nothing - rsp = List [CodeLens (mkRange 0 0 0 100) (Just cmd) Nothing] - responder (Right rsp) + rsp = [CodeLens (mkRange 0 0 0 100) (Just cmd) Nothing] + responder $ Right $ InL rsp pure () Right _ -> - sendNotification SWindowShowMessage (ShowMessageParams MtInfo "Not turning on code lenses") + sendNotification SMethod_WindowShowMessage (ShowMessageParams MessageType_Info "Not turning on code lenses") Left err -> - sendNotification SWindowShowMessage (ShowMessageParams MtError $ "Something went wrong!\n" <> T.pack (show err)) + sendNotification SMethod_WindowShowMessage (ShowMessageParams MessageType_Error $ "Something went wrong!\n" <> T.pack (show err)) pure () - , requestHandler STextDocumentHover $ \req responder -> do - let RequestMessage _ _ _ (HoverParams _doc pos _workDone) = req + , requestHandler SMethod_TextDocumentHover $ \req responder -> do + let TRequestMessage _ _ _ (HoverParams _doc pos _workDone) = req Position _l _c' = pos - rsp = Hover ms (Just range) - ms = HoverContents $ markedUpContent "lsp-demo-simple-server" "Hello world" + rsp = Hover (InL ms) (Just range) + ms = mkMarkdown "Hello world" range = Range pos pos - responder (Right $ Just rsp) + responder (Right $ InL rsp) ] main :: IO Int diff --git a/lsp/lsp.cabal b/lsp/lsp.cabal index da3bb1a8a..0900ae4f8 100644 --- a/lsp/lsp.cabal +++ b/lsp/lsp.cabal @@ -1,122 +1,139 @@ -cabal-version: 2.2 -name: lsp -version: 1.6.0.0 -synopsis: Haskell library for the Microsoft Language Server Protocol +cabal-version: 2.2 +name: lsp +version: 2.0.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 Language + Server, at https://github.com/haskell/haskell-language-server -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 Language - Server, at https://github.com/haskell/haskell-language-server +homepage: https://github.com/haskell/lsp +license: MIT +license-file: LICENSE +author: Alan Zimmerman +maintainer: alan.zimm@gmail.com +copyright: Alan Zimmerman, 2016-2021 +category: Development +build-type: Simple +extra-source-files: + ChangeLog.md + README.md -homepage: https://github.com/haskell/lsp -license: MIT -license-file: LICENSE -author: Alan Zimmerman -maintainer: alan.zimm@gmail.com -copyright: Alan Zimmerman, 2016-2021 -category: Development -build-type: Simple -extra-source-files: ChangeLog.md, README.md +source-repository head + type: git + location: https://github.com/haskell/lsp library - reexported-modules: Language.LSP.Types - , Language.LSP.Types.Capabilities - , Language.LSP.Types.Lens - exposed-modules: Language.LSP.Server - , Language.LSP.Diagnostics - , Language.LSP.Logging - , Language.LSP.VFS - other-modules: Language.LSP.Server.Core - , Language.LSP.Server.Control - , Language.LSP.Server.Processing - ghc-options: -Wall - build-depends: base >= 4.11 && < 5 - , async >= 2.0 - , aeson >=1.0.0.0 - , attoparsec - , bytestring - , containers - , co-log-core >= 0.3.1.0 - , data-default - , directory - , exceptions - , filepath - , hashable - , lsp-types == 1.6.* - , lens >= 4.15.2 - , mtl < 2.4 - , prettyprinter - , sorted-list == 0.2.1.* - , stm == 2.5.* - , temporary - , text - , text-rope - , transformers >= 0.5.6 && < 0.7 - , unordered-containers - , unliftio-core >= 0.2.0.0 - -- used for generating random uuids for dynamic registration - , random - , uuid-types >= 1.0.5 - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall -fprint-explicit-kinds + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall -fprint-explicit-kinds + + reexported-modules: + Language.LSP.Protocol.Types + , Language.LSP.Protocol.Capabilities + , Language.LSP.Protocol.Message + + exposed-modules: + Language.LSP.Diagnostics + Language.LSP.Logging + Language.LSP.Server + Language.LSP.VFS + + other-modules: + Language.LSP.Server.Control + Language.LSP.Server.Core + Language.LSP.Server.Processing + + ghc-options: -Wall + build-depends: + , aeson >=1.0.0.0 + , async >=2.0 + , attoparsec + , base >=4.11 && <5 + , bytestring + , co-log-core >=0.3.1.0 + , containers + , data-default + , directory + , exceptions + , filepath + , hashable + , lens >=4.15.2 + , lsp-types ^>=2.0 + , mtl <2.4 + , prettyprinter + , random + , row-types + , sorted-list ^>=0.2.1 + , stm ^>=2.5 + , temporary + , text + , text-rope + , transformers >=0.5.6 && <0.7 + , unliftio-core >=0.2.0.0 + , unordered-containers + , uuid >=1.3 executable lsp-demo-reactor-server - main-is: Reactor.hs - hs-source-dirs: example - default-language: Haskell2010 - ghc-options: -Wall -Wno-unticked-promoted-constructors + main-is: Reactor.hs + hs-source-dirs: example + default-language: Haskell2010 + ghc-options: -Wall -Wno-unticked-promoted-constructors + build-depends: + , aeson + , base + , co-log-core + , lens >=4.15.2 + , lsp + , prettyprinter + , stm + , text - build-depends: base - , aeson - , co-log-core - , lens >= 4.15.2 - , stm - , prettyprinter - , text - -- the package library. Comment this out if you want repl changes to propagate - , lsp + -- the package library. Comment this out if you want repl changes to propagate if !flag(demo) - buildable: False + buildable: False executable lsp-demo-simple-server - main-is: Simple.hs - hs-source-dirs: example - default-language: Haskell2010 - ghc-options: -Wall -Wno-unticked-promoted-constructors - build-depends: base - -- the package library. Comment this out if you want repl changes to propagate - , lsp - , text + main-is: Simple.hs + hs-source-dirs: example + default-language: Haskell2010 + ghc-options: -Wall -Wno-unticked-promoted-constructors + build-depends: + , base + , lsp + , text + + -- the package library. Comment this out if you want repl changes to propagate if !flag(demo) - buildable: False + buildable: False flag demo description: Build the demo executables default: False - test-suite lsp-test - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Main.hs - other-modules: Spec - DiagnosticsSpec - VspSpec - build-depends: base - , containers - , lsp - , hspec - , sorted-list == 0.2.1.* - , text - , text-rope - , unordered-containers - build-tool-depends: hspec-discover:hspec-discover - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall - default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + other-modules: + DiagnosticsSpec + Spec + VspSpec -source-repository head - type: git - location: https://github.com/haskell/lsp + build-depends: + , base + , containers + , hspec + , lsp + , row-types + , sorted-list >=0.2.1 && <0.2.2 + , text + , text-rope + , unordered-containers + + build-tool-depends: hspec-discover:hspec-discover + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + default-language: Haskell2010 diff --git a/lsp/src/Language/LSP/Diagnostics.hs b/lsp/src/Language/LSP/Diagnostics.hs index 5fc24ef02..7b6c278b7 100644 --- a/lsp/src/Language/LSP/Diagnostics.hs +++ b/lsp/src/Language/LSP/Diagnostics.hs @@ -23,7 +23,8 @@ module Language.LSP.Diagnostics import qualified Data.SortedList as SL import qualified Data.Map.Strict as Map import qualified Data.HashMap.Strict as HM -import qualified Language.LSP.Types as J +import Data.Text (Text) +import qualified Language.LSP.Protocol.Types as J -- --------------------------------------------------------------------- {-# ANN module ("hlint: ignore Eta reduce" :: String) #-} @@ -33,9 +34,9 @@ import qualified Language.LSP.Types as J {- We need a three level store - Uri : Maybe TextDocumentVersion : Maybe DiagnosticSource : [Diagnostics] + Uri : Maybe Int32 : Maybe DiagnosticSource : [Diagnostics] -For a given Uri, as soon as we see a new (Maybe TextDocumentVersion) we flush +For a given Uri, as soon as we see a new (Maybe Int32) we flush all prior entries for the Uri. -} @@ -43,10 +44,10 @@ all prior entries for the Uri. type DiagnosticStore = HM.HashMap J.NormalizedUri StoreItem data StoreItem - = StoreItem J.TextDocumentVersion DiagnosticsBySource + = StoreItem (Maybe J.Int32) DiagnosticsBySource deriving (Show,Eq) -type DiagnosticsBySource = Map.Map (Maybe J.DiagnosticSource) (SL.SortedList J.Diagnostic) +type DiagnosticsBySource = Map.Map (Maybe Text) (SL.SortedList J.Diagnostic) -- --------------------------------------------------------------------- @@ -55,7 +56,7 @@ partitionBySource diags = Map.fromListWith mappend $ map (\d -> (J._source d, (S -- --------------------------------------------------------------------- -flushBySource :: DiagnosticStore -> Maybe J.DiagnosticSource -> DiagnosticStore +flushBySource :: DiagnosticStore -> Maybe Text -> DiagnosticStore flushBySource store Nothing = store flushBySource store (Just source) = HM.map remove store where @@ -64,7 +65,7 @@ flushBySource store (Just source) = HM.map remove store -- --------------------------------------------------------------------- updateDiagnostics :: DiagnosticStore - -> J.NormalizedUri -> J.TextDocumentVersion -> DiagnosticsBySource + -> J.NormalizedUri -> Maybe J.Int32 -> DiagnosticsBySource -> DiagnosticStore updateDiagnostics store uri mv newDiagsBySource = r where @@ -92,6 +93,6 @@ getDiagnosticParamsFor maxDiagnostics ds uri = case HM.lookup uri ds of Nothing -> Nothing Just (StoreItem mv diags) -> - Just $ J.PublishDiagnosticsParams (J.fromNormalizedUri uri) (fmap fromIntegral mv) (J.List (take maxDiagnostics $ SL.fromSortedList $ mconcat $ Map.elems diags)) + Just $ J.PublishDiagnosticsParams (J.fromNormalizedUri uri) (fmap fromIntegral mv) (take maxDiagnostics $ SL.fromSortedList $ mconcat $ Map.elems diags) -- --------------------------------------------------------------------- diff --git a/lsp/src/Language/LSP/Logging.hs b/lsp/src/Language/LSP/Logging.hs index 2fb2d3dae..e522a2d4b 100644 --- a/lsp/src/Language/LSP/Logging.hs +++ b/lsp/src/Language/LSP/Logging.hs @@ -3,27 +3,28 @@ module Language.LSP.Logging (logToShowMessage, logToLogMessage, defaultClientLog import Colog.Core import Language.LSP.Server.Core -import Language.LSP.Types +import Language.LSP.Protocol.Types +import Language.LSP.Protocol.Message import Data.Text (Text) logSeverityToMessageType :: Severity -> MessageType logSeverityToMessageType sev = case sev of - Error -> MtError - Warning -> MtWarning - Info -> MtInfo - Debug -> MtLog + Error -> MessageType_Error + Warning -> MessageType_Warning + Info -> MessageType_Info + Debug -> MessageType_Log -- | Logs messages to the client via @window/logMessage@. logToLogMessage :: (MonadLsp c m) => LogAction m (WithSeverity Text) logToLogMessage = LogAction $ \(WithSeverity msg sev) -> do sendToClient $ fromServerNot $ - NotificationMessage "2.0" SWindowLogMessage (LogMessageParams (logSeverityToMessageType sev) msg) + TNotificationMessage "2.0" SMethod_WindowLogMessage (LogMessageParams (logSeverityToMessageType sev) msg) -- | Logs messages to the client via @window/showMessage@. logToShowMessage :: (MonadLsp c m) => LogAction m (WithSeverity Text) logToShowMessage = LogAction $ \(WithSeverity msg sev) -> do sendToClient $ fromServerNot $ - NotificationMessage "2.0" SWindowShowMessage (ShowMessageParams (logSeverityToMessageType sev) msg) + TNotificationMessage "2.0" SMethod_WindowShowMessage (ShowMessageParams (logSeverityToMessageType sev) msg) -- | A 'sensible' log action for logging messages to the client: -- diff --git a/lsp/src/Language/LSP/Server/Control.hs b/lsp/src/Language/LSP/Server/Control.hs index 6b1bb6f20..47413d602 100644 --- a/lsp/src/Language/LSP/Server/Control.hs +++ b/lsp/src/Language/LSP/Server/Control.hs @@ -20,7 +20,6 @@ import qualified Colog.Core as L import Colog.Core (LogAction (..), WithSeverity (..), Severity (..), (<&)) import Control.Concurrent import Control.Concurrent.STM.TChan -import Control.Applicative((<|>)) import Control.Monad import Control.Monad.STM import Control.Monad.IO.Class @@ -38,7 +37,7 @@ import Data.Text.Prettyprint.Doc import Data.List import Language.LSP.Server.Core import qualified Language.LSP.Server.Processing as Processing -import Language.LSP.Types +import Language.LSP.Protocol.Message import Language.LSP.VFS import Language.LSP.Logging (defaultClientLogger) import System.IO @@ -187,23 +186,10 @@ ioLoop ioLogger logger clientIn serverDefinition vfs sendMsg = do go (parse parser remainder) parser = do - try contentType <|> (return ()) - len <- contentLength - try contentType <|> (return ()) - _ <- string _ONE_CRLF - Attoparsec.take len - - contentLength = do _ <- string "Content-Length: " len <- decimal - _ <- string _ONE_CRLF - return len - - contentType = do - _ <- string "Content-Type: " - skipWhile (/='\r') - _ <- string _ONE_CRLF - return () + _ <- string _TWO_CRLF + Attoparsec.take len parseOne :: MonadIO m @@ -250,8 +236,6 @@ sendServer logger msgChan clientOut = do -- | -- -- -_ONE_CRLF :: BS.ByteString -_ONE_CRLF = "\r\n" _TWO_CRLF :: BS.ByteString _TWO_CRLF = "\r\n\r\n" diff --git a/lsp/src/Language/LSP/Server/Core.hs b/lsp/src/Language/LSP/Server/Core.hs index 56a44ffc2..efdcfe0de 100644 --- a/lsp/src/Language/LSP/Server/Core.hs +++ b/lsp/src/Language/LSP/Server/Core.hs @@ -41,16 +41,18 @@ import qualified Data.List as L import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map.Strict as Map import Data.Maybe +import Data.Row import Data.Monoid (Ap(..)) import Data.Ord (Down (Down)) import qualified Data.Text as T import Data.Text ( Text ) -import qualified Data.UUID.Types as UUID -import qualified Language.LSP.Types.Capabilities as J -import Language.LSP.Types as J -import Language.LSP.Types.SMethodMap (SMethodMap) -import qualified Language.LSP.Types.SMethodMap as SMethodMap -import qualified Language.LSP.Types.Lens as J +import qualified Data.UUID as UUID +import Language.LSP.Protocol.Types hiding (success, uri, method, title, cancellable, percentage, version, edits) +import Language.LSP.Protocol.Message hiding (error, params) +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Message as J +import Language.LSP.Protocol.Utils.SMethodMap (SMethodMap) +import qualified Language.LSP.Protocol.Utils.SMethodMap as SMethodMap import Language.LSP.VFS import Language.LSP.Diagnostics import System.Random hiding (next) @@ -114,8 +116,8 @@ data LanguageContextEnv config = -- -- @ -- mconcat [ --- notificationHandler SInitialized $ \\notif -> pure () --- , requestHandler STextDocumentHover $ \\req responder -> pure () +-- notificationHandler SInitialized $ \notif -> pure () +-- , requestHandler STextDocumentHover $ \req responder -> pure () -- ] -- @ data Handlers m @@ -128,20 +130,20 @@ instance Semigroup (Handlers config) where instance Monoid (Handlers config) where mempty = Handlers mempty mempty -notificationHandler :: forall (m :: Method FromClient Notification) f. SMethod m -> Handler f m -> Handlers f +notificationHandler :: forall (m :: Method ClientToServer Notification) f. SMethod m -> Handler f m -> Handlers f notificationHandler m h = Handlers mempty (SMethodMap.singleton m (ClientMessageHandler h)) -requestHandler :: forall (m :: Method FromClient Request) f. SMethod m -> Handler f m -> Handlers f +requestHandler :: forall (m :: Method ClientToServer Request) f. SMethod m -> Handler f m -> Handlers f requestHandler m h = Handlers (SMethodMap.singleton m (ClientMessageHandler h)) mempty --- | Wrapper to restrict 'Handler's to 'FromClient' 'Method's -newtype ClientMessageHandler f (t :: MethodType) (m :: Method FromClient t) = ClientMessageHandler (Handler f m) +-- | Wrapper to restrict 'Handler's to ClientToServer' 'Method's +newtype ClientMessageHandler f (t :: MessageKind) (m :: Method ClientToServer t) = ClientMessageHandler (Handler f m) -- | The type of a handler that handles requests and notifications coming in -- from the server or client type family Handler (f :: Type -> Type) (m :: Method from t) = (result :: Type) | result -> f t m where - Handler f (m :: Method _from Request) = RequestMessage m -> (Either ResponseError (ResponseResult m) -> f ()) -> f () - Handler f (m :: Method _from Notification) = NotificationMessage m -> f () + Handler f (m :: Method _from Request) = TRequestMessage m -> (Either (TResponseError m) (MessageResult m) -> f ()) -> f () + Handler f (m :: Method _from Notification) = TNotificationMessage m -> f () -- | How to convert two isomorphic data structures between each other. data m <~> n @@ -154,8 +156,8 @@ transmuteHandlers :: (m <~> n) -> Handlers m -> Handlers n transmuteHandlers nat = mapHandlers (\i m k -> forward nat (i m (backward nat . k))) (\i m -> forward nat (i m)) mapHandlers - :: (forall (a :: Method FromClient Request). Handler m a -> Handler n a) - -> (forall (a :: Method FromClient Notification). Handler m a -> Handler n a) + :: (forall (a :: Method ClientToServer Request). Handler m a -> Handler n a) + -> (forall (a :: Method ClientToServer Notification). Handler m a -> Handler n a) -> Handlers m -> Handlers n mapHandlers mapReq mapNot (Handlers reqs nots) = Handlers reqs' nots' where @@ -178,10 +180,10 @@ data LanguageContextState config = type ResponseMap = IxMap LspId (Product SMethod ServerResponseCallback) -type RegistrationMap (t :: MethodType) = SMethodMap (Product RegistrationId (ClientMessageHandler IO t)) +type RegistrationMap (t :: MessageKind) = SMethodMap (Product RegistrationId (ClientMessageHandler IO t)) -data RegistrationToken (m :: Method FromClient t) = RegistrationToken (SMethod m) (RegistrationId m) -newtype RegistrationId (m :: Method FromClient t) = RegistrationId Text +data RegistrationToken (m :: Method ClientToServer t) = RegistrationToken (SMethod m) (RegistrationId m) +newtype RegistrationId (m :: Method ClientToServer t) = RegistrationId Text deriving Eq data ProgressData = ProgressData { progressNextId :: !(TVar Int32) @@ -217,32 +219,32 @@ getsState f = do -- If you set handlers for some requests, you may need to set some of these options. data Options = Options - { textDocumentSync :: Maybe J.TextDocumentSyncOptions + { optTextDocumentSync :: Maybe J.TextDocumentSyncOptions -- | The characters that trigger completion automatically. - , completionTriggerCharacters :: Maybe [Char] + , optCompletionTriggerCharacters :: Maybe [Char] -- | The list of all possible characters that commit a completion. This field can be used -- if clients don't support individual commit characters per completion item. See -- `_commitCharactersSupport`. - , completionAllCommitCharacters :: Maybe [Char] + , optCompletionAllCommitCharacters :: Maybe [Char] -- | The characters that trigger signature help automatically. - , signatureHelpTriggerCharacters :: Maybe [Char] + , optSignatureHelpTriggerCharacters :: Maybe [Char] -- | List of characters that re-trigger signature help. -- These trigger characters are only active when signature help is already showing. All trigger characters -- are also counted as re-trigger characters. - , signatureHelpRetriggerCharacters :: Maybe [Char] + , optSignatureHelpRetriggerCharacters :: Maybe [Char] -- | CodeActionKinds that this server may return. -- The list of kinds may be generic, such as `CodeActionKind.Refactor`, or the server -- may list out every specific kind they provide. - , codeActionKinds :: Maybe [CodeActionKind] + , optCodeActionKinds :: Maybe [CodeActionKind] -- | The list of characters that triggers on type formatting. -- If you set `documentOnTypeFormattingHandler`, you **must** set this. -- The first character is mandatory, so a 'NonEmpty' should be passed. - , documentOnTypeFormattingTriggerCharacters :: Maybe (NonEmpty Char) + , optDocumentOnTypeFormattingTriggerCharacters :: Maybe (NonEmpty Char) -- | The commands to be executed on the server. -- If you set `executeCommandHandler`, you **must** set this. - , executeCommandCommands :: Maybe [Text] + , optExecuteCommandCommands :: Maybe [Text] -- | Information about the server that can be advertised to the client. - , serverInfo :: Maybe J.ServerInfo + , optServerInfo :: Maybe (Rec ("name" .== Text .+ "version" .== Maybe Text)) } instance Default Options where @@ -285,7 +287,7 @@ data ServerDefinition config = forall m a. -- indicating what went wrong. The parsed configuration object will be -- stored internally and can be accessed via 'config'. -- It is also called on the `initializationOptions` field of the InitializeParams - , doInitialize :: LanguageContextEnv config -> Message Initialize -> IO (Either ResponseError a) + , doInitialize :: LanguageContextEnv config -> TMessage Method_Initialize -> IO (Either (TResponseError Method_Initialize) a) -- ^ Called *after* receiving the @initialize@ request and *before* -- returning the response. This callback will be invoked to offer the -- language server implementation the chance to create any processes or @@ -316,8 +318,8 @@ data ServerDefinition config = forall m a. -- | A function that a 'Handler' is passed that can be used to respond to a -- request with either an error, or the response params. -newtype ServerResponseCallback (m :: Method FromServer Request) - = ServerResponseCallback (Either ResponseError (ResponseResult m) -> IO ()) +newtype ServerResponseCallback (m :: Method ServerToClient Request) + = ServerResponseCallback (Either (TResponseError m) (MessageResult m) -> IO ()) -- | Return value signals if response handler was inserted successfully -- Might fail if the id was already in the map @@ -329,20 +331,20 @@ addResponseHandler lid h = do Nothing -> (False, pending) sendNotification - :: forall (m :: Method FromServer Notification) f config. MonadLsp config f + :: forall (m :: Method ServerToClient Notification) f config. MonadLsp config f => SServerMethod m -> MessageParams m -> f () sendNotification m params = - let msg = NotificationMessage "2.0" m params + let msg = TNotificationMessage "2.0" m params in case splitServerMethod m of IsServerNot -> sendToClient $ fromServerNot msg IsServerEither -> sendToClient $ FromServerMess m $ NotMess msg -sendRequest :: forall (m :: Method FromServer Request) f config. MonadLsp config f +sendRequest :: forall (m :: Method ServerToClient Request) f config. MonadLsp config f => SServerMethod m -> MessageParams m - -> (Either ResponseError (ResponseResult m) -> f ()) + -> (Either (TResponseError m) (MessageResult m) -> f ()) -> f (LspId m) sendRequest m params resHandler = do reqId <- IdInt <$> freshLspId @@ -350,7 +352,7 @@ sendRequest m params resHandler = do success <- addResponseHandler reqId (Pair m (ServerResponseCallback (rio . resHandler))) unless success $ error "LSP: could not send FromServer request as id is reused" - let msg = RequestMessage "2.0" reqId m params + let msg = TRequestMessage "2.0" reqId m params ~() <- case splitServerMethod m of IsServerReq -> sendToClient $ fromServerReq msg IsServerEither -> sendToClient $ FromServerMess m $ ReqMess msg @@ -403,8 +405,8 @@ getVersionedTextDoc doc = do let uri = doc ^. J.uri mvf <- getVirtualFile (toNormalizedUri uri) let ver = case mvf of - Just (VirtualFile lspver _ _) -> Just lspver - Nothing -> Nothing + Just (VirtualFile lspver _ _) -> lspver + Nothing -> 0 return (VersionedTextDocumentIdentifier uri ver) {-# INLINE getVersionedTextDoc #-} @@ -467,10 +469,7 @@ getRootPath = resRootPath <$> getLspEnv getWorkspaceFolders :: MonadLsp config m => m (Maybe [WorkspaceFolder]) getWorkspaceFolders = do clientCaps <- getClientCapabilities - let clientSupportsWfs = fromMaybe False $ do - let (J.ClientCapabilities mw _ _ _ _) = clientCaps - (J.WorkspaceClientCapabilities _ _ _ _ _ _ mwf _ _) <- mw - mwf + let clientSupportsWfs = fromMaybe False $ clientCaps ^? workspace . _Just . workspaceFolders . _Just if clientSupportsWfs then Just <$> getsState resWorkspaceFolders else pure Nothing @@ -481,7 +480,7 @@ getWorkspaceFolders = do -- a 'Method' with a 'Handler'. Returns 'Nothing' if the client does not -- support dynamic registration for the specified method, otherwise a -- 'RegistrationToken' which can be used to unregister it later. -registerCapability :: forall f t (m :: Method FromClient t) config. +registerCapability :: forall f t (m :: Method ClientToServer t) config. MonadLsp config f => SClientMethod m -> RegistrationOptions m @@ -503,8 +502,8 @@ registerCapability method regOpts f = do -- First, check to see if the client supports dynamic registration on this method | dynamicSupported clientCaps = do uuid <- liftIO $ UUID.toText <$> getStdRandom random - let registration = J.Registration uuid method (Just regOpts) - params = J.RegistrationParams (J.List [J.SomeRegistration registration]) + let registration = J.TRegistration uuid method (Just regOpts) + params = J.RegistrationParams [toUntypedRegistration registration] regId = RegistrationId uuid rio <- askUnliftIO ~() <- case splitClientMethod method of @@ -517,7 +516,7 @@ registerCapability method regOpts f = do IsClientEither -> error "Cannot register capability for custom methods" -- TODO: handle the scenario where this returns an error - _ <- sendRequest SClientRegisterCapability params $ \_res -> pure () + _ <- sendRequest SMethod_ClientRegisterCapability params $ \_res -> pure () pure (Just (RegistrationToken method regId)) | otherwise = pure Nothing @@ -530,37 +529,37 @@ registerCapability method regOpts f = do -- | Checks if client capabilities declares that the method supports dynamic registration dynamicSupported clientCaps = case method of - SWorkspaceDidChangeConfiguration -> capDyn $ clientCaps ^? J.workspace . _Just . J.didChangeConfiguration . _Just - SWorkspaceDidChangeWatchedFiles -> capDyn $ clientCaps ^? J.workspace . _Just . J.didChangeWatchedFiles . _Just - SWorkspaceSymbol -> capDyn $ clientCaps ^? J.workspace . _Just . J.symbol . _Just - SWorkspaceExecuteCommand -> capDyn $ clientCaps ^? J.workspace . _Just . J.executeCommand . _Just - STextDocumentDidOpen -> capDyn $ clientCaps ^? J.textDocument . _Just . J.synchronization . _Just - STextDocumentDidChange -> capDyn $ clientCaps ^? J.textDocument . _Just . J.synchronization . _Just - STextDocumentDidClose -> capDyn $ clientCaps ^? J.textDocument . _Just . J.synchronization . _Just - STextDocumentCompletion -> capDyn $ clientCaps ^? J.textDocument . _Just . J.completion . _Just - STextDocumentHover -> capDyn $ clientCaps ^? J.textDocument . _Just . J.hover . _Just - STextDocumentSignatureHelp -> capDyn $ clientCaps ^? J.textDocument . _Just . J.signatureHelp . _Just - STextDocumentDeclaration -> capDyn $ clientCaps ^? J.textDocument . _Just . J.declaration . _Just - STextDocumentDefinition -> capDyn $ clientCaps ^? J.textDocument . _Just . J.definition . _Just - STextDocumentTypeDefinition -> capDyn $ clientCaps ^? J.textDocument . _Just . J.typeDefinition . _Just - STextDocumentImplementation -> capDyn $ clientCaps ^? J.textDocument . _Just . J.implementation . _Just - STextDocumentReferences -> capDyn $ clientCaps ^? J.textDocument . _Just . J.references . _Just - STextDocumentDocumentHighlight -> capDyn $ clientCaps ^? J.textDocument . _Just . J.documentHighlight . _Just - STextDocumentDocumentSymbol -> capDyn $ clientCaps ^? J.textDocument . _Just . J.documentSymbol . _Just - STextDocumentCodeAction -> capDyn $ clientCaps ^? J.textDocument . _Just . J.codeAction . _Just - STextDocumentCodeLens -> capDyn $ clientCaps ^? J.textDocument . _Just . J.codeLens . _Just - STextDocumentDocumentLink -> capDyn $ clientCaps ^? J.textDocument . _Just . J.documentLink . _Just - STextDocumentDocumentColor -> capDyn $ clientCaps ^? J.textDocument . _Just . J.colorProvider . _Just - STextDocumentColorPresentation -> capDyn $ clientCaps ^? J.textDocument . _Just . J.colorProvider . _Just - STextDocumentFormatting -> capDyn $ clientCaps ^? J.textDocument . _Just . J.formatting . _Just - STextDocumentRangeFormatting -> capDyn $ clientCaps ^? J.textDocument . _Just . J.rangeFormatting . _Just - STextDocumentOnTypeFormatting -> capDyn $ clientCaps ^? J.textDocument . _Just . J.onTypeFormatting . _Just - STextDocumentRename -> capDyn $ clientCaps ^? J.textDocument . _Just . J.rename . _Just - STextDocumentFoldingRange -> capDyn $ clientCaps ^? J.textDocument . _Just . J.foldingRange . _Just - STextDocumentSelectionRange -> capDyn $ clientCaps ^? J.textDocument . _Just . J.selectionRange . _Just - STextDocumentPrepareCallHierarchy -> capDyn $ clientCaps ^? J.textDocument . _Just . J.callHierarchy . _Just - STextDocumentSemanticTokens -> capDyn $ clientCaps ^? J.textDocument . _Just . J.semanticTokens . _Just - _ -> False + SMethod_WorkspaceDidChangeConfiguration -> capDyn $ clientCaps ^? J.workspace . _Just . J.didChangeConfiguration . _Just + SMethod_WorkspaceDidChangeWatchedFiles -> capDyn $ clientCaps ^? J.workspace . _Just . J.didChangeWatchedFiles . _Just + SMethod_WorkspaceSymbol -> capDyn $ clientCaps ^? J.workspace . _Just . J.symbol . _Just + SMethod_WorkspaceExecuteCommand -> capDyn $ clientCaps ^? J.workspace . _Just . J.executeCommand . _Just + SMethod_TextDocumentDidOpen -> capDyn $ clientCaps ^? J.textDocument . _Just . J.synchronization . _Just + SMethod_TextDocumentDidChange -> capDyn $ clientCaps ^? J.textDocument . _Just . J.synchronization . _Just + SMethod_TextDocumentDidClose -> capDyn $ clientCaps ^? J.textDocument . _Just . J.synchronization . _Just + SMethod_TextDocumentCompletion -> capDyn $ clientCaps ^? J.textDocument . _Just . J.completion . _Just + SMethod_TextDocumentHover -> capDyn $ clientCaps ^? J.textDocument . _Just . J.hover . _Just + SMethod_TextDocumentSignatureHelp -> capDyn $ clientCaps ^? J.textDocument . _Just . J.signatureHelp . _Just + SMethod_TextDocumentDeclaration -> capDyn $ clientCaps ^? J.textDocument . _Just . J.declaration . _Just + SMethod_TextDocumentDefinition -> capDyn $ clientCaps ^? J.textDocument . _Just . J.definition . _Just + SMethod_TextDocumentTypeDefinition -> capDyn $ clientCaps ^? J.textDocument . _Just . J.typeDefinition . _Just + SMethod_TextDocumentImplementation -> capDyn $ clientCaps ^? J.textDocument . _Just . J.implementation . _Just + SMethod_TextDocumentReferences -> capDyn $ clientCaps ^? J.textDocument . _Just . J.references . _Just + SMethod_TextDocumentDocumentHighlight -> capDyn $ clientCaps ^? J.textDocument . _Just . J.documentHighlight . _Just + SMethod_TextDocumentDocumentSymbol -> capDyn $ clientCaps ^? J.textDocument . _Just . J.documentSymbol . _Just + SMethod_TextDocumentCodeAction -> capDyn $ clientCaps ^? J.textDocument . _Just . J.codeAction . _Just + SMethod_TextDocumentCodeLens -> capDyn $ clientCaps ^? J.textDocument . _Just . J.codeLens . _Just + SMethod_TextDocumentDocumentLink -> capDyn $ clientCaps ^? J.textDocument . _Just . J.documentLink . _Just + SMethod_TextDocumentDocumentColor -> capDyn $ clientCaps ^? J.textDocument . _Just . J.colorProvider . _Just + SMethod_TextDocumentColorPresentation -> capDyn $ clientCaps ^? J.textDocument . _Just . J.colorProvider . _Just + SMethod_TextDocumentFormatting -> capDyn $ clientCaps ^? J.textDocument . _Just . J.formatting . _Just + SMethod_TextDocumentRangeFormatting -> capDyn $ clientCaps ^? J.textDocument . _Just . J.rangeFormatting . _Just + SMethod_TextDocumentOnTypeFormatting -> capDyn $ clientCaps ^? J.textDocument . _Just . J.onTypeFormatting . _Just + SMethod_TextDocumentRename -> capDyn $ clientCaps ^? J.textDocument . _Just . J.rename . _Just + SMethod_TextDocumentFoldingRange -> capDyn $ clientCaps ^? J.textDocument . _Just . J.foldingRange . _Just + SMethod_TextDocumentSelectionRange -> capDyn $ clientCaps ^? J.textDocument . _Just . J.selectionRange . _Just + SMethod_TextDocumentPrepareCallHierarchy -> capDyn $ clientCaps ^? J.textDocument . _Just . J.callHierarchy . _Just + --SMethod_TextDocumentSemanticTokens -> capDyn $ clientCaps ^? J.textDocument . _Just . J.semanticTokens . _Just + _ -> False -- | Sends a @client/unregisterCapability@ request and removes the handler -- for that associated registration. @@ -571,9 +570,9 @@ unregisterCapability (RegistrationToken m (RegistrationId uuid)) = do IsClientNot -> modifyState resRegistrationsNot $ SMethodMap.delete m IsClientEither -> error "Cannot unregister capability for custom methods" - let unregistration = J.Unregistration uuid (J.SomeClientMethod m) - params = J.UnregistrationParams (J.List [unregistration]) - void $ sendRequest SClientUnregisterCapability params $ \_res -> pure () + let unregistration = J.TUnregistration uuid m + params = J.UnregistrationParams [toUntypedUnregistration unregistration] + void $ sendRequest SMethod_ClientUnregisterCapability params $ \_res -> pure () -------------------------------------------------------------------------------- -- PROGRESS @@ -594,7 +593,7 @@ getNewProgressId :: MonadLsp config m => m ProgressToken getNewProgressId = do stateState (progressNextId . resProgressData) $ \cur -> let !next = cur+1 - in (ProgressNumericToken cur, next) + in (J.ProgressToken $ J.InL cur, next) {-# INLINE getNewProgressId #-} @@ -613,25 +612,25 @@ withProgressBase indefinite title cancellable f = do -- Create progress token -- FIXME : This needs to wait until the request returns before -- continuing!!! - _ <- sendRequest SWindowWorkDoneProgressCreate + _ <- sendRequest SMethod_WindowWorkDoneProgressCreate (WorkDoneProgressCreateParams progId) $ \res -> do case res of -- An error occurred when the client was setting it up -- No need to do anything then, as per the spec Left _err -> pure () - Right Empty -> pure () + Right _ -> pure () -- Send the begin and done notifications via 'bracket_' so that they are always fired res <- withRunInIO $ \runInBase -> E.bracket_ -- Send begin notification - (runInBase $ sendNotification SProgress $ - fmap Begin $ ProgressParams progId $ - WorkDoneProgressBeginParams title (Just cancellable') Nothing initialPercentage) + (runInBase $ sendNotification SMethod_Progress $ + ProgressParams progId $ J.toJSON $ + WorkDoneProgressBegin J.AString title (Just cancellable') Nothing initialPercentage) -- Send end notification - (runInBase $ sendNotification SProgress $ - End <$> ProgressParams progId (WorkDoneProgressEndParams Nothing)) $ do + (runInBase $ sendNotification SMethod_Progress $ + ProgressParams progId $ J.toJSON $ (WorkDoneProgressEnd J.AString Nothing)) $ do -- Run f asynchronously aid <- async $ runInBase $ f (updater progId) @@ -644,13 +643,11 @@ withProgressBase indefinite title cancellable f = do return res where updater progId (ProgressAmount percentage msg) = do - sendNotification SProgress $ fmap Report $ ProgressParams progId $ - WorkDoneProgressReportParams Nothing msg percentage + sendNotification SMethod_Progress $ ProgressParams progId $ J.toJSON $ + WorkDoneProgressReport J.AString Nothing msg percentage clientSupportsProgress :: J.ClientCapabilities -> Bool -clientSupportsProgress (J.ClientCapabilities _ _ wc _ _) = fromMaybe False $ do - (J.WindowClientCapabilities mProgress _ _) <- wc - mProgress +clientSupportsProgress caps = fromMaybe False $ caps ^? window . _Just . workDoneProgress . _Just {-# INLINE clientSupportsProgress #-} @@ -686,14 +683,14 @@ withIndefiniteProgress title cancellable f = do -- | Aggregate all diagnostics pertaining to a particular version of a document, -- by source, and sends a @textDocument/publishDiagnostics@ notification with -- the total (limited by the first parameter) whenever it is updated. -publishDiagnostics :: MonadLsp config m => Int -> NormalizedUri -> TextDocumentVersion -> DiagnosticsBySource -> m () +publishDiagnostics :: MonadLsp config m => Int -> NormalizedUri -> Maybe J.Int32 -> DiagnosticsBySource -> m () publishDiagnostics maxDiagnosticCount uri version diags = join $ stateState resDiagnostics $ \oldDiags-> let !newDiags = updateDiagnostics oldDiags uri version diags mdp = getDiagnosticParamsFor maxDiagnosticCount newDiags uri act = case mdp of Nothing -> return () Just params -> - sendToClient $ J.fromServerNot $ J.NotificationMessage "2.0" J.STextDocumentPublishDiagnostics params + sendToClient $ J.fromServerNot $ J.TNotificationMessage "2.0" J.SMethod_TextDocumentPublishDiagnostics params in (act,newDiags) -- --------------------------------------------------------------------- @@ -701,7 +698,7 @@ publishDiagnostics maxDiagnosticCount uri version diags = join $ stateState resD -- | Remove all diagnostics from a particular source, and send the updates to -- the client. flushDiagnosticsBySource :: MonadLsp config m => Int -- ^ Max number of diagnostics to send - -> Maybe DiagnosticSource -> m () + -> Maybe Text -> m () flushDiagnosticsBySource maxDiagnosticCount msource = join $ stateState resDiagnostics $ \oldDiags -> let !newDiags = flushBySource oldDiags msource -- Send the updated diagnostics to the client @@ -710,7 +707,7 @@ flushDiagnosticsBySource maxDiagnosticCount msource = join $ stateState resDiagn case mdp of Nothing -> return () Just params -> do - sendToClient $ J.fromServerNot $ J.NotificationMessage "2.0" J.STextDocumentPublishDiagnostics params + sendToClient $ J.fromServerNot $ J.TNotificationMessage "2.0" J.SMethod_TextDocumentPublishDiagnostics params in (act,newDiags) -- --------------------------------------------------------------------- @@ -720,17 +717,17 @@ flushDiagnosticsBySource maxDiagnosticCount msource = join $ stateState resDiagn reverseSortEdit :: J.WorkspaceEdit -> J.WorkspaceEdit reverseSortEdit (J.WorkspaceEdit cs dcs anns) = J.WorkspaceEdit cs' dcs' anns where - cs' :: Maybe J.WorkspaceEditMap + cs' :: Maybe (Map.Map Uri [TextEdit]) cs' = (fmap . fmap ) sortTextEdits cs - dcs' :: Maybe (J.List J.DocumentChange) + dcs' :: Maybe [J.DocumentChange] dcs' = (fmap . fmap) sortOnlyTextDocumentEdits dcs - sortTextEdits :: J.List J.TextEdit -> J.List J.TextEdit - sortTextEdits (J.List edits) = J.List (L.sortOn (Down . (^. J.range)) edits) + sortTextEdits :: [J.TextEdit] -> [J.TextEdit] + sortTextEdits edits = L.sortOn (Down . (^. J.range)) edits sortOnlyTextDocumentEdits :: J.DocumentChange -> J.DocumentChange - sortOnlyTextDocumentEdits (J.InL (J.TextDocumentEdit td (J.List edits))) = J.InL $ J.TextDocumentEdit td (J.List edits') + sortOnlyTextDocumentEdits (J.InL (J.TextDocumentEdit td edits)) = J.InL $ J.TextDocumentEdit td edits' where edits' = L.sortOn (Down . editRange) edits sortOnlyTextDocumentEdits (J.InR others) = J.InR others diff --git a/lsp/src/Language/LSP/Server/Processing.hs b/lsp/src/Language/LSP/Server/Processing.hs index 6488030b3..9a98aaa31 100644 --- a/lsp/src/Language/LSP/Server/Processing.hs +++ b/lsp/src/Language/LSP/Server/Processing.hs @@ -9,8 +9,11 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE OverloadedLabels #-} {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} +-- there's just so much! +{-# OPTIONS_GHC -Wno-name-shadowing #-} -- So we can keep using the old prettyprinter modules (which have a better -- compatibility range) for now. {-# OPTIONS_GHC -Wno-deprecations #-} @@ -19,19 +22,20 @@ module Language.LSP.Server.Processing where import Colog.Core (LogAction (..), WithSeverity (..), Severity (..), (<&)) -import Control.Lens hiding (List, Empty) +import Control.Lens hiding (Empty) import Data.Aeson hiding (Options, Error) import Data.Aeson.Types hiding (Options, Error) import qualified Data.ByteString.Lazy as BSL import Data.List import Data.List.NonEmpty (NonEmpty(..)) +import Data.Row import qualified Data.Text as T import qualified Data.Text.Lazy.Encoding as TL -import Language.LSP.Types -import Language.LSP.Types.Capabilities -import qualified Language.LSP.Types.Lens as LSP -import Language.LSP.Types.SMethodMap (SMethodMap) -import qualified Language.LSP.Types.SMethodMap as SMethodMap +import qualified Language.LSP.Protocol.Types as LSP +import Language.LSP.Protocol.Types hiding (id) +import Language.LSP.Protocol.Message hiding (error) +import Language.LSP.Protocol.Utils.SMethodMap (SMethodMap) +import qualified Language.LSP.Protocol.Utils.SMethodMap as SMethodMap import Language.LSP.Server.Core import Language.LSP.VFS as VFS import qualified Data.Functor.Product as P @@ -48,7 +52,7 @@ import Data.Maybe import qualified Data.Map.Strict as Map import Data.Text.Prettyprint.Doc import System.Exit -import Data.Default (def) +import GHC.TypeLits (symbolVal) import Control.Monad.State import Control.Monad.Writer.Strict import Data.Foldable (traverse_) @@ -95,7 +99,7 @@ processMessage logger jsonStr = do pure $ handle logger m mess FromClientRsp (P.Pair (ServerResponseCallback f) (Const !newMap)) res -> do writeTVar pendingResponsesVar newMap - pure $ liftIO $ f (res ^. LSP.result) + pure $ liftIO $ f (res ^. result) where parser :: ResponseMap -> Value -> Parser (FromClientMessage' (P.Product ServerResponseCallback (Const ResponseMap))) parser rm = parseClientMessage $ \i -> @@ -109,25 +113,25 @@ initializeRequestHandler :: ServerDefinition config -> VFS -> (FromServerMessage -> IO ()) - -> Message Initialize + -> TMessage Method_Initialize -> IO (Maybe (LanguageContextEnv config)) initializeRequestHandler ServerDefinition{..} vfs sendFunc req = do - let sendResp = sendFunc . FromServerRsp SInitialize + let sendResp = sendFunc . FromServerRsp SMethod_Initialize handleErr (Left err) = do sendResp $ makeResponseError (req ^. LSP.id) err pure Nothing handleErr (Right a) = pure $ Just a flip E.catch (initializeErrorHandler $ sendResp . makeResponseError (req ^. LSP.id)) $ handleErr <=< runExceptT $ mdo - let params = req ^. LSP.params - rootDir = getFirst $ foldMap First [ params ^. LSP.rootUri >>= uriToFilePath - , params ^. LSP.rootPath <&> T.unpack ] + let p = req ^. params + rootDir = getFirst $ foldMap First [ p ^? rootUri . _L >>= uriToFilePath + , p ^? rootPath . _Just . _L <&> T.unpack ] - let initialWfs = case params ^. LSP.workspaceFolders of - Just (List xs) -> xs - Nothing -> [] + let initialWfs = case p ^. workspaceFolders of + Just (InL xs) -> xs + _ -> [] - initialConfig = case onConfigurationChange defaultConfig <$> (req ^. LSP.params . LSP.initializationOptions) of + initialConfig = case onConfigurationChange defaultConfig <$> (p ^. initializationOptions) of Just (Right newConfig) -> newConfig _ -> defaultConfig @@ -147,21 +151,21 @@ initializeRequestHandler ServerDefinition{..} vfs sendFunc req = do pure LanguageContextState{..} -- Call the 'duringInitialization' callback to let the server kick stuff up - let env = LanguageContextEnv handlers onConfigurationChange sendFunc stateVars (params ^. LSP.capabilities) rootDir + let env = LanguageContextEnv handlers onConfigurationChange sendFunc stateVars (p ^. capabilities) rootDir handlers = transmuteHandlers interpreter staticHandlers interpreter = interpretHandler initializationResult initializationResult <- ExceptT $ doInitialize env req - let serverCaps = inferServerCapabilities (params ^. LSP.capabilities) options handlers - liftIO $ sendResp $ makeResponseMessage (req ^. LSP.id) (InitializeResult serverCaps (serverInfo options)) + let serverCaps = inferServerCapabilities (p ^. capabilities) options handlers + liftIO $ sendResp $ makeResponseMessage (req ^. LSP.id) (InitializeResult serverCaps (optServerInfo options)) pure env where - makeResponseMessage rid result = ResponseMessage "2.0" (Just rid) (Right result) - makeResponseError origId err = ResponseMessage "2.0" (Just origId) (Left err) + makeResponseMessage rid result = TResponseMessage "2.0" (Just rid) (Right result) + makeResponseError origId err = TResponseMessage "2.0" (Just origId) (Left err) - initializeErrorHandler :: (ResponseError -> IO ()) -> E.SomeException -> IO (Maybe a) + initializeErrorHandler :: (TResponseError Method_Initialize -> IO ()) -> E.SomeException -> IO (Maybe a) initializeErrorHandler sendResp e = do - sendResp $ ResponseError InternalError msg Nothing + sendResp $ TResponseError ErrorCodes_InternalError msg Nothing pure Nothing where msg = T.pack $ unwords ["Error on initialize:", show e] @@ -174,37 +178,46 @@ inferServerCapabilities :: ClientCapabilities -> Options -> Handlers m -> Server inferServerCapabilities clientCaps o h = ServerCapabilities { _textDocumentSync = sync - , _hoverProvider = supportedBool STextDocumentHover + , _hoverProvider = supportedBool SMethod_TextDocumentHover , _completionProvider = completionProvider - , _declarationProvider = supportedBool STextDocumentDeclaration + , _declarationProvider = supportedBool SMethod_TextDocumentDeclaration , _signatureHelpProvider = signatureHelpProvider - , _definitionProvider = supportedBool STextDocumentDefinition - , _typeDefinitionProvider = supportedBool STextDocumentTypeDefinition - , _implementationProvider = supportedBool STextDocumentImplementation - , _referencesProvider = supportedBool STextDocumentReferences - , _documentHighlightProvider = supportedBool STextDocumentDocumentHighlight - , _documentSymbolProvider = supportedBool STextDocumentDocumentSymbol + , _definitionProvider = supportedBool SMethod_TextDocumentDefinition + , _typeDefinitionProvider = supportedBool SMethod_TextDocumentTypeDefinition + , _implementationProvider = supportedBool SMethod_TextDocumentImplementation + , _referencesProvider = supportedBool SMethod_TextDocumentReferences + , _documentHighlightProvider = supportedBool SMethod_TextDocumentDocumentHighlight + , _documentSymbolProvider = supportedBool SMethod_TextDocumentDocumentSymbol , _codeActionProvider = codeActionProvider - , _codeLensProvider = supported' STextDocumentCodeLens $ CodeLensOptions + , _codeLensProvider = supported' SMethod_TextDocumentCodeLens $ CodeLensOptions (Just False) - (supported SCodeLensResolve) - , _documentFormattingProvider = supportedBool STextDocumentFormatting - , _documentRangeFormattingProvider = supportedBool STextDocumentRangeFormatting + (supported SMethod_CodeLensResolve) + , _documentFormattingProvider = supportedBool SMethod_TextDocumentFormatting + , _documentRangeFormattingProvider = supportedBool SMethod_TextDocumentRangeFormatting , _documentOnTypeFormattingProvider = documentOnTypeFormattingProvider , _renameProvider = renameProvider - , _documentLinkProvider = supported' STextDocumentDocumentLink $ DocumentLinkOptions + , _documentLinkProvider = supported' SMethod_TextDocumentDocumentLink $ DocumentLinkOptions (Just False) - (supported SDocumentLinkResolve) - , _colorProvider = supportedBool STextDocumentDocumentColor - , _foldingRangeProvider = supportedBool STextDocumentFoldingRange + (supported SMethod_DocumentLinkResolve) + , _colorProvider = supportedBool SMethod_TextDocumentDocumentColor + , _foldingRangeProvider = supportedBool SMethod_TextDocumentFoldingRange , _executeCommandProvider = executeCommandProvider - , _selectionRangeProvider = supportedBool STextDocumentSelectionRange - , _callHierarchyProvider = supportedBool STextDocumentPrepareCallHierarchy + , _selectionRangeProvider = supportedBool SMethod_TextDocumentSelectionRange + , _callHierarchyProvider = supportedBool SMethod_TextDocumentPrepareCallHierarchy , _semanticTokensProvider = semanticTokensProvider - , _workspaceSymbolProvider = supportedBool SWorkspaceSymbol + , _workspaceSymbolProvider = supportedBool SMethod_WorkspaceSymbol , _workspace = Just workspace -- TODO: Add something for experimental , _experimental = Nothing :: Maybe Value + -- TODO + , _positionEncoding = Nothing + , _notebookDocumentSync = Nothing + , _linkedEditingRangeProvider = Nothing + , _monikerProvider = Nothing + , _typeHierarchyProvider = Nothing + , _inlineValueProvider = Nothing + , _inlayHintProvider = Nothing + , _diagnosticProvider = Nothing } where @@ -229,102 +242,104 @@ inferServerCapabilities clientCaps o h = singleton x = [x] completionProvider - | supported_b STextDocumentCompletion = Just $ - CompletionOptions - Nothing - (map T.singleton <$> completionTriggerCharacters o) - (map T.singleton <$> completionAllCommitCharacters o) - (supported SCompletionItemResolve) + | supported_b SMethod_TextDocumentCompletion = Just $ + CompletionOptions { + _triggerCharacters=map T.singleton <$> optCompletionTriggerCharacters o + , _allCommitCharacters=map T.singleton <$> optCompletionAllCommitCharacters o + , _resolveProvider=supported SMethod_CompletionItemResolve + , _completionItem=Nothing + , _workDoneProgress=Nothing + } | otherwise = Nothing clientSupportsCodeActionKinds = isJust $ - clientCaps ^? LSP.textDocument . _Just . LSP.codeAction . _Just . LSP.codeActionLiteralSupport + clientCaps ^? textDocument . _Just . codeAction . _Just . codeActionLiteralSupport codeActionProvider | clientSupportsCodeActionKinds - , supported_b STextDocumentCodeAction = Just $ case codeActionKinds o of - Just ks -> InR $ CodeActionOptions Nothing (Just (List ks)) (supported SCodeLensResolve) + , supported_b SMethod_TextDocumentCodeAction = Just $ case optCodeActionKinds o of + Just ks -> InR $ CodeActionOptions Nothing (Just ks) (supported SMethod_CodeLensResolve) Nothing -> InL True - | supported_b STextDocumentCodeAction = Just (InL True) + | supported_b SMethod_TextDocumentCodeAction = Just (InL True) | otherwise = Just (InL False) signatureHelpProvider - | supported_b STextDocumentSignatureHelp = Just $ + | supported_b SMethod_TextDocumentSignatureHelp = Just $ SignatureHelpOptions Nothing - (List . map T.singleton <$> signatureHelpTriggerCharacters o) - (List . map T.singleton <$> signatureHelpRetriggerCharacters o) + (map T.singleton <$> optSignatureHelpTriggerCharacters o) + (map T.singleton <$> optSignatureHelpRetriggerCharacters o) | otherwise = Nothing documentOnTypeFormattingProvider - | supported_b STextDocumentOnTypeFormatting - , Just (first :| rest) <- documentOnTypeFormattingTriggerCharacters o = Just $ + | supported_b SMethod_TextDocumentOnTypeFormatting + , Just (first :| rest) <- optDocumentOnTypeFormattingTriggerCharacters o = Just $ DocumentOnTypeFormattingOptions (T.pack [first]) (Just (map (T.pack . singleton) rest)) - | supported_b STextDocumentOnTypeFormatting - , Nothing <- documentOnTypeFormattingTriggerCharacters o = + | supported_b SMethod_TextDocumentOnTypeFormatting + , Nothing <- optDocumentOnTypeFormattingTriggerCharacters o = error "documentOnTypeFormattingTriggerCharacters needs to be set if a documentOnTypeFormattingHandler is set" | otherwise = Nothing executeCommandProvider - | supported_b SWorkspaceExecuteCommand - , Just cmds <- executeCommandCommands o = Just (ExecuteCommandOptions Nothing (List cmds)) - | supported_b SWorkspaceExecuteCommand - , Nothing <- executeCommandCommands o = + | supported_b SMethod_WorkspaceExecuteCommand + , Just cmds <- optExecuteCommandCommands o = Just (ExecuteCommandOptions Nothing cmds) + | supported_b SMethod_WorkspaceExecuteCommand + , Nothing <- optExecuteCommandCommands o = error "executeCommandCommands needs to be set if a executeCommandHandler is set" | otherwise = Nothing clientSupportsPrepareRename = fromMaybe False $ - clientCaps ^? LSP.textDocument . _Just . LSP.rename . _Just . LSP.prepareSupport . _Just + clientCaps ^? textDocument . _Just . rename . _Just . prepareSupport . _Just renameProvider | clientSupportsPrepareRename - , supported_b STextDocumentRename - , supported_b STextDocumentPrepareRename = Just $ + , supported_b SMethod_TextDocumentRename + , supported_b SMethod_TextDocumentPrepareRename = Just $ InR . RenameOptions Nothing . Just $ True - | supported_b STextDocumentRename = Just (InL True) + | supported_b SMethod_TextDocumentRename = Just (InL True) | otherwise = Just (InL False) -- Always provide the default legend -- TODO: allow user-provided legend via 'Options', or at least user-provided types - semanticTokensProvider = Just $ InL $ SemanticTokensOptions Nothing def semanticTokenRangeProvider semanticTokenFullProvider + semanticTokensProvider = Just $ InL $ SemanticTokensOptions Nothing defaultSemanticTokensLegend semanticTokenRangeProvider semanticTokenFullProvider semanticTokenRangeProvider - | supported_b STextDocumentSemanticTokensRange = Just $ SemanticTokensRangeBool True + | supported_b SMethod_TextDocumentSemanticTokensRange = Just $ InL True | otherwise = Nothing semanticTokenFullProvider - | supported_b STextDocumentSemanticTokensFull = Just $ SemanticTokensFullDelta $ SemanticTokensDeltaClientCapabilities $ supported STextDocumentSemanticTokensFullDelta + | supported_b SMethod_TextDocumentSemanticTokensFull = Just $ InR $ #delta .== supported SMethod_TextDocumentSemanticTokensFullDelta | otherwise = Nothing - sync = case textDocumentSync o of + sync = case optTextDocumentSync o of Just x -> Just (InL x) Nothing -> Nothing - workspace = WorkspaceServerCapabilities workspaceFolder - workspaceFolder = supported' SWorkspaceDidChangeWorkspaceFolders $ + workspace = #workspaceFolders .== workspaceFolder .+ #fileOperations .== Nothing + workspaceFolder = supported' SMethod_WorkspaceDidChangeWorkspaceFolders $ -- sign up to receive notifications WorkspaceFoldersServerCapabilities (Just True) (Just (InR True)) -- | Invokes the registered dynamic or static handlers for the given message and -- method, as well as doing some bookkeeping. -handle :: (m ~ LspM config) => LogAction m (WithSeverity LspProcessingLog) -> SClientMethod meth -> ClientMessage meth -> m () +handle :: (m ~ LspM config) => LogAction m (WithSeverity LspProcessingLog) -> SClientMethod meth -> TClientMessage meth -> m () handle logger m msg = case m of - SWorkspaceDidChangeWorkspaceFolders -> handle' logger (Just updateWorkspaceFolders) m msg - SWorkspaceDidChangeConfiguration -> handle' logger (Just $ handleConfigChange logger) m msg - STextDocumentDidOpen -> handle' logger (Just $ vfsFunc logger openVFS) m msg - STextDocumentDidChange -> handle' logger (Just $ vfsFunc logger changeFromClientVFS) m msg - STextDocumentDidClose -> handle' logger (Just $ vfsFunc logger closeVFS) m msg - SWindowWorkDoneProgressCancel -> handle' logger (Just $ progressCancelHandler logger) m msg + SMethod_WorkspaceDidChangeWorkspaceFolders -> handle' logger (Just updateWorkspaceFolders) m msg + SMethod_WorkspaceDidChangeConfiguration -> handle' logger (Just $ handleConfigChange logger) m msg + SMethod_TextDocumentDidOpen -> handle' logger (Just $ vfsFunc logger openVFS) m msg + SMethod_TextDocumentDidChange -> handle' logger (Just $ vfsFunc logger changeFromClientVFS) m msg + SMethod_TextDocumentDidClose -> handle' logger (Just $ vfsFunc logger closeVFS) m msg + SMethod_WindowWorkDoneProgressCancel -> handle' logger (Just $ progressCancelHandler logger) m msg _ -> handle' logger Nothing m msg -handle' :: forall m t (meth :: Method FromClient t) config +handle' :: forall m t (meth :: Method ClientToServer t) config . (m ~ LspM config) => LogAction m (WithSeverity LspProcessingLog) - -> Maybe (ClientMessage meth -> m ()) + -> Maybe (TClientMessage meth -> m ()) -- ^ An action to be run before invoking the handler, used for -- bookkeeping stuff like the vfs etc. -> SClientMethod meth - -> ClientMessage meth + -> TClientMessage meth -> m () handle' logger mAction m msg = do maybe (return ()) (\f -> f msg) mAction @@ -335,29 +350,29 @@ handle' logger mAction m msg = do env <- getLspEnv let Handlers{reqHandlers, notHandlers} = resHandlers env - let mkRspCb :: RequestMessage (m1 :: Method FromClient Request) -> Either ResponseError (ResponseResult m1) -> IO () + let mkRspCb :: TRequestMessage (m1 :: Method ClientToServer Request) -> Either (TResponseError m1) (MessageResult m1) -> IO () mkRspCb req (Left err) = runLspT env $ sendToClient $ - FromServerRsp (req ^. LSP.method) $ ResponseMessage "2.0" (Just (req ^. LSP.id)) (Left err) + FromServerRsp (req ^. method) $ TResponseMessage "2.0" (Just (req ^. LSP.id)) (Left err) mkRspCb req (Right rsp) = runLspT env $ sendToClient $ - FromServerRsp (req ^. LSP.method) $ ResponseMessage "2.0" (Just (req ^. LSP.id)) (Right rsp) + FromServerRsp (req ^. method) $ TResponseMessage "2.0" (Just (req ^. LSP.id)) (Right rsp) case splitClientMethod m of IsClientNot -> case pickHandler dynNotHandlers notHandlers of Just h -> liftIO $ h msg Nothing - | SExit <- m -> exitNotificationHandler logger msg + | SMethod_Exit <- m -> exitNotificationHandler logger msg | otherwise -> do reportMissingHandler IsClientReq -> case pickHandler dynReqHandlers reqHandlers of Just h -> liftIO $ h msg (mkRspCb msg) Nothing - | SShutdown <- m -> liftIO $ shutdownRequestHandler msg (mkRspCb msg) + | SMethod_Shutdown <- m -> liftIO $ shutdownRequestHandler msg (mkRspCb msg) | otherwise -> do let errorMsg = T.pack $ unwords ["lsp:no handler for: ", show m] - err = ResponseError MethodNotFound errorMsg Nothing + err = TResponseError ErrorCodes_MethodNotFound errorMsg Nothing sendToClient $ - FromServerRsp (msg ^. LSP.method) $ ResponseMessage "2.0" (Just (msg ^. LSP.id)) (Left err) + FromServerRsp (msg ^. method) $ TResponseMessage "2.0" (Just (msg ^. LSP.id)) (Left err) IsClientEither -> case msg of NotMess noti -> case pickHandler dynNotHandlers notHandlers of @@ -367,9 +382,9 @@ handle' logger mAction m msg = do Just h -> liftIO $ h req (mkRspCb req) Nothing -> do let errorMsg = T.pack $ unwords ["lsp:no handler for: ", show m] - err = ResponseError MethodNotFound errorMsg Nothing + err = TResponseError ErrorCodes_MethodNotFound errorMsg Nothing sendToClient $ - FromServerRsp (req ^. LSP.method) $ ResponseMessage "2.0" (Just (req ^. LSP.id)) (Left err) + FromServerRsp (req ^. method) $ TResponseMessage "2.0" (Just (req ^. LSP.id)) (Left err) where -- | Checks to see if there's a dynamic handler, and uses it in favour of the -- static handler, if it exists. @@ -386,12 +401,12 @@ handle' logger mAction m msg = do reportMissingHandler = let optional = isOptionalNotification m in logger <& MissingHandler optional m `WithSeverity` if optional then Warning else Error - isOptionalNotification (SCustomMethod method) - | "$/" `T.isPrefixOf` method = True + isOptionalNotification (SMethod_CustomMethod p) + | "$/" `T.isPrefixOf` T.pack (symbolVal p) = True isOptionalNotification _ = False -progressCancelHandler :: (m ~ LspM config) => LogAction m (WithSeverity LspProcessingLog) -> Message WindowWorkDoneProgressCancel -> m () -progressCancelHandler logger (NotificationMessage _ _ (WorkDoneProgressCancelParams tid)) = do +progressCancelHandler :: (m ~ LspM config) => LogAction m (WithSeverity LspProcessingLog) -> TMessage Method_WindowWorkDoneProgressCancel -> m () +progressCancelHandler logger (TNotificationMessage _ _ (WorkDoneProgressCancelParams tid)) = do pdata <- getsState (progressCancel . resProgressData) case Map.lookup tid pdata of Nothing -> return () @@ -399,26 +414,26 @@ progressCancelHandler logger (NotificationMessage _ _ (WorkDoneProgressCancelPar logger <& ProgressCancel tid `WithSeverity` Debug liftIO cancelAction -exitNotificationHandler :: (MonadIO m) => LogAction m (WithSeverity LspProcessingLog) -> Handler m Exit +exitNotificationHandler :: (MonadIO m) => LogAction m (WithSeverity LspProcessingLog) -> Handler m Method_Exit exitNotificationHandler logger _ = do logger <& Exiting `WithSeverity` Info liftIO exitSuccess -- | Default Shutdown handler -shutdownRequestHandler :: Handler IO Shutdown +shutdownRequestHandler :: Handler IO Method_Shutdown shutdownRequestHandler _req k = do - k $ Right Empty + k $ Right LSP.Null -handleConfigChange :: (m ~ LspM config) => LogAction m (WithSeverity LspProcessingLog) -> Message WorkspaceDidChangeConfiguration -> m () +handleConfigChange :: (m ~ LspM config) => LogAction m (WithSeverity LspProcessingLog) -> TMessage Method_WorkspaceDidChangeConfiguration -> m () handleConfigChange logger req = do parseConfig <- LspT $ asks resParseConfig - let settings = req ^. LSP.params . LSP.settings - res <- stateState resConfig $ \oldConfig -> case parseConfig oldConfig settings of + let s = req ^. params . settings + res <- stateState resConfig $ \oldConfig -> case parseConfig oldConfig s of Left err -> (Left err, oldConfig) Right !newConfig -> (Right (), newConfig) case res of Left err -> do - logger <& ConfigurationParseError settings err `WithSeverity` Error + logger <& ConfigurationParseError s err `WithSeverity` Error Right () -> pure () vfsFunc :: forall m n a config @@ -443,10 +458,10 @@ vfsFunc logger modifyVfs req = do innerLogger = LogAction $ \m -> tell [m] -- | Updates the list of workspace folders -updateWorkspaceFolders :: Message WorkspaceDidChangeWorkspaceFolders -> LspM config () -updateWorkspaceFolders (NotificationMessage _ _ params) = do - let List toRemove = params ^. LSP.event . LSP.removed - List toAdd = params ^. LSP.event . LSP.added +updateWorkspaceFolders :: TMessage Method_WorkspaceDidChangeWorkspaceFolders -> LspM config () +updateWorkspaceFolders (TNotificationMessage _ _ params) = do + let toRemove = params ^. event . removed + toAdd = params ^. event . added newWfs oldWfs = foldr delete oldWfs toRemove <> toAdd modifyState resWorkspaceFolders newWfs diff --git a/lsp/src/Language/LSP/VFS.hs b/lsp/src/Language/LSP/VFS.hs index 17915da0d..565d90c11 100644 --- a/lsp/src/Language/LSP/VFS.hs +++ b/lsp/src/Language/LSP/VFS.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -77,16 +78,16 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Int (Int32) import Data.List +import Data.Row import Data.Ord -import qualified Data.HashMap.Strict as HashMap import qualified Data.Map.Strict as Map import Data.Maybe import qualified Data.Text.Rope as URope import Data.Text.Utf16.Rope ( Rope ) import qualified Data.Text.Utf16.Rope as Rope import Data.Text.Prettyprint.Doc hiding (line) -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Message as J import System.FilePath import Data.Hashable import System.Directory @@ -151,7 +152,7 @@ initVFS k = withSystemTempDirectory "haskell-lsp" $ \temp_dir -> k (VFS mempty t -- --------------------------------------------------------------------- -- | Applies the changes from a 'J.DidOpenTextDocument' to the 'VFS' -openVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.Message 'J.TextDocumentDidOpen -> m () +openVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_TextDocumentDidOpen -> m () openVFS logger msg = do let J.TextDocumentItem (J.toNormalizedUri -> uri) _ version text = msg ^. J.params . J.textDocument vfile = VirtualFile version 0 (Rope.fromText text) @@ -161,12 +162,12 @@ openVFS logger msg = do -- --------------------------------------------------------------------- -- | Applies a 'DidChangeTextDocumentNotification' to the 'VFS' -changeFromClientVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.Message 'J.TextDocumentDidChange -> m () +changeFromClientVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_TextDocumentDidChange -> m () changeFromClientVFS logger msg = do let - J.DidChangeTextDocumentParams vid (J.List changes) = msg ^. J.params + J.DidChangeTextDocumentParams vid changes = msg ^. J.params -- the client shouldn't be sending over a null version, only the server, but we just use 0 if that happens - J.VersionedTextDocumentIdentifier (J.toNormalizedUri -> uri) (fromMaybe 0 -> version) = vid + J.VersionedTextDocumentIdentifier (J.toNormalizedUri -> uri) version = vid vfs <- get case vfs ^. vfsMap . at uri of Just (VirtualFile _ file_ver contents) -> do @@ -177,7 +178,7 @@ changeFromClientVFS logger msg = do -- --------------------------------------------------------------------- applyCreateFile :: (MonadState VFS m) => J.CreateFile -> m () -applyCreateFile (J.CreateFile (J.toNormalizedUri -> uri) options _ann) = +applyCreateFile (J.CreateFile _ann _kind (J.toNormalizedUri -> uri) options) = vfsMap %= Map.insertWith (\ new old -> if shouldOverwrite then new else old) uri @@ -197,7 +198,7 @@ applyCreateFile (J.CreateFile (J.toNormalizedUri -> uri) options _ann) = Just (J.CreateFileOptions (Just False) (Just False)) -> False -- `overwrite` wins over `ignoreIfExists` applyRenameFile :: (MonadState VFS m) => J.RenameFile -> m () -applyRenameFile (J.RenameFile (J.toNormalizedUri -> oldUri) (J.toNormalizedUri -> newUri) options _ann) = do +applyRenameFile (J.RenameFile _ann _kind (J.toNormalizedUri -> oldUri) (J.toNormalizedUri -> newUri) options) = do vfs <- get case vfs ^. vfsMap . at oldUri of -- nothing to rename @@ -225,7 +226,7 @@ applyRenameFile (J.RenameFile (J.toNormalizedUri -> oldUri) (J.toNormalizedUri - Just (J.RenameFileOptions (Just False) (Just False)) -> False -- `overwrite` wins over `ignoreIfExists` applyDeleteFile :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.DeleteFile -> m () -applyDeleteFile logger (J.DeleteFile (J.toNormalizedUri -> uri) options _ann) = do +applyDeleteFile logger (J.DeleteFile _ann _kind (J.toNormalizedUri -> uri) options) = do -- NOTE: we are ignoring the `recursive` option here because we don't know which file is a directory when (options ^? _Just . J.recursive . _Just == Just True) $ logger <& CantRecursiveDelete uri `WithSeverity` Warning @@ -239,13 +240,15 @@ applyDeleteFile logger (J.DeleteFile (J.toNormalizedUri -> uri) options _ann) = _ -> pure () applyTextDocumentEdit :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TextDocumentEdit -> m () -applyTextDocumentEdit logger (J.TextDocumentEdit vid (J.List edits)) = do +applyTextDocumentEdit logger (J.TextDocumentEdit vid edits) = do -- all edits are supposed to be applied at once -- so apply from bottom up so they don't affect others let sortedEdits = sortOn (Down . editRange) edits changeEvents = map editToChangeEvent sortedEdits - ps = J.DidChangeTextDocumentParams vid (J.List changeEvents) - notif = J.NotificationMessage "" J.STextDocumentDidChange ps + -- TODO: is this right? + vid' = J.VersionedTextDocumentIdentifier (vid ^. J.uri) (case vid ^. J.version of {J.InL v -> v; J.InR _ -> 0}) + ps = J.DidChangeTextDocumentParams vid' changeEvents + notif = J.TNotificationMessage "" J.SMethod_TextDocumentDidChange ps changeFromClientVFS logger notif where @@ -254,8 +257,8 @@ applyTextDocumentEdit logger (J.TextDocumentEdit vid (J.List edits)) = do editRange (J.InL e) = e ^. J.range editToChangeEvent :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.TextDocumentContentChangeEvent - editToChangeEvent (J.InR e) = J.TextDocumentContentChangeEvent (Just $ e ^. J.range) Nothing (e ^. J.newText) - editToChangeEvent (J.InL e) = J.TextDocumentContentChangeEvent (Just $ e ^. J.range) Nothing (e ^. J.newText) + editToChangeEvent (J.InR e) = J.TextDocumentContentChangeEvent $ J.InL $ #range .== e ^. J.range .+ #rangeLength .== Nothing .+ #text .== e ^. J.newText + editToChangeEvent (J.InL e) = J.TextDocumentContentChangeEvent $ J.InL $ #range .== e ^. J.range .+ #rangeLength .== Nothing .+ #text .== e ^. J.newText applyDocumentChange :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.DocumentChange -> m () applyDocumentChange logger (J.InL change) = applyTextDocumentEdit logger change @@ -264,26 +267,28 @@ applyDocumentChange _ (J.InR (J.InR (J.InL change))) = applyRenameFile chan applyDocumentChange logger (J.InR (J.InR (J.InR change))) = applyDeleteFile logger change -- | Applies the changes from a 'ApplyWorkspaceEditRequest' to the 'VFS' -changeFromServerVFS :: forall m . MonadState VFS m => LogAction m (WithSeverity VfsLog) -> J.Message 'J.WorkspaceApplyEdit -> m () +changeFromServerVFS :: forall m . MonadState VFS m => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_WorkspaceApplyEdit -> m () changeFromServerVFS logger msg = do let J.ApplyWorkspaceEditParams _label edit = msg ^. J.params J.WorkspaceEdit mChanges mDocChanges _anns = edit case mDocChanges of - Just (J.List docChanges) -> applyDocumentChanges docChanges + Just docChanges -> applyDocumentChanges docChanges Nothing -> case mChanges of - Just cs -> applyDocumentChanges $ map J.InL $ HashMap.foldlWithKey' changeToTextDocumentEdit [] cs + Just cs -> applyDocumentChanges $ map J.InL $ Map.foldlWithKey' changeToTextDocumentEdit [] cs Nothing -> pure () where changeToTextDocumentEdit acc uri edits = - acc ++ [J.TextDocumentEdit (J.VersionedTextDocumentIdentifier uri (Just 0)) (fmap J.InL edits)] + acc ++ [J.TextDocumentEdit (J.OptionalVersionedTextDocumentIdentifier uri (J.InL 0)) (fmap J.InL edits)] applyDocumentChanges :: [J.DocumentChange] -> m () applyDocumentChanges = traverse_ (applyDocumentChange logger) . sortOn project -- for sorting [DocumentChange] - project :: J.DocumentChange -> J.TextDocumentVersion -- type TextDocumentVersion = Maybe Int - project (J.InL textDocumentEdit) = textDocumentEdit ^. J.textDocument . J.version + project :: J.DocumentChange -> Maybe J.Int32 + project (J.InL textDocumentEdit) = case textDocumentEdit ^. J.textDocument . J.version of + J.InL v -> Just v + _ -> Nothing project _ = Nothing -- --------------------------------------------------------------------- @@ -322,7 +327,7 @@ persistFileVFS logger vfs uri = -- --------------------------------------------------------------------- -closeVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.Message 'J.TextDocumentDidClose -> m () +closeVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_TextDocumentDidClose -> m () closeVFS logger msg = do let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier (J.toNormalizedUri -> uri)) = msg ^. J.params logger <& Closing uri `WithSeverity` Debug @@ -339,10 +344,10 @@ applyChanges logger = foldM (applyChange logger) -- --------------------------------------------------------------------- applyChange :: (Monad m) => LogAction m (WithSeverity VfsLog) -> Rope -> J.TextDocumentContentChangeEvent -> m Rope -applyChange _ _ (J.TextDocumentContentChangeEvent Nothing _ str) - = pure $ Rope.fromText str -applyChange logger str (J.TextDocumentContentChangeEvent (Just (J.Range (J.Position sl sc) (J.Position fl fc))) _ txt) +applyChange logger str (J.TextDocumentContentChangeEvent (J.InL e)) | J.Range (J.Position sl sc) (J.Position fl fc) <- e .! #range, txt <- e .! #text = changeChars logger str (Rope.Position (fromIntegral sl) (fromIntegral sc)) (Rope.Position (fromIntegral fl) (fromIntegral fc)) txt +applyChange _ _ (J.TextDocumentContentChangeEvent (J.InR e)) + = pure $ Rope.fromText $ e .! #text -- --------------------------------------------------------------------- diff --git a/lsp/test/DiagnosticsSpec.hs b/lsp/test/DiagnosticsSpec.hs index f26346c76..9f9f4c061 100644 --- a/lsp/test/DiagnosticsSpec.hs +++ b/lsp/test/DiagnosticsSpec.hs @@ -7,7 +7,7 @@ import qualified Data.HashMap.Strict as HM import qualified Data.SortedList as SL import Data.Text (Text) import Language.LSP.Diagnostics -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as LSP import Test.Hspec @@ -29,20 +29,20 @@ spec = describe "Diagnostics functions" diagnosticsSpec -- --------------------------------------------------------------------- -mkDiagnostic :: Maybe J.DiagnosticSource -> Text -> J.Diagnostic +mkDiagnostic :: Maybe Text -> Text -> LSP.Diagnostic mkDiagnostic ms str = let - rng = J.Range (J.Position 0 1) (J.Position 3 0) - loc = J.Location (J.Uri "file") rng + rng = LSP.Range (LSP.Position 0 1) (LSP.Position 3 0) + loc = LSP.Location (LSP.Uri "file") rng in - J.Diagnostic rng Nothing Nothing ms str Nothing (Just (J.List [J.DiagnosticRelatedInformation loc str])) + LSP.Diagnostic rng Nothing Nothing Nothing ms str Nothing (Just [LSP.DiagnosticRelatedInformation loc str]) Nothing -mkDiagnostic2 :: Maybe J.DiagnosticSource -> Text -> J.Diagnostic +mkDiagnostic2 :: Maybe Text -> Text -> LSP.Diagnostic mkDiagnostic2 ms str = let - rng = J.Range (J.Position 4 1) (J.Position 5 0) - loc = J.Location (J.Uri "file") rng - in J.Diagnostic rng Nothing Nothing ms str Nothing (Just (J.List [J.DiagnosticRelatedInformation loc str])) + rng = LSP.Range (LSP.Position 4 1) (LSP.Position 5 0) + loc = LSP.Location (LSP.Uri "file") rng + in LSP.Diagnostic rng Nothing Nothing Nothing ms str Nothing (Just [LSP.DiagnosticRelatedInformation loc str]) Nothing -- --------------------------------------------------------------------- @@ -55,7 +55,7 @@ diagnosticsSpec = do [ mkDiagnostic (Just "hlint") "a" , mkDiagnostic (Just "hlint") "b" ] - uri = J.toNormalizedUri $ J.Uri "uri" + uri = LSP.toNormalizedUri $ LSP.Uri "uri" (updateDiagnostics HM.empty uri Nothing (partitionBySource diags)) `shouldBe` HM.fromList [ (uri,StoreItem Nothing $ Map.fromList [(Just "hlint", SL.toSortedList diags) ] ) @@ -69,7 +69,7 @@ diagnosticsSpec = do [ mkDiagnostic (Just "hlint") "a" , mkDiagnostic (Just "ghcmod") "b" ] - uri = J.toNormalizedUri $ J.Uri "uri" + uri = LSP.toNormalizedUri $ LSP.Uri "uri" (updateDiagnostics HM.empty uri Nothing (partitionBySource diags)) `shouldBe` HM.fromList [ (uri,StoreItem Nothing $ Map.fromList @@ -86,7 +86,7 @@ diagnosticsSpec = do [ mkDiagnostic (Just "hlint") "a" , mkDiagnostic (Just "ghcmod") "b" ] - uri = J.toNormalizedUri $ J.Uri "uri" + uri = LSP.toNormalizedUri $ LSP.Uri "uri" (updateDiagnostics HM.empty uri (Just 1) (partitionBySource diags)) `shouldBe` HM.fromList [ (uri,StoreItem (Just 1) $ Map.fromList @@ -107,7 +107,7 @@ diagnosticsSpec = do diags2 = [ mkDiagnostic (Just "hlint") "a2" ] - uri = J.toNormalizedUri $ J.Uri "uri" + uri = LSP.toNormalizedUri $ LSP.Uri "uri" let origStore = updateDiagnostics HM.empty uri Nothing (partitionBySource diags1) (updateDiagnostics origStore uri Nothing (partitionBySource diags2)) `shouldBe` HM.fromList @@ -125,7 +125,7 @@ diagnosticsSpec = do diags2 = [ mkDiagnostic (Just "hlint") "a2" ] - uri = J.toNormalizedUri $ J.Uri "uri" + uri = LSP.toNormalizedUri $ LSP.Uri "uri" let origStore = updateDiagnostics HM.empty uri Nothing (partitionBySource diags1) (updateDiagnostics origStore uri Nothing (partitionBySource diags2)) `shouldBe` HM.fromList @@ -143,7 +143,7 @@ diagnosticsSpec = do [ mkDiagnostic (Just "hlint") "a1" , mkDiagnostic (Just "ghcmod") "b1" ] - uri = J.toNormalizedUri $ J.Uri "uri" + uri = LSP.toNormalizedUri $ LSP.Uri "uri" let origStore = updateDiagnostics HM.empty uri Nothing (partitionBySource diags1) (updateDiagnostics origStore uri Nothing (Map.fromList [(Just "ghcmod",SL.toSortedList [])])) `shouldBe` HM.fromList @@ -166,7 +166,7 @@ diagnosticsSpec = do diags2 = [ mkDiagnostic (Just "hlint") "a2" ] - uri = J.toNormalizedUri $ J.Uri "uri" + uri = LSP.toNormalizedUri $ LSP.Uri "uri" let origStore = updateDiagnostics HM.empty uri (Just 1) (partitionBySource diags1) (updateDiagnostics origStore uri (Just 2) (partitionBySource diags2)) `shouldBe` HM.fromList @@ -184,7 +184,7 @@ diagnosticsSpec = do diags2 = [ mkDiagnostic (Just "hlint") "a2" ] - uri = J.toNormalizedUri $ J.Uri "uri" + uri = LSP.toNormalizedUri $ LSP.Uri "uri" let origStore = updateDiagnostics HM.empty uri (Just 1) (partitionBySource diags1) (updateDiagnostics origStore uri (Just 2) (partitionBySource diags2)) `shouldBe` HM.fromList @@ -203,10 +203,10 @@ diagnosticsSpec = do [ mkDiagnostic (Just "hlint") "a" , mkDiagnostic (Just "ghcmod") "b" ] - uri = J.toNormalizedUri $ J.Uri "uri" + uri = LSP.toNormalizedUri $ LSP.Uri "uri" let ds = updateDiagnostics HM.empty uri (Just 1) (partitionBySource diags) getDiagnosticParamsFor 10 ds uri `shouldBe` - Just (J.PublishDiagnosticsParams (J.fromNormalizedUri uri) (Just 1) (J.List $ reverse diags)) + Just (LSP.PublishDiagnosticsParams (LSP.fromNormalizedUri uri) (Just 1) (reverse diags)) -- --------------------------------- @@ -220,20 +220,20 @@ diagnosticsSpec = do , mkDiagnostic (Just "hlint") "c" , mkDiagnostic (Just "ghcmod") "d" ] - uri = J.toNormalizedUri $ J.Uri "uri" + uri = LSP.toNormalizedUri $ LSP.Uri "uri" let ds = updateDiagnostics HM.empty uri (Just 1) (partitionBySource diags) getDiagnosticParamsFor 2 ds uri `shouldBe` - Just (J.PublishDiagnosticsParams (J.fromNormalizedUri uri) (Just 1) - (J.List [ - mkDiagnostic (Just "ghcmod") "d" - , mkDiagnostic (Just "hlint") "c" - ])) + Just (LSP.PublishDiagnosticsParams (LSP.fromNormalizedUri uri) (Just 1) + [ + mkDiagnostic (Just "ghcmod") "d" + , mkDiagnostic (Just "hlint") "c" + ]) getDiagnosticParamsFor 1 ds uri `shouldBe` - Just (J.PublishDiagnosticsParams (J.fromNormalizedUri uri) (Just 1) - (J.List [ - mkDiagnostic (Just "ghcmod") "d" - ])) + Just (LSP.PublishDiagnosticsParams (LSP.fromNormalizedUri uri) (Just 1) + [ + mkDiagnostic (Just "ghcmod") "d" + ]) -- --------------------------------- @@ -247,23 +247,23 @@ diagnosticsSpec = do , mkDiagnostic (Just "hlint") "c" , mkDiagnostic (Just "ghcmod") "d" ] - uri = J.toNormalizedUri $ J.Uri "uri" + uri = LSP.toNormalizedUri $ LSP.Uri "uri" let ds = updateDiagnostics HM.empty uri (Just 1) (partitionBySource diags) getDiagnosticParamsFor 100 ds uri `shouldBe` - Just (J.PublishDiagnosticsParams (J.fromNormalizedUri uri) (Just 1) - (J.List [ - mkDiagnostic (Just "ghcmod") "d" - , mkDiagnostic (Just "hlint") "c" - , mkDiagnostic2 (Just "ghcmod") "b" - , mkDiagnostic2 (Just "hlint") "a" - ])) + Just (LSP.PublishDiagnosticsParams (LSP.fromNormalizedUri uri) (Just 1) + [ + mkDiagnostic (Just "ghcmod") "d" + , mkDiagnostic (Just "hlint") "c" + , mkDiagnostic2 (Just "ghcmod") "b" + , mkDiagnostic2 (Just "hlint") "a" + ]) let ds' = flushBySource ds (Just "hlint") getDiagnosticParamsFor 100 ds' uri `shouldBe` - Just (J.PublishDiagnosticsParams (J.fromNormalizedUri uri) (Just 1) - (J.List [ - mkDiagnostic (Just "ghcmod") "d" - , mkDiagnostic2 (Just "ghcmod") "b" - ])) + Just (LSP.PublishDiagnosticsParams (LSP.fromNormalizedUri uri) (Just 1) + [ + mkDiagnostic (Just "ghcmod") "d" + , mkDiagnostic2 (Just "ghcmod") "b" + ]) -- --------------------------------- diff --git a/lsp/test/VspSpec.hs b/lsp/test/VspSpec.hs index 7e24cb457..35eac9942 100644 --- a/lsp/test/VspSpec.hs +++ b/lsp/test/VspSpec.hs @@ -1,10 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLabels #-} module VspSpec where +import Data.Row import Data.String import qualified Data.Text.Utf16.Rope as Rope import Language.LSP.VFS -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J import qualified Data.Text as T import Test.Hspec @@ -31,23 +33,27 @@ vfsFromText text = VirtualFile 0 0 (Rope.fromText text) -- --------------------------------------------------------------------- +mkChangeEvent :: J.Range -> T.Text -> J.TextDocumentContentChangeEvent +mkChangeEvent r t = J.TextDocumentContentChangeEvent $ J.InL $ #range .== r .+ #rangeLength .== Nothing .+ #text .== t + vspSpec :: Spec vspSpec = do describe "applys changes in order" $ do it "handles vscode style undos" $ do let orig = "abc" changes = - [ J.TextDocumentContentChangeEvent (Just $ J.mkRange 0 2 0 3) Nothing "" - , J.TextDocumentContentChangeEvent (Just $ J.mkRange 0 1 0 2) Nothing "" - , J.TextDocumentContentChangeEvent (Just $ J.mkRange 0 0 0 1) Nothing "" + [ mkChangeEvent (J.mkRange 0 2 0 3) "" + , mkChangeEvent (J.mkRange 0 1 0 2) "" + , mkChangeEvent (J.mkRange 0 0 0 1) "" ] applyChanges mempty orig changes `shouldBe` Identity "" it "handles vscode style redos" $ do let orig = "" changes = - [ J.TextDocumentContentChangeEvent (Just $ J.mkRange 0 1 0 1) Nothing "a" - , J.TextDocumentContentChangeEvent (Just $ J.mkRange 0 2 0 2) Nothing "b" - , J.TextDocumentContentChangeEvent (Just $ J.mkRange 0 3 0 3) Nothing "c" + [ + mkChangeEvent (J.mkRange 0 1 0 1) "a" + , mkChangeEvent (J.mkRange 0 2 0 2) "b" + , mkChangeEvent (J.mkRange 0 3 0 3) "c" ] applyChanges mempty orig changes `shouldBe` Identity "abc" @@ -63,25 +69,7 @@ vspSpec = do , "-- fooo" , "foo :: Int" ] - new = applyChange mempty (fromString orig) - $ J.TextDocumentContentChangeEvent (Just $ J.mkRange 2 1 2 5) (Just 4) "" - Rope.lines <$> new `shouldBe` Identity - [ "abcdg" - , "module Foo where" - , "-oo" - , "foo :: Int" - ] - - it "deletes characters within a line (no len)" $ do - let - orig = unlines - [ "abcdg" - , "module Foo where" - , "-- fooo" - , "foo :: Int" - ] - new = applyChange mempty (fromString orig) - $ J.TextDocumentContentChangeEvent (Just $ J.mkRange 2 1 2 5) Nothing "" + new = applyChange mempty (fromString orig) $ mkChangeEvent (J.mkRange 2 1 2 5) "" Rope.lines <$> new `shouldBe` Identity [ "abcdg" , "module Foo where" @@ -100,30 +88,13 @@ vspSpec = do , "-- fooo" , "foo :: Int" ] - new = applyChange mempty (fromString orig) - $ J.TextDocumentContentChangeEvent (Just $ J.mkRange 2 0 3 0) (Just 8) "" + new = applyChange mempty (fromString orig) $ mkChangeEvent (J.mkRange 2 0 3 0) "" Rope.lines <$> new `shouldBe` Identity [ "abcdg" , "module Foo where" , "foo :: Int" ] - it "deletes one line(no len)" $ do - -- based on vscode log - let - orig = unlines - [ "abcdg" - , "module Foo where" - , "-- fooo" - , "foo :: Int" - ] - new = applyChange mempty (fromString orig) - $ J.TextDocumentContentChangeEvent (Just $ J.mkRange 2 0 3 0) Nothing "" - Rope.lines <$> new `shouldBe` Identity - [ "abcdg" - , "module Foo where" - , "foo :: Int" - ] -- --------------------------------- it "deletes two lines" $ do @@ -135,28 +106,12 @@ vspSpec = do , "foo :: Int" , "foo = bb" ] - new = applyChange mempty (fromString orig) - $ J.TextDocumentContentChangeEvent (Just $ J.mkRange 1 0 3 0) (Just 19) "" + new = applyChange mempty (fromString orig) $ mkChangeEvent (J.mkRange 1 0 3 0) "" Rope.lines <$> new `shouldBe` Identity [ "module Foo where" , "foo = bb" ] - it "deletes two lines(no len)" $ do - -- based on vscode log - let - orig = unlines - [ "module Foo where" - , "-- fooo" - , "foo :: Int" - , "foo = bb" - ] - new = applyChange mempty (fromString orig) - $ J.TextDocumentContentChangeEvent (Just $ J.mkRange 1 0 3 0) Nothing "" - Rope.lines <$> new `shouldBe` Identity - [ "module Foo where" - , "foo = bb" - ] -- --------------------------------- describe "adds characters" $ do @@ -168,8 +123,7 @@ vspSpec = do , "module Foo where" , "foo :: Int" ] - new = applyChange mempty (fromString orig) - $ J.TextDocumentContentChangeEvent (Just $ J.mkRange 1 16 1 16) (Just 0) "\n-- fooo" + new = applyChange mempty (fromString orig) $ mkChangeEvent (J.mkRange 1 16 1 16) "\n-- fooo" Rope.lines <$> new `shouldBe` Identity [ "abcdg" , "module Foo where" @@ -186,8 +140,7 @@ vspSpec = do [ "module Foo where" , "foo = bb" ] - new = applyChange mempty (fromString orig) - $ J.TextDocumentContentChangeEvent (Just $ J.mkRange 1 8 1 8) Nothing "\n-- fooo\nfoo :: Int" + new = applyChange mempty (fromString orig) $ mkChangeEvent (J.mkRange 1 8 1 8) "\n-- fooo\nfoo :: Int" Rope.lines <$> new `shouldBe` Identity [ "module Foo where" , "foo = bb" @@ -213,36 +166,7 @@ vspSpec = do , " putStrLn \"hello world\"" ] -- new = changeChars (fromString orig) (J.Position 7 0) (J.Position 7 8) "baz =" - new = applyChange mempty (fromString orig) - $ J.TextDocumentContentChangeEvent (Just $ J.mkRange 7 0 7 8) (Just 8) "baz =" - Rope.lines <$> new `shouldBe` Identity - [ "module Foo where" - , "-- fooo" - , "foo :: Int" - , "foo = bb" - , "" - , "bb = 5" - , "" - , "baz =" - , " putStrLn \"hello world\"" - ] - it "removes end of a line(no len)" $ 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 (fromString orig) (J.Position 7 0) (J.Position 7 8) "baz =" - new = applyChange mempty (fromString orig) - $ J.TextDocumentContentChangeEvent (Just $ J.mkRange 7 0 7 8) Nothing "baz =" + new = applyChange mempty (fromString orig) $ mkChangeEvent (J.mkRange 7 0 7 8) "baz =" Rope.lines <$> new `shouldBe` Identity [ "module Foo where" , "-- fooo" @@ -260,8 +184,7 @@ vspSpec = do [ "a𐐀b" , "a𐐀b" ] - new = applyChange mempty (fromString orig) - $ J.TextDocumentContentChangeEvent (Just $ J.mkRange 1 0 1 3) (Just 3) "𐐀𐐀" + new = applyChange mempty (fromString orig) $ mkChangeEvent (J.mkRange 1 0 1 3) "𐐀𐐀" Rope.lines <$> new `shouldBe` Identity [ "a𐐀b" , "𐐀𐐀b"