diff --git a/lsp-test/bench/SimpleBench.hs b/lsp-test/bench/SimpleBench.hs index 7b208f3c..ba979c5a 100644 --- a/lsp-test/bench/SimpleBench.hs +++ b/lsp-test/bench/SimpleBench.hs @@ -62,10 +62,10 @@ main = do replicateM_ n $ do v <- liftIO $ readIORef i liftIO $ when (v `mod` 1000 == 0) $ putStrLn $ show v - TResponseMessage{_result = Right (InL _)} <- + TResponseMessage{result = Right (InL _)} <- Test.request SMethod_TextDocumentHover $ HoverParams (TextDocumentIdentifier $ Uri "test") (Position 1 100) Nothing - TResponseMessage{_result = Right (InL _)} <- + TResponseMessage{result = Right (InL _)} <- Test.request SMethod_TextDocumentDefinition $ DefinitionParams (TextDocumentIdentifier $ Uri "test") (Position 1000 100) Nothing Nothing diff --git a/lsp-test/func-test/FuncTest.hs b/lsp-test/func-test/FuncTest.hs index 1cc2ef9f..ae599c57 100644 --- a/lsp-test/func-test/FuncTest.hs +++ b/lsp-test/func-test/FuncTest.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} @@ -13,11 +15,13 @@ import Control.Lens hiding (Iso, List) import Control.Monad import Control.Monad.IO.Class import Data.Aeson qualified as J +import Data.Generics.Labels () +import Data.Generics.Product.Fields (field') import Data.Maybe import Data.Proxy import Data.Set qualified as Set -import Language.LSP.Protocol.Lens qualified as L -import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Lens +import Language.LSP.Protocol.Message hiding (error) import Language.LSP.Protocol.Types import Language.LSP.Server import Language.LSP.Test qualified as Test @@ -85,7 +89,7 @@ spec = do -- has happened and the server has been able to send us a begin message skipManyTill Test.anyMessage $ do x <- Test.message SMethod_Progress - guard $ has (L.params . L.value . _workDoneProgressBegin) x + guard $ has (field' @"params" . #value . workDoneProgressBegin) x -- allow the hander to send us updates putMVar startBarrier () @@ -93,25 +97,25 @@ spec = do do u <- Test.message SMethod_Progress liftIO $ do - u ^? L.params . L.value . _workDoneProgressReport . L.message `shouldBe` Just (Just "step1") - u ^? L.params . L.value . _workDoneProgressReport . L.percentage `shouldBe` Just (Just 25) + u ^? field' @"params" . #value . workDoneProgressReport . #message `shouldBe` Just (Just "step1") + u ^? field' @"params" . #value . workDoneProgressReport . #percentage `shouldBe` Just (Just 25) do u <- Test.message SMethod_Progress liftIO $ do - u ^? L.params . L.value . _workDoneProgressReport . L.message `shouldBe` Just (Just "step2") - u ^? L.params . L.value . _workDoneProgressReport . L.percentage `shouldBe` Just (Just 50) + u ^? field' @"params" . #value . workDoneProgressReport . #message `shouldBe` Just (Just "step2") + u ^? field' @"params" . #value . workDoneProgressReport . #percentage `shouldBe` Just (Just 50) do u <- Test.message SMethod_Progress liftIO $ do - u ^? L.params . L.value . _workDoneProgressReport . L.message `shouldBe` Just (Just "step3") - u ^? L.params . L.value . _workDoneProgressReport . L.percentage `shouldBe` Just (Just 75) + u ^? field' @"params" . #value . workDoneProgressReport . #message `shouldBe` Just (Just "step3") + u ^? field' @"params" . #value . workDoneProgressReport . #percentage `shouldBe` Just (Just 75) -- Then make sure we get a $/progress end notification skipManyTill Test.anyMessage $ do x <- Test.message SMethod_Progress - guard $ has (L.params . L.value . _workDoneProgressEnd) x + guard $ has (field' @"params" . #value . workDoneProgressEnd) x it "handles cancellation" $ do wasCancelled <- newMVar False @@ -142,19 +146,19 @@ spec = do -- Wait until we have created the progress so the updates will be sent individually token <- skipManyTill Test.anyMessage $ do x <- Test.message SMethod_WindowWorkDoneProgressCreate - pure $ x ^. L.params . L.token + pure $ x ^. field' @"params" . #token -- First make sure that we get a $/progress begin notification skipManyTill Test.anyMessage $ do x <- Test.message SMethod_Progress - guard $ has (L.params . L.value . _workDoneProgressBegin) x + guard $ has (field' @"params" . #value . workDoneProgressBegin) x Test.sendNotification SMethod_WindowWorkDoneProgressCancel (WorkDoneProgressCancelParams token) -- Then make sure we still get a $/progress end notification skipManyTill Test.anyMessage $ do x <- Test.message SMethod_Progress - guard $ has (L.params . L.value . _workDoneProgressEnd) x + guard $ has (field' @"params" . #value . workDoneProgressEnd) x c <- readMVar wasCancelled c `shouldBe` True @@ -186,7 +190,7 @@ spec = do -- First make sure that we get a $/progress begin notification skipManyTill Test.anyMessage $ do x <- Test.message SMethod_Progress - guard $ has (L.params . L.value . _workDoneProgressBegin) x + guard $ has (field' @"params" . #value . workDoneProgressBegin) x -- Then kill the thread liftIO $ putMVar killVar () @@ -194,7 +198,7 @@ spec = do -- Then make sure we still get a $/progress end notification skipManyTill Test.anyMessage $ do x <- Test.message SMethod_Progress - guard $ has (L.params . L.value . _workDoneProgressEnd) x + guard $ has (field' @"params" . #value . workDoneProgressEnd) x describe "client-initiated progress reporting" $ do it "sends updates" $ do @@ -213,7 +217,7 @@ spec = do handlers :: Handlers (LspM ()) handlers = requestHandler SMethod_TextDocumentCodeLens $ \req resp -> void $ forkIO $ do - withProgress "Doing something" (req ^. L.params . L.workDoneToken) NotCancellable $ \updater -> do + withProgress "Doing something" (req ^. field' @"params" . #workDoneToken) NotCancellable $ \updater -> do updater $ ProgressAmount (Just 25) (Just "step1") updater $ ProgressAmount (Just 50) (Just "step2") updater $ ProgressAmount (Just 75) (Just "step3") @@ -224,30 +228,30 @@ spec = do -- First make sure that we get a $/progress begin notification skipManyTill Test.anyMessage $ do x <- Test.message SMethod_Progress - guard $ has (L.params . L.value . _workDoneProgressBegin) x + guard $ has (field' @"params" . #value . workDoneProgressBegin) x do u <- Test.message SMethod_Progress liftIO $ do - u ^? L.params . L.value . _workDoneProgressReport . L.message `shouldBe` Just (Just "step1") - u ^? L.params . L.value . _workDoneProgressReport . L.percentage `shouldBe` Just (Just 25) + u ^? field' @"params" . #value . workDoneProgressReport . #message `shouldBe` Just (Just "step1") + u ^? field' @"params" . #value . workDoneProgressReport . #percentage `shouldBe` Just (Just 25) do u <- Test.message SMethod_Progress liftIO $ do - u ^? L.params . L.value . _workDoneProgressReport . L.message `shouldBe` Just (Just "step2") - u ^? L.params . L.value . _workDoneProgressReport . L.percentage `shouldBe` Just (Just 50) + u ^? field' @"params" . #value . workDoneProgressReport . #message `shouldBe` Just (Just "step2") + u ^? field' @"params" . #value . workDoneProgressReport . #percentage `shouldBe` Just (Just 50) do u <- Test.message SMethod_Progress liftIO $ do - u ^? L.params . L.value . _workDoneProgressReport . L.message `shouldBe` Just (Just "step3") - u ^? L.params . L.value . _workDoneProgressReport . L.percentage `shouldBe` Just (Just 75) + u ^? field' @"params" . #value . workDoneProgressReport . #message `shouldBe` Just (Just "step3") + u ^? field' @"params" . #value . workDoneProgressReport . #percentage `shouldBe` Just (Just 75) -- Then make sure we get a $/progress end notification skipManyTill Test.anyMessage $ do x <- Test.message SMethod_Progress - guard $ has (L.params . L.value . _workDoneProgressEnd) x + guard $ has (field' @"params" . #value . workDoneProgressEnd) x describe "workspace folders" $ it "keeps track of open workspace folders" $ do diff --git a/lsp-test/lsp-test.cabal b/lsp-test/lsp-test.cabal index 5a72ac5f..2cdd0778 100644 --- a/lsp-test/lsp-test.cabal +++ b/lsp-test/lsp-test.cabal @@ -1,4 +1,4 @@ -cabal-version: 2.4 +cabal-version: 3.0 name: lsp-test version: 0.17.0.0 synopsis: Functional test framework for LSP servers. @@ -58,11 +58,13 @@ library , exceptions ^>=0.10 , extra ^>=1.7 , filepath >=1.4 && < 1.6 + , generic-lens ^>=2.2 , Glob >=0.9 && <0.11 , lens >=5.1 && <5.3 , lens-aeson ^>=1.2 , lsp ^>=2.4 - , lsp-types ^>=2.1 + , lsp-types + , lsp-types:lsp-types-lens , mtl >=2.2 && <2.4 , parser-combinators ^>=1.3 , process ^>=1.6 @@ -104,6 +106,7 @@ test-suite tests , directory , extra , filepath + , generic-lens , hspec , lens , lsp @@ -124,10 +127,12 @@ test-suite func-test , aeson , co-log-core , containers + , generic-lens , hspec , lens , lsp , lsp-test + , lsp-types:lsp-types-lens , parser-combinators , process , unliftio diff --git a/lsp-test/src/Language/LSP/Test.hs b/lsp-test/src/Language/LSP/Test.hs index 06e68a77..5ac1f3b6 100644 --- a/lsp-test/src/Language/LSP/Test.hs +++ b/lsp-test/src/Language/LSP/Test.hs @@ -1,6 +1,9 @@ {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeInType #-} @@ -147,6 +150,8 @@ import Data.Aeson hiding (Null) import Data.Aeson qualified as J import Data.Aeson.KeyMap qualified as J import Data.Default +import Data.Generics.Labels () +import Data.Generics.Product.Fields (field') import Data.List import Data.List.Extra (firstJust) import Data.Map.Strict qualified as Map @@ -158,8 +163,10 @@ import Data.Text.IO qualified as T import Data.Traversable (for) import Language.LSP.Protocol.Capabilities qualified as C import Language.LSP.Protocol.Lens qualified as L -import Language.LSP.Protocol.Message -import Language.LSP.Protocol.Types +import Language.LSP.Protocol.Message (MessageDirection (..), MessageKind (..), Method (..), SMethod (..)) +import Language.LSP.Protocol.Message qualified as L +import Language.LSP.Protocol.Types (ClientCapabilities, type (|?) (..)) +import Language.LSP.Protocol.Types qualified as L import Language.LSP.Test.Compat import Language.LSP.Test.Decoding import Language.LSP.Test.Exceptions @@ -208,7 +215,7 @@ runSessionWithConfig :: -- | The session to run. Session a -> IO a -runSessionWithConfig = runSessionWithConfigCustomProcess id +runSessionWithConfig = runSessionWithConfigCustomProcess Prelude.id -- | Starts a new session with a custom configuration and server 'CreateProcess'. runSessionWithConfigCustomProcess :: @@ -277,7 +284,7 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio config <- envOverrideConfig config' let initializeParams = - InitializeParams + L.InitializeParams Nothing -- Narrowing to Int32 here, but it's unlikely that a PID will -- be outside the range @@ -285,11 +292,11 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio (Just lspTestClientInfo) (Just $ T.pack absRootDir) Nothing - (InL $ filePathToUri absRootDir) + (InL $ L.filePathToUri absRootDir) caps -- TODO: make this configurable? (Just $ Object $ lspConfig config') - (Just TraceValue_Off) + (Just L.TraceValue_Off) (fmap InL $ initialWorkspaceFolders config) runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do -- Wrap the session around initialize and shutdown calls @@ -299,13 +306,13 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio -- collect them and then... (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId SMethod_Initialize initReqId) - case initRspMsg ^. L.result of + case initRspMsg.result of Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error) Right _ -> pure () initRspVar <- initRsp <$> ask liftIO $ putMVar initRspVar initRspMsg - sendNotification SMethod_Initialized InitializedParams + sendNotification SMethod_Initialized L.InitializedParams -- ... relay them back to the user Session so they can match on them! -- As long as they are allowed. @@ -331,17 +338,17 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio writeChan (messageChan context) (ServerMessage msg) case msg of - (FromServerRsp SMethod_Shutdown _) -> return () + (L.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 SMethod_WindowShowMessage _) = pure () - checkLegalBetweenMessage (FromServerMess SMethod_WindowLogMessage _) = pure () - checkLegalBetweenMessage (FromServerMess SMethod_TelemetryEvent _) = pure () - checkLegalBetweenMessage (FromServerMess SMethod_WindowShowMessageRequest _) = pure () + checkLegalBetweenMessage :: L.FromServerMessage -> Session () + checkLegalBetweenMessage (L.FromServerMess SMethod_WindowShowMessage _) = pure () + checkLegalBetweenMessage (L.FromServerMess SMethod_WindowLogMessage _) = pure () + checkLegalBetweenMessage (L.FromServerMess SMethod_TelemetryEvent _) = pure () + checkLegalBetweenMessage (L.FromServerMess SMethod_WindowShowMessageRequest _) = pure () checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg) -- | Check environment variables to override the config @@ -357,16 +364,16 @@ envOverrideConfig cfg = do convertVal _ = True -- | The current text contents of a document. -documentContents :: TextDocumentIdentifier -> Session T.Text +documentContents :: L.TextDocumentIdentifier -> Session T.Text documentContents doc = do vfs <- vfs <$> get - let Just file = vfs ^. vfsMap . at (toNormalizedUri (doc ^. L.uri)) + let Just file = vfs ^. #vfsMap . at (L.toNormalizedUri (doc.uri)) return (virtualFileText file) {- | Parses an ApplyEditRequest, checks that it is for the passed document and returns the new content -} -getDocumentEdit :: TextDocumentIdentifier -> Session T.Text +getDocumentEdit :: L.TextDocumentIdentifier -> Session T.Text getDocumentEdit doc = do req <- message SMethod_WorkspaceApplyEdit @@ -377,14 +384,14 @@ getDocumentEdit doc = do documentContents doc where checkDocumentChanges req = - let changes = req ^. L.params . L.edit . L.documentChanges + let changes = req.params.edit.documentChanges maybeDocs = fmap (fmap documentChangeUri) changes in case maybeDocs of - Just docs -> (doc ^. L.uri) `elem` docs + Just docs -> (doc.uri) `elem` docs Nothing -> False checkChanges req = - let mMap = req ^. L.params . L.edit . L.changes - in maybe False (Map.member (doc ^. L.uri)) mMap + let mMap = req.params.edit.changes + 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 @@ -393,27 +400,27 @@ getDocumentEdit doc = do @ Note: will skip any messages in between the request and the response. -} -request :: SClientMethod m -> MessageParams m -> Session (TResponseMessage m) +request :: L.SClientMethod m -> L.MessageParams m -> Session (L.TResponseMessage m) request m = sendRequest m >=> skipManyTill anyMessage . responseForId m -- | The same as 'sendRequest', but discard the response. -request_ :: SClientMethod (m :: Method ClientToServer Request) -> MessageParams m -> Session () +request_ :: L.SClientMethod (m :: Method ClientToServer Request) -> L.MessageParams m -> Session () request_ p = void . request p -- | Sends a request to the server. Unlike 'request', this doesn't wait for the response. sendRequest :: -- | The request method. - SClientMethod m -> + L.SClientMethod m -> -- | The request parameters. - MessageParams m -> + L.MessageParams m -> -- | The id of the request that was sent. - Session (LspId m) + Session (L.LspId m) sendRequest method params = do idn <- curReqId <$> get modify $ \c -> c{curReqId = idn + 1} - let id = IdInt idn + let id = L.IdInt idn - let mess = TRequestMessage "2.0" id method params + let mess = L.TRequestMessage "2.0" id method params -- Update the request map reqMap <- requestMap <$> ask @@ -421,22 +428,22 @@ sendRequest method params = do modifyMVar_ reqMap $ \r -> return $ fromJust $ updateRequestMap r id method - ~() <- case splitClientMethod method of - IsClientReq -> sendMessage mess - IsClientEither -> sendMessage $ ReqMess mess + ~() <- case L.splitClientMethod method of + L.IsClientReq -> sendMessage mess + L.IsClientEither -> sendMessage $ L.ReqMess mess return id -- | Sends a notification to the server. sendNotification :: -- | The notification method. - SClientMethod (m :: Method ClientToServer Notification) -> + L.SClientMethod (m :: Method ClientToServer Notification) -> -- | The notification parameters. - MessageParams m -> + L.MessageParams m -> Session () -- Open a virtual file if we send a did open text document notification sendNotification SMethod_TextDocumentDidOpen params = do - let n = TNotificationMessage "2.0" SMethod_TextDocumentDidOpen params + let n = L.TNotificationMessage "2.0" SMethod_TextDocumentDidOpen params oldVFS <- vfs <$> get let newVFS = flip execState oldVFS $ openVFS mempty n modify (\s -> s{vfs = newVFS}) @@ -444,31 +451,31 @@ sendNotification SMethod_TextDocumentDidOpen params = do -- Close a virtual file if we send a close text document notification sendNotification SMethod_TextDocumentDidClose params = do - let n = TNotificationMessage "2.0" SMethod_TextDocumentDidClose params + let n = L.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 SMethod_TextDocumentDidChange params = do - let n = TNotificationMessage "2.0" SMethod_TextDocumentDidChange params + let n = L.TNotificationMessage "2.0" SMethod_TextDocumentDidChange params oldVFS <- vfs <$> get let newVFS = flip execState oldVFS $ changeFromClientVFS mempty n modify (\s -> s{vfs = newVFS}) sendMessage n sendNotification method params = - case splitClientMethod method of - IsClientNot -> sendMessage (TNotificationMessage "2.0" method params) - IsClientEither -> sendMessage (NotMess $ TNotificationMessage "2.0" method params) + case L.splitClientMethod method of + L.IsClientNot -> sendMessage (L.TNotificationMessage "2.0" method params) + L.IsClientEither -> sendMessage (L.NotMess $ L.TNotificationMessage "2.0" method params) -- | Sends a response to the server. -sendResponse :: (ToJSON (MessageResult m), ToJSON (ErrorData m)) => TResponseMessage m -> Session () +sendResponse :: (ToJSON (L.MessageResult m), ToJSON (L.ErrorData m)) => L.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 (TResponseMessage Method_Initialize) +initializeResponse :: Session (L.TResponseMessage Method_Initialize) initializeResponse = ask >>= (liftIO . readMVar) . initRsp setIgnoringLogNotifications :: Bool -> Session () @@ -498,10 +505,10 @@ modifyConfig f = do registeredCaps <- getRegisteredCapabilities let requestedSections :: Maybe [T.Text] - requestedSections = flip firstJust registeredCaps $ \(SomeRegistration (TRegistration _ regMethod regOpts)) -> + requestedSections = flip firstJust registeredCaps $ \(L.SomeRegistration (L.TRegistration _ regMethod regOpts)) -> case regMethod of SMethod_WorkspaceDidChangeConfiguration -> case regOpts of - Just (DidChangeConfigurationRegistrationOptions{_section = section}) -> case section of + Just (L.DidChangeConfigurationRegistrationOptions{section = section}) -> case section of Just (InL s) -> Just [s] Just (InR ss) -> Just ss Nothing -> Nothing @@ -512,7 +519,7 @@ modifyConfig f = do let configToSend = case requestedSectionKeys of Just ss -> Object $ J.filterWithKey (\k _ -> k `elem` ss) newConfig Nothing -> Object newConfig - sendNotification SMethod_WorkspaceDidChangeConfiguration $ DidChangeConfigurationParams configToSend + sendNotification SMethod_WorkspaceDidChangeConfiguration $ L.DidChangeConfigurationParams configToSend {- | Set the client config. This will send a notification to the server that the config has changed. @@ -546,24 +553,24 @@ createDoc :: -- | The path to the document to open, __relative to the root directory__. FilePath -> -- | The text document's language identifier, e.g. @"haskell"@. - LanguageKind -> + L.LanguageKind -> -- | The content of the text document to create. T.Text -> -- | The identifier of the document just created. - Session TextDocumentIdentifier + Session L.TextDocumentIdentifier createDoc file languageId contents = do dynCaps <- curDynCaps <$> get rootDir <- asks rootDir caps <- asks sessionCapabilities absFile <- liftIO $ canonicalizePath (rootDir file) - let pred :: SomeRegistration -> [TRegistration Method_WorkspaceDidChangeWatchedFiles] - pred (SomeRegistration r@(TRegistration _ SMethod_WorkspaceDidChangeWatchedFiles _)) = [r] + let pred :: L.SomeRegistration -> [L.TRegistration Method_WorkspaceDidChangeWatchedFiles] + pred (L.SomeRegistration r@(L.TRegistration _ SMethod_WorkspaceDidChangeWatchedFiles _)) = [r] pred _ = mempty regs = concatMap pred $ Map.elems dynCaps - watchHits :: FileSystemWatcher -> Bool - watchHits (FileSystemWatcher (GlobPattern (InL (Pattern pattern))) kind) = + watchHits :: L.FileSystemWatcher -> Bool + watchHits (L.FileSystemWatcher (L.GlobPattern (InL (L.Pattern pattern))) kind) = -- If WatchKind is excluded, defaults to all true as per spec - fileMatches (T.unpack pattern) && containsCreate (fromMaybe WatchKind_Create kind) + fileMatches (T.unpack pattern) && L.containsCreate (fromMaybe L.WatchKind_Create kind) -- TODO: Relative patterns watchHits _ = False @@ -574,24 +581,24 @@ createDoc file languageId contents = do | isAbsolute pattern = absFile | otherwise = file - regHits :: TRegistration Method_WorkspaceDidChangeWatchedFiles -> Bool - regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. L.registerOptions . _Just . L.watchers) + regHits :: L.TRegistration Method_WorkspaceDidChangeWatchedFiles -> Bool + regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. field' @"registerOptions" . _Just . #watchers) clientCapsSupports = - caps ^? L.workspace . _Just . L.didChangeWatchedFiles . _Just . L.dynamicRegistration . _Just + caps ^? #workspace . _Just . #didChangeWatchedFiles . _Just . #dynamicRegistration . _Just == Just True shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs when shouldSend $ sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ - DidChangeWatchedFilesParams $ - [FileEvent (filePathToUri (rootDir file)) FileChangeType_Created] + L.DidChangeWatchedFilesParams $ + [L.FileEvent (L.filePathToUri (rootDir file)) L.FileChangeType_Created] openDoc' file languageId contents {- | Opens a text document that /exists on disk/, and sends a textDocument/didOpen notification to the server. -} -openDoc :: FilePath -> LanguageKind -> Session TextDocumentIdentifier +openDoc :: FilePath -> L.LanguageKind -> Session L.TextDocumentIdentifier openDoc file languageId = do context <- ask let fp = rootDir context file @@ -601,46 +608,46 @@ openDoc file languageId = do {- | This is a variant of `openDoc` that takes the file content as an argument. Use this is the file exists /outside/ of the current workspace. -} -openDoc' :: FilePath -> LanguageKind -> T.Text -> Session TextDocumentIdentifier +openDoc' :: FilePath -> L.LanguageKind -> T.Text -> Session L.TextDocumentIdentifier openDoc' file languageId contents = do context <- ask let fp = rootDir context file - uri = filePathToUri fp - item = TextDocumentItem uri languageId 0 contents - sendNotification SMethod_TextDocumentDidOpen (DidOpenTextDocumentParams item) - pure $ TextDocumentIdentifier uri + uri = L.filePathToUri fp + item = L.TextDocumentItem uri languageId 0 contents + sendNotification SMethod_TextDocumentDidOpen (L.DidOpenTextDocumentParams item) + pure $ L.TextDocumentIdentifier uri -- | Closes a text document and sends a textDocument/didOpen notification to the server. -closeDoc :: TextDocumentIdentifier -> Session () +closeDoc :: L.TextDocumentIdentifier -> Session () closeDoc docId = do - let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. L.uri)) + let params = L.DidCloseTextDocumentParams (L.TextDocumentIdentifier (docId.uri)) sendNotification SMethod_TextDocumentDidClose params -- | Changes a text document and sends a textDocument/didOpen notification to the server. -changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session () +changeDoc :: L.TextDocumentIdentifier -> [L.TextDocumentContentChangeEvent] -> Session () changeDoc docId changes = do verDoc <- getVersionedDoc docId - let params = DidChangeTextDocumentParams (verDoc & L.version +~ 1) changes + let params = L.DidChangeTextDocumentParams (verDoc & #version +~ 1) changes sendNotification SMethod_TextDocumentDidChange params -- | Gets the Uri for the file corrected to the session directory. -getDocUri :: FilePath -> Session Uri +getDocUri :: FilePath -> Session L.Uri getDocUri file = do context <- ask let fp = rootDir context file - return $ filePathToUri fp + return $ L.filePathToUri fp -- | Waits for diagnostics to be published and returns them. -waitForDiagnostics :: Session [Diagnostic] +waitForDiagnostics :: Session [L.Diagnostic] waitForDiagnostics = do diagsNot <- skipManyTill anyMessage (message SMethod_TextDocumentPublishDiagnostics) - let diags = diagsNot ^. L.params . L.diagnostics + let diags = diagsNot.params.diagnostics return diags {- | The same as 'waitForDiagnostics', but will only match a specific 'Language.LSP.Types._source'. -} -waitForDiagnosticsSource :: String -> Session [Diagnostic] +waitForDiagnosticsSource :: String -> Session [L.Diagnostic] waitForDiagnosticsSource src = do diags <- waitForDiagnostics let res = filter matches diags @@ -648,8 +655,8 @@ waitForDiagnosticsSource src = do then waitForDiagnosticsSource src else return res where - matches :: Diagnostic -> Bool - matches d = d ^. L.source == Just (T.pack src) + matches :: L.Diagnostic -> Bool + matches d = d.source == Just (T.pack src) {- | Expects a 'PublishDiagnosticsNotification' and throws an 'UnexpectedDiagnostics' exception if there are any diagnostics @@ -658,99 +665,99 @@ waitForDiagnosticsSource src = do noDiagnostics :: Session () noDiagnostics = do diagsNot <- message SMethod_TextDocumentPublishDiagnostics - when (diagsNot ^. L.params . L.diagnostics /= []) $ liftIO $ throw UnexpectedDiagnostics + when (diagsNot.params.diagnostics /= []) $ liftIO $ throw UnexpectedDiagnostics -- | Returns the symbols in a document. -getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [SymbolInformation] [DocumentSymbol]) +getDocumentSymbols :: L.TextDocumentIdentifier -> Session (Either [L.SymbolInformation] [L.DocumentSymbol]) getDocumentSymbols doc = do - TResponseMessage _ rspLid res <- request SMethod_TextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) + L.TResponseMessage _ rspLid res <- request SMethod_TextDocumentDocumentSymbol (L.DocumentSymbolParams Nothing Nothing doc) case res of 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) err) + Left err -> throw (UnexpectedResponseError (L.SomeLspId $ fromJust rspLid) err) -- | Returns the code actions in the specified range. -getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction] +getCodeActions :: L.TextDocumentIdentifier -> L.Range -> Session [L.Command |? L.CodeAction] getCodeActions doc range = do ctx <- getCodeActionContextInRange doc range - rsp <- request SMethod_TextDocumentCodeAction (CodeActionParams Nothing Nothing doc range ctx) + rsp <- request SMethod_TextDocumentCodeAction (L.CodeActionParams Nothing Nothing doc range ctx) - case rsp ^. L.result of + case rsp.result of Right (InL xs) -> return xs Right (InR _) -> return [] - Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. L.id) error) + Left error -> throw (UnexpectedResponseError (L.SomeLspId $ fromJust $ rsp.id) error) {- | Returns the code actions in the specified range, resolving any with a non empty _data_ field. -} -getAndResolveCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction] +getAndResolveCodeActions :: L.TextDocumentIdentifier -> L.Range -> Session [L.Command |? L.CodeAction] getAndResolveCodeActions doc range = do items <- getCodeActions doc range for items $ \case l@(InL _) -> pure l - (InR r) | isJust (r ^. L.data_) -> InR <$> resolveCodeAction r + (InR r) | isJust (r.data_) -> InR <$> resolveCodeAction r r@(InR _) -> pure r {- | Returns all the code actions in a document by querying the code actions at each of the current diagnostics' positions. -} -getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction] +getAllCodeActions :: L.TextDocumentIdentifier -> Session [L.Command |? L.CodeAction] getAllCodeActions doc = do ctx <- getCodeActionContext doc foldM (go ctx) [] =<< getCurrentDiagnostics doc where - go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction] + go :: L.CodeActionContext -> [L.Command |? L.CodeAction] -> L.Diagnostic -> Session [L.Command |? L.CodeAction] go ctx acc diag = do - TResponseMessage _ rspLid res <- request SMethod_TextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. L.range) ctx) + L.TResponseMessage _ rspLid res <- request SMethod_TextDocumentCodeAction (L.CodeActionParams Nothing Nothing doc (diag.range) ctx) case res of - Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e) + Left e -> throw (UnexpectedResponseError (L.SomeLspId $ fromJust rspLid) e) Right (InL cmdOrCAs) -> pure (acc ++ cmdOrCAs) Right (InR _) -> pure acc -getCodeActionContextInRange :: TextDocumentIdentifier -> Range -> Session CodeActionContext +getCodeActionContextInRange :: L.TextDocumentIdentifier -> L.Range -> Session L.CodeActionContext getCodeActionContextInRange doc caRange = do curDiags <- getCurrentDiagnostics doc let diags = - [ d | d@Diagnostic{_range = range} <- curDiags, overlappingRange caRange range + [ d | d@L.Diagnostic{range = range} <- curDiags, overlappingRange caRange range ] - return $ CodeActionContext diags Nothing Nothing + return $ L.CodeActionContext diags Nothing Nothing where - overlappingRange :: Range -> Range -> Bool - overlappingRange (Range s e) range = + overlappingRange :: L.Range -> L.Range -> Bool + overlappingRange (L.Range s e) range = positionInRange s range || positionInRange e range - positionInRange :: Position -> Range -> Bool - positionInRange (Position pl po) (Range (Position sl so) (Position el eo)) = + positionInRange :: L.Position -> L.Range -> Bool + positionInRange (L.Position pl po) (L.Range (L.Position sl so) (L.Position el eo)) = pl > sl && pl < el || pl == sl && pl == el && po >= so && po <= eo || pl == sl && po >= so || pl == el && po <= eo -getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext +getCodeActionContext :: L.TextDocumentIdentifier -> Session L.CodeActionContext getCodeActionContext doc = do curDiags <- getCurrentDiagnostics doc - return $ CodeActionContext curDiags Nothing Nothing + return $ L.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. -} -getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic] -getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. L.uri) . curDiagnostics <$> get +getCurrentDiagnostics :: L.TextDocumentIdentifier -> Session [L.Diagnostic] +getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (L.toNormalizedUri $ doc.uri) . curDiagnostics <$> get -- | Returns the tokens of all progress sessions that have started but not yet ended. -getIncompleteProgressSessions :: Session (Set.Set ProgressToken) +getIncompleteProgressSessions :: Session (Set.Set L.ProgressToken) getIncompleteProgressSessions = curProgressSessions <$> get -- | Executes a command. -executeCommand :: Command -> Session () +executeCommand :: L.Command -> Session () executeCommand cmd = do - let args = decode $ encode $ fromJust $ cmd ^. L.arguments - execParams = ExecuteCommandParams Nothing (cmd ^. L.command) args + let args = decode $ encode $ fromJust $ cmd.arguments + execParams = L.ExecuteCommandParams Nothing (cmd.command) args void $ sendRequest SMethod_WorkspaceExecuteCommand execParams {- | Executes a code action. @@ -758,253 +765,253 @@ executeCommand cmd = do contains both an edit and a command, the edit will be applied first. -} -executeCodeAction :: CodeAction -> Session () +executeCodeAction :: L.CodeAction -> Session () executeCodeAction action = do - maybe (return ()) handleEdit $ action ^. L.edit - maybe (return ()) executeCommand $ action ^. L.command + maybe (return ()) handleEdit $ action.edit + maybe (return ()) executeCommand $ action.command where - handleEdit :: WorkspaceEdit -> Session () + handleEdit :: L.WorkspaceEdit -> Session () handleEdit e = -- Its ok to pass in dummy parameters here as they aren't used - let req = TRequestMessage "" (IdInt 0) SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing e) - in updateState (FromServerMess SMethod_WorkspaceApplyEdit req) + let req = L.TRequestMessage "" (L.IdInt 0) SMethod_WorkspaceApplyEdit (L.ApplyWorkspaceEditParams Nothing e) + in updateState (L.FromServerMess SMethod_WorkspaceApplyEdit req) -- | Resolves the provided code action. -resolveCodeAction :: CodeAction -> Session CodeAction +resolveCodeAction :: L.CodeAction -> Session L.CodeAction resolveCodeAction ca = do rsp <- request SMethod_CodeActionResolve ca - case rsp ^. L.result of + case rsp.result of Right ca -> return ca - Left er -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. L.id) er) + Left er -> throw (UnexpectedResponseError (L.SomeLspId $ fromJust $ rsp.id) er) {- | If a code action contains a _data_ field: resolves the code action, then executes it. Otherwise, just executes it. -} -resolveAndExecuteCodeAction :: CodeAction -> Session () -resolveAndExecuteCodeAction ca@CodeAction{_data_ = Just _} = do +resolveAndExecuteCodeAction :: L.CodeAction -> Session () +resolveAndExecuteCodeAction ca@L.CodeAction{data_ = Just _} = do caRsp <- resolveCodeAction ca executeCodeAction caRsp resolveAndExecuteCodeAction ca = executeCodeAction ca -- | Adds the current version to the document, as tracked by the session. -getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier -getVersionedDoc (TextDocumentIdentifier uri) = do +getVersionedDoc :: L.TextDocumentIdentifier -> Session L.VersionedTextDocumentIdentifier +getVersionedDoc (L.TextDocumentIdentifier uri) = do vfs <- vfs <$> get - let ver = vfs ^? vfsMap . ix (toNormalizedUri uri) . to virtualFileVersion + let ver = vfs ^? #vfsMap . ix (L.toNormalizedUri uri) . to virtualFileVersion -- TODO: is this correct? Could return an OptionalVersionedTextDocumentIdentifier, -- but that complicated callers... - return (VersionedTextDocumentIdentifier uri (fromMaybe 0 ver)) + return (L.VersionedTextDocumentIdentifier uri (fromMaybe 0 ver)) -- | Applys an edit to the document and returns the updated document version. -applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier +applyEdit :: L.TextDocumentIdentifier -> L.TextEdit -> Session L.VersionedTextDocumentIdentifier applyEdit doc edit = do verDoc <- getVersionedDoc doc caps <- asks sessionCapabilities - let supportsDocChanges = fromMaybe False $ caps ^? L.workspace . _Just . L.workspaceEdit . _Just . L.documentChanges . _Just + let supportsDocChanges = fromMaybe False $ caps ^? #workspace . _Just . #workspaceEdit . _Just . #documentChanges . _Just let wEdit = if supportsDocChanges then - let docEdit = TextDocumentEdit (review _versionedTextDocumentIdentifier verDoc) [InL edit] - in WorkspaceEdit Nothing (Just [InL docEdit]) Nothing + let docEdit = L.TextDocumentEdit (review L.versionedTextDocumentIdentifier verDoc) [InL edit] + in L.WorkspaceEdit Nothing (Just [InL docEdit]) Nothing else - let changes = Map.singleton (doc ^. L.uri) [edit] - in WorkspaceEdit (Just changes) Nothing Nothing + let changes = Map.singleton (doc.uri) [edit] + in L.WorkspaceEdit (Just changes) Nothing Nothing - let req = TRequestMessage "" (IdInt 0) SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit) - updateState (FromServerMess SMethod_WorkspaceApplyEdit req) + let req = L.TRequestMessage "" (L.IdInt 0) SMethod_WorkspaceApplyEdit (L.ApplyWorkspaceEditParams Nothing wEdit) + updateState (L.FromServerMess SMethod_WorkspaceApplyEdit req) -- version may have changed getVersionedDoc doc -- | Returns the completions for the position in the document. -getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem] +getCompletions :: L.TextDocumentIdentifier -> L.Position -> Session [L.CompletionItem] getCompletions doc pos = do - rsp <- request SMethod_TextDocumentCompletion (CompletionParams doc pos Nothing Nothing Nothing) + rsp <- request SMethod_TextDocumentCompletion (L.CompletionParams doc pos Nothing Nothing Nothing) case getResponseResult rsp of InL items -> return items - InR (InL c) -> return $ c ^. L.items + InR (InL c) -> return $ c.items InR (InR _) -> return [] {- | Returns the completions for the position in the document, resolving any with a non empty _data_ field. -} -getAndResolveCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem] +getAndResolveCompletions :: L.TextDocumentIdentifier -> L.Position -> Session [L.CompletionItem] getAndResolveCompletions doc pos = do items <- getCompletions doc pos - for items $ \item -> if isJust (item ^. L.data_) then resolveCompletion item else pure item + for items $ \item -> if isJust (item.data_) then resolveCompletion item else pure item -- | Resolves the provided completion item. -resolveCompletion :: CompletionItem -> Session CompletionItem +resolveCompletion :: L.CompletionItem -> Session L.CompletionItem resolveCompletion ci = do rsp <- request SMethod_CompletionItemResolve ci - case rsp ^. L.result of + case rsp.result of Right ci -> return ci - Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. L.id) error) + Left error -> throw (UnexpectedResponseError (L.SomeLspId $ fromJust $ rsp.id) error) -- | Returns the references for the position in the document. getReferences :: -- | The document to lookup in. - TextDocumentIdentifier -> + L.TextDocumentIdentifier -> -- | The position to lookup. - Position -> + L.Position -> -- | Whether to include declarations as references. Bool -> -- | The locations of the references. - Session [Location] + Session [L.Location] getReferences doc pos inclDecl = - let ctx = ReferenceContext inclDecl - params = ReferenceParams doc pos Nothing Nothing ctx - in absorbNull . getResponseResult <$> request SMethod_TextDocumentReferences params + let ctx = L.ReferenceContext inclDecl + params = L.ReferenceParams doc pos Nothing Nothing ctx + in L.absorbNull . getResponseResult <$> request SMethod_TextDocumentReferences params -- | Returns the declarations(s) for the term at the specified position. getDeclarations :: -- | The document the term is in. - TextDocumentIdentifier -> + L.TextDocumentIdentifier -> -- | The position the term is at. - Position -> - Session (Declaration |? [DeclarationLink] |? Null) + L.Position -> + Session (L.Declaration |? [L.DeclarationLink] |? L.Null) getDeclarations doc pos = do - rsp <- request SMethod_TextDocumentDeclaration (DeclarationParams doc pos Nothing Nothing) + rsp <- request SMethod_TextDocumentDeclaration (L.DeclarationParams doc pos Nothing Nothing) pure $ getResponseResult rsp -- | Returns the definition(s) for the term at the specified position. getDefinitions :: -- | The document the term is in. - TextDocumentIdentifier -> + L.TextDocumentIdentifier -> -- | The position the term is at. - Position -> - Session (Definition |? [DefinitionLink] |? Null) + L.Position -> + Session (L.Definition |? [L.DefinitionLink] |? L.Null) getDefinitions doc pos = do - rsp <- request SMethod_TextDocumentDefinition (DefinitionParams doc pos Nothing Nothing) + rsp <- request SMethod_TextDocumentDefinition (L.DefinitionParams doc pos Nothing Nothing) pure $ getResponseResult rsp -- | Returns the type definition(s) for the term at the specified position. getTypeDefinitions :: -- | The document the term is in. - TextDocumentIdentifier -> + L.TextDocumentIdentifier -> -- | The position the term is at. - Position -> - Session (Definition |? [DefinitionLink] |? Null) + L.Position -> + Session (L.Definition |? [L.DefinitionLink] |? L.Null) getTypeDefinitions doc pos = do - rsp <- request SMethod_TextDocumentTypeDefinition (TypeDefinitionParams doc pos Nothing Nothing) + rsp <- request SMethod_TextDocumentTypeDefinition (L.TypeDefinitionParams doc pos Nothing Nothing) pure $ getResponseResult rsp -- | Returns the type definition(s) for the term at the specified position. getImplementations :: -- | The document the term is in. - TextDocumentIdentifier -> + L.TextDocumentIdentifier -> -- | The position the term is at. - Position -> - Session (Definition |? [DefinitionLink] |? Null) + L.Position -> + Session (L.Definition |? [L.DefinitionLink] |? L.Null) getImplementations doc pos = do - rsp <- request SMethod_TextDocumentImplementation (ImplementationParams doc pos Nothing Nothing) + rsp <- request SMethod_TextDocumentImplementation (L.ImplementationParams doc pos Nothing Nothing) pure $ getResponseResult rsp -- | Renames the term at the specified position. -rename :: TextDocumentIdentifier -> Position -> String -> Session () +rename :: L.TextDocumentIdentifier -> L.Position -> String -> Session () rename doc pos newName = do - let params = RenameParams Nothing doc pos (T.pack newName) + let params = L.RenameParams Nothing doc pos (T.pack newName) rsp <- request SMethod_TextDocumentRename params let wEdit = getResponseResult rsp - case nullToMaybe wEdit of + case L.nullToMaybe wEdit of Just e -> do - let req = TRequestMessage "" (IdInt 0) SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing e) - updateState (FromServerMess SMethod_WorkspaceApplyEdit req) + let req = L.TRequestMessage "" (L.IdInt 0) SMethod_WorkspaceApplyEdit (L.ApplyWorkspaceEditParams Nothing e) + updateState (L.FromServerMess SMethod_WorkspaceApplyEdit req) Nothing -> pure () -- | Returns the hover information at the specified position. -getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover) +getHover :: L.TextDocumentIdentifier -> L.Position -> Session (Maybe L.Hover) getHover doc pos = - let params = HoverParams doc pos Nothing - in nullToMaybe . getResponseResult <$> request SMethod_TextDocumentHover params + let params = L.HoverParams doc pos Nothing + in L.nullToMaybe . getResponseResult <$> request SMethod_TextDocumentHover params -- | Returns the highlighted occurrences of the term at the specified position -getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight] +getHighlights :: L.TextDocumentIdentifier -> L.Position -> Session [L.DocumentHighlight] getHighlights doc pos = - let params = DocumentHighlightParams doc pos Nothing Nothing - in absorbNull . getResponseResult <$> request SMethod_TextDocumentDocumentHighlight params + let params = L.DocumentHighlightParams doc pos Nothing Nothing + in L.absorbNull . getResponseResult <$> request SMethod_TextDocumentDocumentHighlight params {- | Checks the response for errors and throws an exception if needed. Returns the result if successful. -} -getResponseResult :: (ToJSON (ErrorData m)) => TResponseMessage m -> MessageResult m +getResponseResult :: (ToJSON (L.ErrorData m)) => L.TResponseMessage m -> L.MessageResult m getResponseResult rsp = - case rsp ^. L.result of + case rsp.result of Right x -> x - Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. L.id) err + Left err -> throw $ UnexpectedResponseError (L.SomeLspId $ fromJust $ rsp.id) err -- | Applies formatting to the specified document. -formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session () +formatDoc :: L.TextDocumentIdentifier -> L.FormattingOptions -> Session () formatDoc doc opts = do - let params = DocumentFormattingParams Nothing doc opts - edits <- absorbNull . getResponseResult <$> request SMethod_TextDocumentFormatting params + let params = L.DocumentFormattingParams Nothing doc opts + edits <- L.absorbNull . getResponseResult <$> request SMethod_TextDocumentFormatting params applyTextEdits doc edits -- | Applies formatting to the specified range in a document. -formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session () +formatRange :: L.TextDocumentIdentifier -> L.FormattingOptions -> L.Range -> Session () formatRange doc opts range = do - let params = DocumentRangeFormattingParams Nothing doc range opts - edits <- absorbNull . getResponseResult <$> request SMethod_TextDocumentRangeFormatting params + let params = L.DocumentRangeFormattingParams Nothing doc range opts + edits <- L.absorbNull . getResponseResult <$> request SMethod_TextDocumentRangeFormatting params applyTextEdits doc edits -applyTextEdits :: TextDocumentIdentifier -> [TextEdit] -> Session () +applyTextEdits :: L.TextDocumentIdentifier -> [L.TextEdit] -> Session () applyTextEdits doc edits = - let wEdit = WorkspaceEdit (Just (Map.singleton (doc ^. L.uri) edits)) Nothing Nothing + let wEdit = L.WorkspaceEdit (Just (Map.singleton (doc.uri) edits)) Nothing Nothing -- Send a dummy message to updateState so it can do bookkeeping - req = TRequestMessage "" (IdInt 0) SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit) - in updateState (FromServerMess SMethod_WorkspaceApplyEdit req) + req = L.TRequestMessage "" (L.IdInt 0) SMethod_WorkspaceApplyEdit (L.ApplyWorkspaceEditParams Nothing wEdit) + in updateState (L.FromServerMess SMethod_WorkspaceApplyEdit req) -- | Returns the code lenses for the specified document. -getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens] +getCodeLenses :: L.TextDocumentIdentifier -> Session [L.CodeLens] getCodeLenses tId = do - rsp <- request SMethod_TextDocumentCodeLens (CodeLensParams Nothing Nothing tId) - pure $ absorbNull $ getResponseResult rsp + rsp <- request SMethod_TextDocumentCodeLens (L.CodeLensParams Nothing Nothing tId) + pure $ L.absorbNull $ getResponseResult rsp {- | Returns the code lenses for the specified document, resolving any with a non empty _data_ field. -} -getAndResolveCodeLenses :: TextDocumentIdentifier -> Session [CodeLens] +getAndResolveCodeLenses :: L.TextDocumentIdentifier -> Session [L.CodeLens] getAndResolveCodeLenses tId = do codeLenses <- getCodeLenses tId - for codeLenses $ \codeLens -> if isJust (codeLens ^. L.data_) then resolveCodeLens codeLens else pure codeLens + for codeLenses $ \codeLens -> if isJust (codeLens.data_) then resolveCodeLens codeLens else pure codeLens -- | Resolves the provided code lens. -resolveCodeLens :: CodeLens -> Session CodeLens +resolveCodeLens :: L.CodeLens -> Session L.CodeLens resolveCodeLens cl = do rsp <- request SMethod_CodeLensResolve cl - case rsp ^. L.result of + case rsp.result of Right cl -> return cl - Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. L.id) error) + Left error -> throw (UnexpectedResponseError (L.SomeLspId $ fromJust $ rsp.id) error) -- | Pass a param and return the response from `prepareCallHierarchy` -prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem] +prepareCallHierarchy :: L.CallHierarchyPrepareParams -> Session [L.CallHierarchyItem] prepareCallHierarchy = resolveRequestWithListResp SMethod_TextDocumentPrepareCallHierarchy -incomingCalls :: CallHierarchyIncomingCallsParams -> Session [CallHierarchyIncomingCall] +incomingCalls :: L.CallHierarchyIncomingCallsParams -> Session [L.CallHierarchyIncomingCall] incomingCalls = resolveRequestWithListResp SMethod_CallHierarchyIncomingCalls -outgoingCalls :: CallHierarchyOutgoingCallsParams -> Session [CallHierarchyOutgoingCall] +outgoingCalls :: L.CallHierarchyOutgoingCallsParams -> Session [L.CallHierarchyOutgoingCall] outgoingCalls = resolveRequestWithListResp SMethod_CallHierarchyOutgoingCalls -- | Send a request and receive a response with list. resolveRequestWithListResp :: forall (m :: Method ClientToServer Request) a. - (ToJSON (ErrorData m), MessageResult m ~ ([a] |? Null)) => + (ToJSON (L.ErrorData m), L.MessageResult m ~ ([a] |? L.Null)) => SMethod m -> - MessageParams m -> + L.MessageParams m -> Session [a] resolveRequestWithListResp method params = do rsp <- request method params - pure $ absorbNull $ getResponseResult rsp + pure $ L.absorbNull $ getResponseResult rsp -- | Pass a param and return the response from `semanticTokensFull` -getSemanticTokens :: TextDocumentIdentifier -> Session (SemanticTokens |? Null) +getSemanticTokens :: L.TextDocumentIdentifier -> Session (L.SemanticTokens |? L.Null) getSemanticTokens doc = do - let params = SemanticTokensParams Nothing Nothing doc + let params = L.SemanticTokensParams Nothing Nothing doc rsp <- request SMethod_TextDocumentSemanticTokensFull params pure $ getResponseResult rsp @@ -1013,5 +1020,5 @@ getSemanticTokens doc = do @since 0.11.0.0 -} -getRegisteredCapabilities :: Session [SomeRegistration] +getRegisteredCapabilities :: Session [L.SomeRegistration] getRegisteredCapabilities = Map.elems . curDynCaps <$> get diff --git a/lsp-test/src/Language/LSP/Test/Compat.hs b/lsp-test/src/Language/LSP/Test/Compat.hs index 144797d0..1ffb193b 100644 --- a/lsp-test/src/Language/LSP/Test/Compat.hs +++ b/lsp-test/src/Language/LSP/Test/Compat.hs @@ -119,4 +119,4 @@ withCreateProcess c action = #endif lspTestClientInfo :: L.ClientInfo -lspTestClientInfo = L.ClientInfo{L._name = "lsp-test", L._version = Just CURRENT_PACKAGE_VERSION} +lspTestClientInfo = L.ClientInfo{L.name = "lsp-test", L.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 c8892dd5..f5252289 100644 --- a/lsp-test/src/Language/LSP/Test/Decoding.hs +++ b/lsp-test/src/Language/LSP/Test/Decoding.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeInType #-} @@ -10,11 +12,10 @@ import Data.Aeson import Data.Aeson.Types import Data.ByteString.Lazy.Char8 qualified as B import Data.Foldable -import Data.Functor.Const import Data.Functor.Product +import Data.Generics.Labels () import Data.Maybe -import Language.LSP.Protocol.Lens qualified as L -import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Message hiding (error) import Language.LSP.Test.Exceptions import System.IO import System.IO.Error @@ -68,10 +69,10 @@ getRequestMap = foldl' helper emptyIxMap helper acc msg = case msg of FromClientMess m mess -> case splitClientMethod m of IsClientNot -> acc - IsClientReq -> fromJust $ updateRequestMap acc (mess ^. L.id) m + IsClientReq -> fromJust $ updateRequestMap acc (mess.id) m IsClientEither -> case mess of NotMess _ -> acc - ReqMess msg -> fromJust $ updateRequestMap acc (msg ^. L.id) m + ReqMess msg -> fromJust $ updateRequestMap acc (msg.id) m _ -> acc decodeFromServerMsg :: RequestMap -> B.ByteString -> (RequestMap, FromServerMessage) diff --git a/lsp-test/src/Language/LSP/Test/Files.hs b/lsp-test/src/Language/LSP/Test/Files.hs index 78e5db0d..49884069 100644 --- a/lsp-test/src/Language/LSP/Test/Files.hs +++ b/lsp-test/src/Language/LSP/Test/Files.hs @@ -1,4 +1,7 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeInType #-} @@ -9,12 +12,13 @@ module Language.LSP.Test.Files ( where import Control.Lens +import Data.Generics.Labels () +import Data.Generics.Product.Fields (field') import Data.Map.Strict qualified as M import Data.Maybe import Data.Text qualified as T import Data.Time.Clock -import Language.LSP.Protocol.Lens qualified as L -import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Message hiding (error) import Language.LSP.Protocol.Types import System.Directory import System.FilePath @@ -39,7 +43,7 @@ swapFiles relCurBaseDir msgs = do rootDir :: [Event] -> FilePath rootDir (ClientEv _ (FromClientMess SMethod_Initialize req) : _) = fromMaybe (error "Couldn't find root dir") $ do - rootUri <- case req ^. L.params . L.rootUri of + rootUri <- case req.params.rootUri of InL r -> Just r InR _ -> error "Couldn't find root dir" uriToFilePath rootUri @@ -52,47 +56,46 @@ mapUris f event = ServerEv t msg -> ServerEv t (fromServerMsg msg) where -- TODO: Handle all other URIs that might need swapped - fromClientMsg (FromClientMess m@SMethod_Initialize r) = FromClientMess m $ L.params .~ transformInit (r ^. L.params) $ r - fromClientMsg (FromClientMess m@SMethod_TextDocumentDidOpen n) = FromClientMess m $ swapUri (L.params . L.textDocument) n - fromClientMsg (FromClientMess m@SMethod_TextDocumentDidChange n) = FromClientMess m $ swapUri (L.params . L.textDocument) n - fromClientMsg (FromClientMess m@SMethod_TextDocumentWillSave n) = FromClientMess m $ swapUri (L.params . L.textDocument) n - fromClientMsg (FromClientMess m@SMethod_TextDocumentDidSave n) = FromClientMess m $ swapUri (L.params . L.textDocument) n - fromClientMsg (FromClientMess m@SMethod_TextDocumentDidClose n) = FromClientMess m $ swapUri (L.params . L.textDocument) n - fromClientMsg (FromClientMess m@SMethod_TextDocumentDocumentSymbol n) = FromClientMess m $ swapUri (L.params . L.textDocument) n - fromClientMsg (FromClientMess m@SMethod_TextDocumentRename n) = FromClientMess m $ swapUri (L.params . L.textDocument) n + fromClientMsg (FromClientMess m@SMethod_Initialize r) = FromClientMess m $ r & #params %~ transformInit + -- in FromClientMess m $ msg { params = transformInit p } + fromClientMsg (FromClientMess m@SMethod_TextDocumentDidOpen n) = FromClientMess m $ n & field' @"params" . #textDocument . #uri %~ f + fromClientMsg (FromClientMess m@SMethod_TextDocumentDidChange n) = FromClientMess m $ n & field' @"params" . #textDocument . #uri %~ f + fromClientMsg (FromClientMess m@SMethod_TextDocumentWillSave n) = FromClientMess m $ n & field' @"params" . #textDocument . #uri %~ f + fromClientMsg (FromClientMess m@SMethod_TextDocumentDidSave n) = FromClientMess m $ n & field' @"params" . #textDocument . #uri %~ f + fromClientMsg (FromClientMess m@SMethod_TextDocumentDidClose n) = FromClientMess m $ n & field' @"params" . #textDocument . #uri %~ f + fromClientMsg (FromClientMess m@SMethod_TextDocumentDocumentSymbol n) = FromClientMess m $ n & field' @"params" . #textDocument . #uri %~ f + fromClientMsg (FromClientMess m@SMethod_TextDocumentRename n) = FromClientMess m $ n & field' @"params" . #textDocument . #uri %~ f fromClientMsg x = x fromServerMsg :: FromServerMessage -> FromServerMessage - fromServerMsg (FromServerMess m@SMethod_WorkspaceApplyEdit r) = FromServerMess m $ L.params . L.edit .~ swapWorkspaceEdit (r ^. L.params . L.edit) $ r - fromServerMsg (FromServerMess m@SMethod_TextDocumentPublishDiagnostics n) = FromServerMess m $ swapUri L.params n + fromServerMsg (FromServerMess m@SMethod_WorkspaceApplyEdit r) = FromServerMess m $ r & field' @"params" . #edit %~ swapWorkspaceEdit + fromServerMsg (FromServerMess m@SMethod_TextDocumentPublishDiagnostics n) = FromServerMess m $ n & field' @"params" . #uri %~ f 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 L.location <$> si) - in FromServerRsp m $ r & L.result . _Right %~ swapUri' - fromServerMsg (FromServerRsp m@SMethod_TextDocumentRename r) = FromServerRsp m $ r & L.result . _Right . _L %~ swapWorkspaceEdit + swapUri' (InL si) = InL (swapUri (#location . #uri) <$> si) + in FromServerRsp m $ r & #result . _Right %~ swapUri' + fromServerMsg (FromServerRsp m@SMethod_TextDocumentRename r) = FromServerRsp m $ r & field' @"result" . _Right . #_InL %~ swapWorkspaceEdit fromServerMsg x = x swapWorkspaceEdit :: WorkspaceEdit -> WorkspaceEdit swapWorkspaceEdit e = let swapDocumentChangeUri :: DocumentChange -> DocumentChange - swapDocumentChangeUri (InL textDocEdit) = InL $ swapUri L.textDocument textDocEdit - swapDocumentChangeUri (InR (InL createFile)) = InR $ InL $ swapUri id createFile + swapDocumentChangeUri (InL textDocEdit) = InL $ swapUri (#textDocument . #uri) textDocEdit + swapDocumentChangeUri (InR (InL createFile)) = InR $ InL $ swapUri #uri createFile -- for RenameFile, we swap `newUri` - swapDocumentChangeUri (InR (InR (InL renameFile))) = InR $ InR $ InL $ L.newUri .~ f (renameFile ^. L.newUri) $ renameFile - swapDocumentChangeUri (InR (InR (InR deleteFile))) = InR $ InR $ InR $ swapUri id deleteFile + swapDocumentChangeUri (InR (InR (InL renameFile))) = InR $ InR $ InL $ #newUri .~ f (renameFile ^. #newUri) $ renameFile + swapDocumentChangeUri (InR (InR (InR deleteFile))) = InR $ InR $ InR $ swapUri #uri deleteFile in e - & L.changes . _Just %~ swapKeys f - & L.documentChanges . _Just . traversed %~ swapDocumentChangeUri + & #changes . _Just %~ swapKeys f + & #documentChanges . _Just . traversed %~ swapDocumentChangeUri 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 :: L.HasUri b Uri => Lens' a b -> a -> a - swapUri lens x = - let newUri = f (x ^. lens . L.uri) - in (lens . L.uri) .~ newUri $ x + swapUri :: Lens' a Uri -> a -> a + swapUri lens x = x & lens %~ f -- \| Transforms rootUri/rootPath. transformInit :: InitializeParams -> InitializeParams @@ -104,5 +107,5 @@ mapUris f event = Just fp -> T.pack fp Nothing -> p in x - & L.rootUri . _L %~ f - & L.rootPath . _Just . _L %~ modifyRootPath + & #rootUri . #_InL %~ f + & #rootPath . _Just . #_InL %~ modifyRootPath diff --git a/lsp-test/src/Language/LSP/Test/Parsing.hs b/lsp-test/src/Language/LSP/Test/Parsing.hs index 334bb974..940b5248 100644 --- a/lsp-test/src/Language/LSP/Test/Parsing.hs +++ b/lsp-test/src/Language/LSP/Test/Parsing.hs @@ -32,7 +32,7 @@ import Data.GADT.Compare import Data.Text qualified as T import Data.Typeable import GHC.TypeLits (KnownSymbol, symbolVal) -import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Message qualified as LSP import Language.LSP.Test.Session {- $receiving @@ -68,17 +68,17 @@ import Language.LSP.Test.Session @since 0.5.2.0 -} -satisfy :: (FromServerMessage -> Bool) -> Session FromServerMessage +satisfy :: (LSP.FromServerMessage -> Bool) -> Session LSP.FromServerMessage satisfy pred = satisfyMaybe (\msg -> if pred msg then Just msg else Nothing) {- | Consumes and returns the result of the specified predicate if it returns `Just`. @since 0.6.1.0 -} -satisfyMaybe :: (FromServerMessage -> Maybe a) -> Session a +satisfyMaybe :: (LSP.FromServerMessage -> Maybe a) -> Session a satisfyMaybe pred = satisfyMaybeM (pure . pred) -satisfyMaybeM :: (FromServerMessage -> Session (Maybe a)) -> Session a +satisfyMaybeM :: (LSP.FromServerMessage -> Session (Maybe a)) -> Session a satisfyMaybeM pred = do skipTimeout <- overridingTimeout <$> get timeoutId <- getCurTimeoutId @@ -115,36 +115,36 @@ 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 (TMessage m) -message (SMethod_CustomMethod _) = error "message can't be used with CustomMethod, use customRequest or customNotification instead" +message :: LSP.SServerMethod m -> Session (LSP.TMessage m) +message (LSP.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 + LSP.FromServerMess m2 msg -> do + res <- LSP.mEqServer m1 m2 case res of Right HRefl -> pure msg Left _f -> Nothing _ -> Nothing -customRequest :: KnownSymbol s => Proxy s -> Session (TMessage (Method_CustomMethod s :: Method ServerToClient Request)) +customRequest :: KnownSymbol s => Proxy s -> Session (LSP.TMessage (LSP.Method_CustomMethod s :: LSP.Method LSP.ServerToClient LSP.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 + LSP.FromServerMess m1 msg -> case LSP.splitServerMethod m1 of + LSP.IsServerEither -> case msg of + LSP.ReqMess _ -> case m1 `geq` LSP.SMethod_CustomMethod p of Just Refl -> Just msg _ -> Nothing _ -> Nothing _ -> Nothing _ -> Nothing -customNotification :: KnownSymbol s => Proxy s -> Session (TMessage (Method_CustomMethod s :: Method ServerToClient Notification)) +customNotification :: KnownSymbol s => Proxy s -> Session (LSP.TMessage (LSP.Method_CustomMethod s :: LSP.Method LSP.ServerToClient LSP.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 + LSP.FromServerMess m1 msg -> case LSP.splitServerMethod m1 of + LSP.IsServerEither -> case msg of + LSP.NotMess _ -> case m1 `geq` LSP.SMethod_CustomMethod p of Just Refl -> Just msg _ -> Nothing _ -> Nothing @@ -152,78 +152,78 @@ customNotification p = _ -> Nothing -- | Matches if the message is a notification. -anyNotification :: Session FromServerMessage +anyNotification :: Session LSP.FromServerMessage anyNotification = named "Any notification" $ satisfy $ \case - FromServerMess m msg -> case splitServerMethod m of - IsServerNot -> True - IsServerEither -> case msg of - NotMess _ -> True + LSP.FromServerMess m msg -> case LSP.splitServerMethod m of + LSP.IsServerNot -> True + LSP.IsServerEither -> case msg of + LSP.NotMess _ -> True _ -> False _ -> False - FromServerRsp _ _ -> False + LSP.FromServerRsp _ _ -> False -- | Matches if the message is a request. -anyRequest :: Session FromServerMessage +anyRequest :: Session LSP.FromServerMessage anyRequest = named "Any request" $ satisfy $ \case - FromServerMess m _ -> case splitServerMethod m of - IsServerReq -> True + LSP.FromServerMess m _ -> case LSP.splitServerMethod m of + LSP.IsServerReq -> True _ -> False - FromServerRsp _ _ -> False + LSP.FromServerRsp _ _ -> False -- | Matches if the message is a response. -anyResponse :: Session FromServerMessage +anyResponse :: Session LSP.FromServerMessage anyResponse = named "Any response" $ satisfy $ \case - FromServerMess _ _ -> False - FromServerRsp _ _ -> True + LSP.FromServerMess _ _ -> False + LSP.FromServerRsp _ _ -> True -- | Matches a response coming from the server. -response :: SMethod (m :: Method ClientToServer Request) -> Session (TResponseMessage m) +response :: LSP.SMethod (m :: LSP.Method LSP.ClientToServer LSP.Request) -> Session (LSP.TResponseMessage m) response m1 = named (T.pack $ "Response for: " <> show m1) $ satisfyMaybe $ \case - FromServerRsp m2 msg -> do - HRefl <- runEq mEqClient m1 m2 + LSP.FromServerRsp m2 msg -> do + HRefl <- LSP.runEq LSP.mEqClient m1 m2 pure msg _ -> Nothing -- | Like 'response', but matches a response for a specific id. -responseForId :: SMethod (m :: Method ClientToServer Request) -> LspId m -> Session (TResponseMessage m) +responseForId :: LSP.SMethod (m :: LSP.Method LSP.ClientToServer LSP.Request) -> LSP.LspId m -> Session (LSP.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@(TResponseMessage _ lid' _) -> do - HRefl <- runEq mEqClient m m' + LSP.FromServerMess _ _ -> Nothing + LSP.FromServerRsp m' rspMsg@(LSP.TResponseMessage _ lid' _) -> do + HRefl <- LSP.runEq LSP.mEqClient m m' guard (Just lid == lid') pure rspMsg -- | Matches any type of message. -anyMessage :: Session FromServerMessage +anyMessage :: Session LSP.FromServerMessage anyMessage = satisfy (const True) -- | Matches if the message is a log message notification or a show message notification/request. -loggingNotification :: Session FromServerMessage +loggingNotification :: Session LSP.FromServerMessage loggingNotification = named "Logging notification" $ satisfy shouldSkip where - shouldSkip (FromServerMess SMethod_WindowLogMessage _) = True - shouldSkip (FromServerMess SMethod_WindowShowMessage _) = True - shouldSkip (FromServerMess SMethod_WindowShowMessageRequest _) = True - shouldSkip (FromServerMess SMethod_WindowShowDocument _) = True + shouldSkip (LSP.FromServerMess LSP.SMethod_WindowLogMessage _) = True + shouldSkip (LSP.FromServerMess LSP.SMethod_WindowShowMessage _) = True + shouldSkip (LSP.FromServerMess LSP.SMethod_WindowShowMessageRequest _) = True + shouldSkip (LSP.FromServerMess LSP.SMethod_WindowShowDocument _) = True shouldSkip _ = False -- | Matches if the message is a configuration request from the server. -configurationRequest :: Session FromServerMessage +configurationRequest :: Session LSP.FromServerMessage configurationRequest = named "Configuration request" $ satisfy shouldSkip where - shouldSkip (FromServerMess SMethod_WorkspaceConfiguration _) = True + shouldSkip (LSP.FromServerMess LSP.SMethod_WorkspaceConfiguration _) = True shouldSkip _ = False -loggingOrConfiguration :: Session FromServerMessage +loggingOrConfiguration :: Session LSP.FromServerMessage loggingOrConfiguration = loggingNotification <|> configurationRequest {- | Matches a 'Language.LSP.Types.TextDocumentPublishDiagnostics' (textDocument/publishDiagnostics) notification. -} -publishDiagnosticsNotification :: Session (TMessage Method_TextDocumentPublishDiagnostics) +publishDiagnosticsNotification :: Session (LSP.TMessage LSP.Method_TextDocumentPublishDiagnostics) publishDiagnosticsNotification = named "Publish diagnostics notification" $ satisfyMaybe $ \msg -> case msg of - FromServerMess SMethod_TextDocumentPublishDiagnostics diags -> Just diags + LSP.FromServerMess LSP.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 9263b65f..99726ada 100644 --- a/lsp-test/src/Language/LSP/Test/Session.hs +++ b/lsp-test/src/Language/LSP/Test/Session.hs @@ -5,10 +5,12 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE TypeInType #-} module Language.LSP.Test.Session ( Session(..) + , SessionConfig(..) , defaultConfig , SessionMessage(..) @@ -64,9 +66,9 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Maybe import Data.Function -import Language.LSP.Protocol.Types as LSP -import qualified Language.LSP.Protocol.Lens as L -import Language.LSP.Protocol.Message as LSP +import Language.LSP.Protocol.Types as LSP hiding (to) +import Language.LSP.Protocol.Message as LSP hiding (error) +import Language.LSP.Protocol.Lens import Language.LSP.VFS import Language.LSP.Test.Compat import Language.LSP.Test.Decoding @@ -331,11 +333,11 @@ updateStateC = awaitForever $ \msg -> do updateState msg case msg of FromServerMess SMethod_WindowWorkDoneProgressCreate req -> - sendMessage $ TResponseMessage "2.0" (Just $ req ^. L.id) (Right Null) + sendMessage $ TResponseMessage "2.0" (Just $ req.id) (Right Null) FromServerMess SMethod_WorkspaceApplyEdit r -> do - sendMessage $ TResponseMessage "2.0" (Just $ r ^. L.id) (Right $ ApplyWorkspaceEditResult True Nothing Nothing) + sendMessage $ TResponseMessage "2.0" (Just $ r.id) (Right $ ApplyWorkspaceEditResult True Nothing Nothing) FromServerMess SMethod_WorkspaceConfiguration r -> do - let requestedSections = mapMaybe (\i -> i ^? L.section . _Just) $ r ^. L.params . L.items + let requestedSections = mapMaybe (\i -> i ^? #section . _Just) $ r.params.items let o = curLspConfig state -- check for each requested section whether we have it let configsOrErrs = (flip fmap) requestedSections $ \section -> @@ -346,7 +348,7 @@ updateStateC = awaitForever $ \msg -> do let (errs, configs) = partitionEithers configsOrErrs -- we have to return exactly the number of sections requested, so if we can't find all of them then that's an error - sendMessage $ TResponseMessage "2.0" (Just $ r ^. L.id) $ + sendMessage $ TResponseMessage "2.0" (Just $ r.id) $ if null errs then (Right configs) else Left $ ResponseError (InL LSPErrorCodes_RequestFailed) ("No configuration for requested sections: " <> (T.pack $ show errs)) Nothing @@ -374,38 +376,39 @@ updateStateC = awaitForever $ \msg -> do -- extract Uri out from DocumentChange -- didn't put this in `lsp-types` because TH was getting in the way documentChangeUri :: DocumentChange -> Uri -documentChangeUri (InL x) = x ^. L.textDocument . L.uri -documentChangeUri (InR (InL x)) = x ^. L.uri -documentChangeUri (InR (InR (InL x))) = x ^. L.oldUri -documentChangeUri (InR (InR (InR x))) = x ^. L.uri +documentChangeUri (InL x) = x.textDocument.uri +documentChangeUri (InR (InL x)) = x.uri +documentChangeUri (InR (InR (InL x))) = x.oldUri +documentChangeUri (InR (InR (InR x))) = x.uri updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m) => FromServerMessage -> m () -updateState (FromServerMess SMethod_Progress req) = case req ^. L.params . L.value of - v | Just _ <- v ^? _workDoneProgressBegin -> - modify $ \s -> s { curProgressSessions = Set.insert (req ^. L.params . L.token) $ curProgressSessions s } - v | Just _ <- v ^? _workDoneProgressEnd -> - modify $ \s -> s { curProgressSessions = Set.delete (req ^. L.params . L.token) $ curProgressSessions s } +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 } + v | Just _ <- v ^? workDoneProgressEnd -> + modify $ \s -> s { curProgressSessions = Set.delete (req.params.token) $ curProgressSessions s } _ -> pure () -- Keep track of dynamic capability registration updateState (FromServerMess SMethod_ClientRegisterCapability req) = do let + params = req ^. #params regs :: [SomeRegistration] - regs = req ^.. L.params . L.registrations . traversed . to toSomeRegistration . _Just - let newRegs = (\sr@(SomeRegistration r) -> (r ^. L.id, sr)) <$> regs + regs = params ^.. #registrations . traversed . to toSomeRegistration . _Just + let newRegs = (\sr@(SomeRegistration r) -> (r.id, sr)) <$> regs modify $ \s -> s { curDynCaps = Map.union (Map.fromList newRegs) (curDynCaps s) } updateState (FromServerMess SMethod_ClientUnregisterCapability req) = do - let unRegs = (^. L.id) <$> req ^. L.params . L.unregisterations + let unRegs = (^. #id) <$> req.params.unregisterations modify $ \s -> let newCurDynCaps = foldr' Map.delete (curDynCaps s) unRegs in s { curDynCaps = newCurDynCaps } updateState (FromServerMess SMethod_TextDocumentPublishDiagnostics n) = do - let diags = n ^. L.params . L.diagnostics - doc = n ^. L.params . L.uri + let diags = n.params.diagnostics + doc = n.params.uri modify $ \s -> let newDiags = Map.insert (toNormalizedUri doc) diags (curDiagnostics s) in s { curDiagnostics = newDiags } @@ -413,15 +416,15 @@ updateState (FromServerMess SMethod_TextDocumentPublishDiagnostics n) = do updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do -- First, prefer the versioned documentChanges field - allChangeParams <- case r ^. L.params . L.edit . L.documentChanges of + allChangeParams <- case r.params.edit.documentChanges of 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 . _L . L.textDocument . _versionedTextDocumentIdentifier) bumpNewestVersion cs + cs' <- traverseOf (traverse . #_InL . #textDocument . versionedTextDocumentIdentifier) bumpNewestVersion cs return $ mapMaybe getParamsFromDocumentChange cs' -- Then fall back to the changes field - Nothing -> case r ^. L.params . L.edit . L.changes of + Nothing -> case r.params.edit.changes of Just cs -> do mapM_ checkIfNeedsOpened (Map.keys cs) concat <$> mapM (uncurry getChangeParams) (Map.toList cs) @@ -432,21 +435,21 @@ updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do let newVFS = flip execState (vfs s) $ changeFromServerVFS logger r return $ s { vfs = newVFS } - let groupedParams = groupBy (\a b -> a ^. L.textDocument == b ^. L.textDocument) allChangeParams + let groupedParams = groupBy (\a b -> a.textDocument == b.textDocument) allChangeParams mergedParams = map mergeParams groupedParams -- TODO: Don't do this when replaying a session forM_ mergedParams (sendMessage . TNotificationMessage "2.0" SMethod_TextDocumentDidChange) -- Update VFS to new document versions - let sortedVersions = map (sortBy (compare `on` (^. L.textDocument . L.version))) groupedParams - latestVersions = map ((^. L.textDocument) . last) sortedVersions + let sortedVersions = map (sortBy (compare `on` (^. #textDocument . #version))) groupedParams + latestVersions = map ((^. #textDocument) . last) sortedVersions forM_ latestVersions $ \(VersionedTextDocumentIdentifier uri v) -> modify $ \s -> let oldVFS = vfs s update (VirtualFile _ file_ver t) = VirtualFile v (file_ver +1) t - newVFS = oldVFS & vfsMap . ix (toNormalizedUri uri) %~ update + newVFS = oldVFS & #vfsMap . ix (toNormalizedUri uri) %~ update in s { vfs = newVFS } where @@ -455,7 +458,7 @@ updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do oldVFS <- vfs <$> get -- if its not open, open it - unless (has (vfsMap . ix (toNormalizedUri uri)) oldVFS) $ do + unless (has (#vfsMap . ix (toNormalizedUri uri)) oldVFS) $ do let fp = fromJust $ uriToFilePath uri contents <- liftIO $ T.readFile fp let item = TextDocumentItem (filePathToUri fp) "" 0 contents @@ -468,12 +471,12 @@ updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do getParamsFromTextDocumentEdit :: TextDocumentEdit -> Maybe DidChangeTextDocumentParams getParamsFromTextDocumentEdit (TextDocumentEdit docId edits) = - DidChangeTextDocumentParams <$> docId ^? _versionedTextDocumentIdentifier <*> pure (map editToChangeEvent edits) + DidChangeTextDocumentParams <$> docId ^? versionedTextDocumentIdentifier <*> pure (map editToChangeEvent edits) -- TODO: move somewhere reusable editToChangeEvent :: TextEdit |? AnnotatedTextEdit -> TextDocumentContentChangeEvent - editToChangeEvent (InR e) = TextDocumentContentChangeEvent $ InL $ TextDocumentContentChangePartial { _range = (e ^. L.range) , _rangeLength = Nothing , _text = (e ^. L.newText) } - editToChangeEvent (InL e) = TextDocumentContentChangeEvent $ InL $ TextDocumentContentChangePartial { _range = (e ^. L.range) , _rangeLength = Nothing , _text = (e ^. L.newText) } + editToChangeEvent (InR e) = TextDocumentContentChangeEvent $ InL $ TextDocumentContentChangePartial { range = (e.range) , rangeLength = Nothing , text = (e.newText) } + editToChangeEvent (InL e) = TextDocumentContentChangeEvent $ InL $ TextDocumentContentChangePartial { range = (e.range) , rangeLength = Nothing , text = (e.newText) } getParamsFromDocumentChange :: DocumentChange -> Maybe DidChangeTextDocumentParams getParamsFromDocumentChange (InL textDocumentEdit) = getParamsFromTextDocumentEdit textDocumentEdit @@ -486,20 +489,20 @@ updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do -- where n is the current version textDocumentVersions uri = do vfs <- vfs <$> get - let curVer = fromMaybe 0 $ vfs ^? vfsMap . ix (toNormalizedUri uri) . lsp_version + let curVer = fromMaybe 0 $ vfs ^? #vfsMap . ix (toNormalizedUri uri) . #lsp_version pure $ map (VersionedTextDocumentIdentifier uri) [curVer + 1..] textDocumentEdits uri edits = do vers <- textDocumentVersions uri - pure $ map (\(v, e) -> TextDocumentEdit (review _versionedTextDocumentIdentifier v) [InL e]) $ zip vers edits + pure $ map (\(v, e) -> TextDocumentEdit (review versionedTextDocumentIdentifier v) [InL e]) $ zip vers 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 . (^. L.contentChanges)) params)) - in DidChangeTextDocumentParams (head params ^. L.textDocument) events + mergeParams params = let events = concat (toList (map (toList . (^. #contentChanges)) params)) + 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 1db2a559..30bc5e3d 100644 --- a/lsp-test/test/DummyServer.hs +++ b/lsp-test/test/DummyServer.hs @@ -13,7 +13,7 @@ import Data.Map.Strict qualified as M import Data.Proxy import Data.String import Data.Text qualified as T -import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Message hiding (error) import Language.LSP.Protocol.Types import Language.LSP.Server import System.Directory diff --git a/lsp-test/test/Test.hs b/lsp-test/test/Test.hs index 2f0db501..0bcd0c2c 100644 --- a/lsp-test/test/Test.hs +++ b/lsp-test/test/Test.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeInType #-} @@ -12,16 +14,16 @@ import Data.Aeson import Data.Aeson qualified as J import Data.Default import Data.Either +import Data.Generics.Labels () import Data.List.Extra import Data.Map.Strict qualified as M import Data.Maybe import Data.Proxy import Data.Text qualified as T import DummyServer -import Language.LSP.Protocol.Lens qualified as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types -import Language.LSP.Test +import Language.LSP.Test as Test import System.Directory import System.FilePath import System.Timeout @@ -39,7 +41,7 @@ main = hspec $ around withDummyServer $ do in session `shouldThrow` anySessionException it "initializeResponse" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do rsp <- initializeResponse - liftIO $ rsp ^. L.result `shouldSatisfy` isRight + liftIO $ rsp.result `shouldSatisfy` isRight it "runSessionWithConfig" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ return () @@ -51,7 +53,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 SMethod_WorkspaceApplyEdit) + withTimeout 5 $ skipManyTill anyMessage (Test.message SMethod_WorkspaceApplyEdit) in -- wait just a bit longer than 5 seconds so we have time -- to open the document timeout 6000000 sesh `shouldThrow` anySessionException @@ -91,7 +93,7 @@ main = hspec $ around withDummyServer $ do withTimeout 10 $ liftIO $ threadDelay 7000000 getDocumentSymbols doc -- should now timeout - skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) + skipManyTill anyMessage (Test.message SMethod_WorkspaceApplyEdit) isTimeout (Timeout _) = True isTimeout _ = False in sesh `shouldThrow` isTimeout @@ -99,7 +101,7 @@ main = hspec $ around withDummyServer $ do describe "SessionException" $ do it "throw on time out" $ \(hin, hout) -> let sesh = runSessionWithHandles hin hout (def{messageTimeout = 10}) fullCaps "." $ do - _ <- message SMethod_WorkspaceApplyEdit + _ <- Test.message SMethod_WorkspaceApplyEdit return () in sesh `shouldThrow` anySessionException @@ -131,11 +133,11 @@ main = hspec $ around withDummyServer $ do configurationRequest -- initialized configuration request let requestConfig = do resp <- request (SMethod_CustomMethod (Proxy @"getConfig")) J.Null - case resp ^? L.result . _Right of - Just val -> case fromJSON @Int val of + case resp.result of + Right val -> case fromJSON @Int val of J.Success v -> pure v J.Error err -> fail err - Nothing -> fail "no result" + Left _ -> fail "no result" c <- requestConfig -- from the server definition @@ -154,16 +156,16 @@ main = hspec $ around withDummyServer $ do doc <- openDoc "test/data/refactor/Main.hs" "haskell" VersionedTextDocumentIdentifier _ beforeVersion <- getVersionedDoc doc - let args = toJSON (VersionedTextDocumentIdentifier (doc ^. L.uri) beforeVersion) + let args = toJSON (VersionedTextDocumentIdentifier (doc.uri) beforeVersion) reqParams = ExecuteCommandParams Nothing "doAVersionedEdit" (Just [args]) request_ SMethod_WorkspaceExecuteCommand reqParams - editReq <- message SMethod_WorkspaceApplyEdit + editReq <- Test.message SMethod_WorkspaceApplyEdit liftIO $ do let Just [InL (TextDocumentEdit vdoc [InL edit_])] = - editReq ^. L.params . L.edit . L.documentChanges - vdoc `shouldBe` OptionalVersionedTextDocumentIdentifier (doc ^. L.uri) (InL beforeVersion) + editReq.params.edit.documentChanges + vdoc `shouldBe` OptionalVersionedTextDocumentIdentifier (doc.uri) (InL beforeVersion) edit_ `shouldBe` TextEdit (Range (Position 0 0) (Position 0 5)) "howdy" change <- customNotification (Proxy @"custom/textDocument/didChange") @@ -183,15 +185,15 @@ main = hspec $ around withDummyServer $ do runSessionWithHandles hin hout def fullCaps "." $ do doc <- openDoc "test/data/refactor/Main.hs" "haskell" - let args = toJSON (doc ^. L.uri) + let args = toJSON (doc.uri) reqParams = ExecuteCommandParams Nothing "doAnEdit" (Just [args]) request_ SMethod_WorkspaceExecuteCommand reqParams - editReq <- message SMethod_WorkspaceApplyEdit + editReq <- Test.message SMethod_WorkspaceApplyEdit liftIO $ do - let (Just cs) = editReq ^. L.params . L.edit . L.changes + let (Just cs) = editReq.params.edit.changes [(u, es)] = M.toList cs - u `shouldBe` doc ^. L.uri + u `shouldBe` doc.uri es `shouldBe` [TextEdit (Range (Position 0 0) (Position 0 5)) "howdy"] contents <- documentContents doc liftIO $ contents `shouldBe` "howdy:: IO Int\nmain = return (42)\n" @@ -201,7 +203,7 @@ main = hspec $ around withDummyServer $ do runSessionWithHandles hin hout def fullCaps "." $ do doc <- openDoc "test/data/refactor/Main.hs" "haskell" - let args = toJSON (doc ^. L.uri) + let args = toJSON (doc.uri) reqParams = ExecuteCommandParams Nothing "doAnEdit" (Just [args]) request_ SMethod_WorkspaceExecuteCommand reqParams contents <- getDocumentEdit doc @@ -213,7 +215,7 @@ main = hspec $ around withDummyServer $ do waitForDiagnostics [InR action] <- getCodeActions doc (Range (Position 0 0) (Position 0 2)) actions <- getCodeActions doc (Range (Position 1 14) (Position 1 18)) - liftIO $ action ^. L.title `shouldBe` "Delete this" + liftIO $ action.title `shouldBe` "Delete this" liftIO $ actions `shouldSatisfy` null describe "getAllCodeActions" $ @@ -223,8 +225,8 @@ main = hspec $ around withDummyServer $ do actions <- getAllCodeActions doc liftIO $ do let [InR action] = actions - action ^. L.title `shouldBe` "Delete this" - action ^. L.command . _Just . L.command `shouldBe` "deleteThis" + action.title `shouldBe` "Delete this" + action ^. #command . _Just . #command `shouldBe` "deleteThis" describe "getDocumentSymbols" $ it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do @@ -233,21 +235,21 @@ main = hspec $ around withDummyServer $ do Right (mainSymbol : _) <- getDocumentSymbols doc liftIO $ do - mainSymbol ^. L.name `shouldBe` "foo" - mainSymbol ^. L.kind `shouldBe` SymbolKind_Object - mainSymbol ^. L.range `shouldBe` mkRange 0 0 3 6 + mainSymbol.name `shouldBe` "foo" + 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 fullCaps "." $ do doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" VersionedTextDocumentIdentifier _ oldVersion <- getVersionedDoc doc let edit = TextEdit (Range (Position 1 1) (Position 1 3)) "foo" - VersionedTextDocumentIdentifier _ newVersion <- applyEdit doc edit + VersionedTextDocumentIdentifier _ newVersion <- Test.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" let edit = TextEdit (Range (Position 0 0) (Position 0 2)) "foo" - applyEdit doc edit + Test.applyEdit doc edit contents <- documentContents doc liftIO $ contents `shouldSatisfy` T.isPrefixOf "foodule" @@ -257,7 +259,7 @@ main = hspec $ around withDummyServer $ do comps <- getCompletions doc (Position 5 5) let item = head comps - liftIO $ item ^. L.label `shouldBe` "foo" + liftIO $ item.label `shouldBe` "foo" -- describe "getReferences" $ -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do @@ -290,8 +292,8 @@ main = hspec $ around withDummyServer $ do openDoc "test/data/Error.hs" "haskell" [diag] <- waitForDiagnosticsSource "dummy-server" liftIO $ do - diag ^. L.severity `shouldBe` Just DiagnosticSeverity_Warning - diag ^. L.source `shouldBe` Just "dummy-server" + diag.severity `shouldBe` Just DiagnosticSeverity_Warning + diag.source `shouldBe` Just "dummy-server" -- describe "rename" $ do -- it "works" $ \(hin, hout) -> pendingWith "HaRe not in hie-bios yet" @@ -358,7 +360,7 @@ main = hspec $ around withDummyServer $ do pred _ = Nothing :: Maybe String -- We expect a window/logMessage from the server, but -- not a textDocument/publishDiagnostics. - result <- satisfyMaybe pred <|> (message SMethod_WindowLogMessage *> pure "no match") + result <- satisfyMaybe pred <|> (Test.message SMethod_WindowLogMessage *> pure "no match") liftIO $ result `shouldBe` "no match" describe "ignoreLogNotifications" $ @@ -373,11 +375,11 @@ main = hspec $ around withDummyServer $ do loggingNotification -- initialized log message createDoc ".register" "haskell" "" setIgnoringRegistrationRequests False - message SMethod_ClientRegisterCapability + Test.message SMethod_ClientRegisterCapability doc <- createDoc "Foo.watch" "haskell" "" - msg <- message SMethod_WindowLogMessage - liftIO $ msg ^. L.params . L.message `shouldBe` "got workspace/didChangeWatchedFiles" + msg <- Test.message SMethod_WindowLogMessage + liftIO $ msg.params.message `shouldBe` "got workspace/didChangeWatchedFiles" -- Look for the registration, we might have one for didChangeConfiguration in there too registeredCaps <- getRegisteredCapabilities @@ -396,7 +398,7 @@ main = hspec $ around withDummyServer $ do -- now unregister it by sending a specific createDoc createDoc ".unregister" "haskell" "" - message SMethod_ClientUnregisterCapability + Test.message SMethod_ClientUnregisterCapability createDoc "Bar.watch" "haskell" "" void $ sendRequest SMethod_TextDocumentHover $ HoverParams doc (Position 0 0) Nothing @@ -408,15 +410,15 @@ main = hspec $ around withDummyServer $ do setIgnoringRegistrationRequests False createDoc ".register.abs" "haskell" "" - message SMethod_ClientRegisterCapability + Test.message SMethod_ClientRegisterCapability doc <- createDoc (curDir "Foo.watch") "haskell" "" - msg <- message SMethod_WindowLogMessage - liftIO $ msg ^. L.params . L.message `shouldBe` "got workspace/didChangeWatchedFiles" + msg <- Test.message SMethod_WindowLogMessage + liftIO $ msg.params.message `shouldBe` "got workspace/didChangeWatchedFiles" -- now unregister it by sending a specific createDoc createDoc ".unregister.abs" "haskell" "" - message SMethod_ClientUnregisterCapability + Test.message SMethod_ClientUnregisterCapability createDoc (curDir "Bar.watch") "haskell" "" void $ sendRequest SMethod_TextDocumentHover $ HoverParams doc (Position 0 0) Nothing @@ -438,7 +440,7 @@ main = hspec $ around withDummyServer $ do Nothing it "prepare works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do rsp <- prepareCallHierarchy (params workPos) - liftIO $ head rsp ^. L.range `shouldBe` Range (Position 2 3) (Position 4 5) + liftIO $ (head rsp).range `shouldBe` Range (Position 2 3) (Position 4 5) it "prepare not works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do rsp <- prepareCallHierarchy (params notWorkPos) liftIO $ rsp `shouldBe` [] @@ -453,4 +455,4 @@ main = hspec $ around withDummyServer $ do it "full works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do let doc = TextDocumentIdentifier (Uri "") InL toks <- getSemanticTokens doc - liftIO $ toks ^. L.data_ `shouldBe` [0, 1, 2, 1, 0] + liftIO $ toks.data_ `shouldBe` [0, 1, 2, 1, 0] diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/AnnotatedTextEdit.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/AnnotatedTextEdit.hs index 6d9cd95e..468b234e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/AnnotatedTextEdit.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/AnnotatedTextEdit.hs @@ -30,16 +30,16 @@ 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 + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| The string to be inserted. For delete operations use an empty string. -} - _newText :: Data.Text.Text + newText :: Data.Text.Text , {-| The actual identifier of the change annotation -} - _annotationId :: Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier + annotationId :: Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditParams.hs index 6c190b70..b2a38526 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditParams.hs @@ -28,11 +28,11 @@ data ApplyWorkspaceEditParams = ApplyWorkspaceEditParams presented in the user interface for example on an undo stack to undo the workspace edit. -} - _label :: (Maybe Data.Text.Text) + label :: (Maybe Data.Text.Text) , {-| The edits to apply. -} - _edit :: Language.LSP.Protocol.Internal.Types.WorkspaceEdit.WorkspaceEdit + edit :: Language.LSP.Protocol.Internal.Types.WorkspaceEdit.WorkspaceEdit } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditResult.hs index a580ff5b..bb3569b5 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditResult.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ApplyWorkspaceEditResult.hs @@ -27,19 +27,19 @@ data ApplyWorkspaceEditResult = ApplyWorkspaceEditResult { {-| Indicates whether the edit was applied or not. -} - _applied :: Bool + 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) + 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) + failedChange :: (Maybe Language.LSP.Protocol.Types.Common.UInt) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/BaseSymbolInformation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/BaseSymbolInformation.hs index 585e937d..ea660f63 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/BaseSymbolInformation.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/BaseSymbolInformation.hs @@ -27,24 +27,24 @@ data BaseSymbolInformation = BaseSymbolInformation { {-| The name of this symbol. -} - _name :: Data.Text.Text + name :: Data.Text.Text , {-| The kind of this symbol. -} - _kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind + 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]) + 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) + containerName :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyClientCapabilities.hs index 6360fa9d..def10db6 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyClientCapabilities.hs @@ -26,7 +26,7 @@ data CallHierarchyClientCapabilities = CallHierarchyClientCapabilities the client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCall.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCall.hs index 1d2bbb18..4b5c8bb8 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCall.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCall.hs @@ -28,12 +28,12 @@ data CallHierarchyIncomingCall = CallHierarchyIncomingCall { {-| The item that makes the call. -} - _from :: Language.LSP.Protocol.Internal.Types.CallHierarchyItem.CallHierarchyItem + 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] + fromRanges :: [Language.LSP.Protocol.Internal.Types.Range.Range] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCallsParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCallsParams.hs index a859f148..56ac68ab 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCallsParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyIncomingCallsParams.hs @@ -28,16 +28,16 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| -} - _item :: Language.LSP.Protocol.Internal.Types.CallHierarchyItem.CallHierarchyItem + item :: Language.LSP.Protocol.Internal.Types.CallHierarchyItem.CallHierarchyItem } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyItem.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyItem.hs index cf9f89d7..5ba9a0e2 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyItem.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyItem.hs @@ -33,37 +33,37 @@ data CallHierarchyItem = CallHierarchyItem { {-| The name of this item. -} - _name :: Data.Text.Text + name :: Data.Text.Text , {-| The kind of this item. -} - _kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind + kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind , {-| Tags for this item. -} - _tags :: (Maybe [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag]) + 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) + detail :: (Maybe Data.Text.Text) , {-| The resource identifier of this item. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + 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 + 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 + 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) + data_ :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOptions.hs index 89449c80..b498c8b0 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOptions.hs @@ -26,7 +26,7 @@ data CallHierarchyOptions = CallHierarchyOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCall.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCall.hs index b061208c..9fcf365c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCall.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCall.hs @@ -28,13 +28,13 @@ data CallHierarchyOutgoingCall = CallHierarchyOutgoingCall { {-| The item that is called. -} - _to :: Language.LSP.Protocol.Internal.Types.CallHierarchyItem.CallHierarchyItem + 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] + fromRanges :: [Language.LSP.Protocol.Internal.Types.Range.Range] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCallsParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCallsParams.hs index 82fed20c..4c929a85 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCallsParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyOutgoingCallsParams.hs @@ -28,16 +28,16 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| -} - _item :: Language.LSP.Protocol.Internal.Types.CallHierarchyItem.CallHierarchyItem + item :: Language.LSP.Protocol.Internal.Types.CallHierarchyItem.CallHierarchyItem } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyPrepareParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyPrepareParams.hs index fb4a09d3..b54ccd6f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyPrepareParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyPrepareParams.hs @@ -29,15 +29,15 @@ data CallHierarchyPrepareParams = CallHierarchyPrepareParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyRegistrationOptions.hs index fe810709..c9392f7b 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CallHierarchyRegistrationOptions.hs @@ -29,16 +29,16 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CancelParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CancelParams.hs index ade78d77..adca00ff 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CancelParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CancelParams.hs @@ -25,7 +25,7 @@ data CancelParams = CancelParams { {-| The request id to cancel. -} - _id :: (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Data.Text.Text) + id :: (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotation.hs index 19a646dd..f014cc67 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotation.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotation.hs @@ -28,17 +28,17 @@ data ChangeAnnotation = ChangeAnnotation A human-readable string describing the actual change. The string is rendered prominent in the user interface. -} - _label :: Data.Text.Text + label :: Data.Text.Text , {-| A flag which indicates that user confirmation is needed before applying the change. -} - _needsConfirmation :: (Maybe Bool) + needsConfirmation :: (Maybe Bool) , {-| A human-readable string which is rendered less prominent in the user interface. -} - _description :: (Maybe Data.Text.Text) + description :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotationsSupportOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotationsSupportOptions.hs index 323bac1f..2ed86620 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotationsSupportOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ChangeAnnotationsSupportOptions.hs @@ -27,7 +27,7 @@ data ChangeAnnotationsSupportOptions = ChangeAnnotationsSupportOptions for instance all edits labelled with "Changes in Strings" would be a tree node. -} - _groupsOnLabel :: (Maybe Bool) + groupsOnLabel :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCapabilities.hs index c02bf5b3..a6373c6c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCapabilities.hs @@ -30,31 +30,31 @@ data ClientCapabilities = ClientCapabilities { {-| Workspace specific client capabilities. -} - _workspace :: (Maybe Language.LSP.Protocol.Internal.Types.WorkspaceClientCapabilities.WorkspaceClientCapabilities) + workspace :: (Maybe Language.LSP.Protocol.Internal.Types.WorkspaceClientCapabilities.WorkspaceClientCapabilities) , {-| Text document specific client capabilities. -} - _textDocument :: (Maybe Language.LSP.Protocol.Internal.Types.TextDocumentClientCapabilities.TextDocumentClientCapabilities) + 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) + notebookDocument :: (Maybe Language.LSP.Protocol.Internal.Types.NotebookDocumentClientCapabilities.NotebookDocumentClientCapabilities) , {-| Window specific client capabilities. -} - _window :: (Maybe Language.LSP.Protocol.Internal.Types.WindowClientCapabilities.WindowClientCapabilities) + 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) + general :: (Maybe Language.LSP.Protocol.Internal.Types.GeneralClientCapabilities.GeneralClientCapabilities) , {-| Experimental client capabilities. -} - _experimental :: (Maybe Data.Aeson.Value) + experimental :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCodeActionKindOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCodeActionKindOptions.hs index 0e925e93..f66fd1f1 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCodeActionKindOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCodeActionKindOptions.hs @@ -29,7 +29,7 @@ data ClientCodeActionKindOptions = ClientCodeActionKindOptions handle values outside its set gracefully and falls back to a default value when unknown. -} - _valueSet :: [Language.LSP.Protocol.Internal.Types.CodeActionKind.CodeActionKind] + valueSet :: [Language.LSP.Protocol.Internal.Types.CodeActionKind.CodeActionKind] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCodeActionLiteralOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCodeActionLiteralOptions.hs index a9b424d3..31fc5f5e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCodeActionLiteralOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCodeActionLiteralOptions.hs @@ -27,7 +27,7 @@ data ClientCodeActionLiteralOptions = ClientCodeActionLiteralOptions The code action kind is support with the following value set. -} - _codeActionKind :: Language.LSP.Protocol.Internal.Types.ClientCodeActionKindOptions.ClientCodeActionKindOptions + codeActionKind :: Language.LSP.Protocol.Internal.Types.ClientCodeActionKindOptions.ClientCodeActionKindOptions } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCodeActionResolveOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCodeActionResolveOptions.hs index cd1eacd7..05588a68 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCodeActionResolveOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCodeActionResolveOptions.hs @@ -26,7 +26,7 @@ data ClientCodeActionResolveOptions = ClientCodeActionResolveOptions { {-| The properties that a client can resolve lazily. -} - _properties :: [Data.Text.Text] + properties :: [Data.Text.Text] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemInsertTextModeOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemInsertTextModeOptions.hs index 1308bb7a..e705ff13 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemInsertTextModeOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemInsertTextModeOptions.hs @@ -26,7 +26,7 @@ data ClientCompletionItemInsertTextModeOptions = ClientCompletionItemInsertTextM { {-| -} - _valueSet :: [Language.LSP.Protocol.Internal.Types.InsertTextMode.InsertTextMode] + valueSet :: [Language.LSP.Protocol.Internal.Types.InsertTextMode.InsertTextMode] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemOptions.hs index eaa01b41..945dbc81 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemOptions.hs @@ -34,24 +34,24 @@ data ClientCompletionItemOptions = ClientCompletionItemOptions the end of the snippet. Placeholders with equal identifiers are linked, that is typing in one will update others too. -} - _snippetSupport :: (Maybe Bool) + snippetSupport :: (Maybe Bool) , {-| Client supports commit characters on a completion item. -} - _commitCharactersSupport :: (Maybe Bool) + commitCharactersSupport :: (Maybe Bool) , {-| Client supports the following content formats for the documentation property. The order describes the preferred format of the client. -} - _documentationFormat :: (Maybe [Language.LSP.Protocol.Internal.Types.MarkupKind.MarkupKind]) + documentationFormat :: (Maybe [Language.LSP.Protocol.Internal.Types.MarkupKind.MarkupKind]) , {-| Client supports the deprecated property on a completion item. -} - _deprecatedSupport :: (Maybe Bool) + deprecatedSupport :: (Maybe Bool) , {-| Client supports the preselect property on a completion item. -} - _preselectSupport :: (Maybe Bool) + 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 @@ -60,14 +60,14 @@ data ClientCompletionItemOptions = ClientCompletionItemOptions @since 3.15.0 -} - _tagSupport :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionItemTagOptions.CompletionItemTagOptions) + tagSupport :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionItemTagOptions.CompletionItemTagOptions) , {-| Client support insert replace edit to control different behavior if a completion item is inserted in the text or should replace text. @since 3.16.0 -} - _insertReplaceSupport :: (Maybe Bool) + 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` @@ -75,7 +75,7 @@ data ClientCompletionItemOptions = ClientCompletionItemOptions @since 3.16.0 -} - _resolveSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientCompletionItemResolveOptions.ClientCompletionItemResolveOptions) + resolveSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientCompletionItemResolveOptions.ClientCompletionItemResolveOptions) , {-| The client supports the `insertTextMode` property on a completion item to override the whitespace handling mode @@ -83,14 +83,14 @@ data ClientCompletionItemOptions = ClientCompletionItemOptions @since 3.16.0 -} - _insertTextModeSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientCompletionItemInsertTextModeOptions.ClientCompletionItemInsertTextModeOptions) + insertTextModeSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientCompletionItemInsertTextModeOptions.ClientCompletionItemInsertTextModeOptions) , {-| The client has support for completion item label details (see also `CompletionItemLabelDetails`). @since 3.17.0 -} - _labelDetailsSupport :: (Maybe Bool) + labelDetailsSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemOptionsKind.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemOptionsKind.hs index 4a2b689a..0dac155d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemOptionsKind.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemOptionsKind.hs @@ -33,7 +33,7 @@ data ClientCompletionItemOptionsKind = ClientCompletionItemOptionsKind the completion items kinds from `Text` to `Reference` as defined in the initial version of the protocol. -} - _valueSet :: (Maybe [Language.LSP.Protocol.Internal.Types.CompletionItemKind.CompletionItemKind]) + valueSet :: (Maybe [Language.LSP.Protocol.Internal.Types.CompletionItemKind.CompletionItemKind]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemResolveOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemResolveOptions.hs index 06faf781..1c8e85d4 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemResolveOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientCompletionItemResolveOptions.hs @@ -26,7 +26,7 @@ data ClientCompletionItemResolveOptions = ClientCompletionItemResolveOptions { {-| The properties that a client can resolve lazily. -} - _properties :: [Data.Text.Text] + properties :: [Data.Text.Text] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientDiagnosticsTagOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientDiagnosticsTagOptions.hs index 952d8eff..ef9b9ab9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientDiagnosticsTagOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientDiagnosticsTagOptions.hs @@ -26,7 +26,7 @@ data ClientDiagnosticsTagOptions = ClientDiagnosticsTagOptions { {-| The tags supported by the client. -} - _valueSet :: [Language.LSP.Protocol.Internal.Types.DiagnosticTag.DiagnosticTag] + valueSet :: [Language.LSP.Protocol.Internal.Types.DiagnosticTag.DiagnosticTag] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientFoldingRangeKindOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientFoldingRangeKindOptions.hs index 2fb1f5a3..273ae2dc 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientFoldingRangeKindOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientFoldingRangeKindOptions.hs @@ -29,7 +29,7 @@ data ClientFoldingRangeKindOptions = ClientFoldingRangeKindOptions handle values outside its set gracefully and falls back to a default value when unknown. -} - _valueSet :: (Maybe [Language.LSP.Protocol.Internal.Types.FoldingRangeKind.FoldingRangeKind]) + valueSet :: (Maybe [Language.LSP.Protocol.Internal.Types.FoldingRangeKind.FoldingRangeKind]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientFoldingRangeOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientFoldingRangeOptions.hs index 72b41348..787fe7d9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientFoldingRangeOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientFoldingRangeOptions.hs @@ -28,7 +28,7 @@ data ClientFoldingRangeOptions = ClientFoldingRangeOptions @since 3.17.0 -} - _collapsedText :: (Maybe Bool) + collapsedText :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientInfo.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientInfo.hs index c99e2786..d5c9b4d6 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientInfo.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientInfo.hs @@ -29,11 +29,11 @@ data ClientInfo = ClientInfo { {-| The name of the client as defined by the client. -} - _name :: Data.Text.Text + name :: Data.Text.Text , {-| The client's version as defined by the client. -} - _version :: (Maybe Data.Text.Text) + version :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientInlayHintResolveOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientInlayHintResolveOptions.hs index 50cc0fc5..06ec953d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientInlayHintResolveOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientInlayHintResolveOptions.hs @@ -26,7 +26,7 @@ data ClientInlayHintResolveOptions = ClientInlayHintResolveOptions { {-| The properties that a client can resolve lazily. -} - _properties :: [Data.Text.Text] + properties :: [Data.Text.Text] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSemanticTokensRequestFullDelta.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSemanticTokensRequestFullDelta.hs index 3808cb7b..791c20f9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSemanticTokensRequestFullDelta.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSemanticTokensRequestFullDelta.hs @@ -26,7 +26,7 @@ data ClientSemanticTokensRequestFullDelta = ClientSemanticTokensRequestFullDelta The client will send the `textDocument/semanticTokens/full/delta` request if the server provides a corresponding handler. -} - _delta :: (Maybe Bool) + delta :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSemanticTokensRequestOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSemanticTokensRequestOptions.hs index 619861de..a5613d54 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSemanticTokensRequestOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSemanticTokensRequestOptions.hs @@ -28,12 +28,12 @@ data ClientSemanticTokensRequestOptions = ClientSemanticTokensRequestOptions The client will send the `textDocument/semanticTokens/range` request if the server provides a corresponding handler. -} - _range :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Row.Rec Row.Empty))) + range :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Row.Rec Row.Empty))) , {-| The client will send the `textDocument/semanticTokens/full` request if the server provides a corresponding handler. -} - _full :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.ClientSemanticTokensRequestFullDelta.ClientSemanticTokensRequestFullDelta)) + full :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.ClientSemanticTokensRequestFullDelta.ClientSemanticTokensRequestFullDelta)) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientShowMessageActionItemOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientShowMessageActionItemOptions.hs index 2f96649c..27ab5737 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientShowMessageActionItemOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientShowMessageActionItemOptions.hs @@ -27,7 +27,7 @@ data ClientShowMessageActionItemOptions = ClientShowMessageActionItemOptions are preserved and send back to the server in the request's response. -} - _additionalPropertiesSupport :: (Maybe Bool) + additionalPropertiesSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSignatureInformationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSignatureInformationOptions.hs index 87d54e10..58ae8a09 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSignatureInformationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSignatureInformationOptions.hs @@ -28,18 +28,18 @@ data ClientSignatureInformationOptions = ClientSignatureInformationOptions Client supports the following content formats for the documentation property. The order describes the preferred format of the client. -} - _documentationFormat :: (Maybe [Language.LSP.Protocol.Internal.Types.MarkupKind.MarkupKind]) + documentationFormat :: (Maybe [Language.LSP.Protocol.Internal.Types.MarkupKind.MarkupKind]) , {-| Client capabilities specific to parameter information. -} - _parameterInformation :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSignatureParameterInformationOptions.ClientSignatureParameterInformationOptions) + parameterInformation :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSignatureParameterInformationOptions.ClientSignatureParameterInformationOptions) , {-| The client supports the `activeParameter` property on `SignatureInformation` literal. @since 3.16.0 -} - _activeParameterSupport :: (Maybe Bool) + activeParameterSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSignatureParameterInformationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSignatureParameterInformationOptions.hs index 9dd8f5a9..bb2a547e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSignatureParameterInformationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSignatureParameterInformationOptions.hs @@ -28,7 +28,7 @@ data ClientSignatureParameterInformationOptions = ClientSignatureParameterInform @since 3.14.0 -} - _labelOffsetSupport :: (Maybe Bool) + labelOffsetSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSymbolKindOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSymbolKindOptions.hs index 456bd447..9f4da66a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSymbolKindOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSymbolKindOptions.hs @@ -33,7 +33,7 @@ data ClientSymbolKindOptions = ClientSymbolKindOptions the symbol kinds from `File` to `Array` as defined in the initial version of the protocol. -} - _valueSet :: (Maybe [Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind]) + valueSet :: (Maybe [Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSymbolResolveOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSymbolResolveOptions.hs index 10c7b885..79eb7846 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSymbolResolveOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSymbolResolveOptions.hs @@ -27,7 +27,7 @@ data ClientSymbolResolveOptions = ClientSymbolResolveOptions The properties that a client can resolve lazily. Usually `location.range` -} - _properties :: [Data.Text.Text] + properties :: [Data.Text.Text] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSymbolTagOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSymbolTagOptions.hs index 42805260..77bc6b74 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSymbolTagOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ClientSymbolTagOptions.hs @@ -26,7 +26,7 @@ data ClientSymbolTagOptions = ClientSymbolTagOptions { {-| The tags supported by the client. -} - _valueSet :: [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag] + valueSet :: [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeAction.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeAction.hs index f2d9932b..d3df1733 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeAction.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeAction.hs @@ -34,17 +34,17 @@ data CodeAction = CodeAction { {-| A short, human-readable, title for this code action. -} - _title :: Data.Text.Text + title :: Data.Text.Text , {-| The kind of the code action. Used to filter code actions. -} - _kind :: (Maybe Language.LSP.Protocol.Internal.Types.CodeActionKind.CodeActionKind) + 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]) + 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. @@ -54,7 +54,7 @@ data CodeAction = CodeAction @since 3.15.0 -} - _isPreferred :: (Maybe Bool) + isPreferred :: (Maybe Bool) , {-| Marks that the code action cannot currently be applied. @@ -72,24 +72,24 @@ data CodeAction = CodeAction @since 3.16.0 -} - _disabled :: (Maybe Language.LSP.Protocol.Internal.Types.CodeActionDisabled.CodeActionDisabled) + disabled :: (Maybe Language.LSP.Protocol.Internal.Types.CodeActionDisabled.CodeActionDisabled) , {-| The workspace edit this code action performs. -} - _edit :: (Maybe Language.LSP.Protocol.Internal.Types.WorkspaceEdit.WorkspaceEdit) + 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) + 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) + data_ :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionClientCapabilities.hs index bffa1961..5e1b3f3e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionClientCapabilities.hs @@ -26,7 +26,7 @@ data CodeActionClientCapabilities = CodeActionClientCapabilities { {-| Whether code action supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + 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 @@ -34,19 +34,19 @@ data CodeActionClientCapabilities = CodeActionClientCapabilities @since 3.8.0 -} - _codeActionLiteralSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientCodeActionLiteralOptions.ClientCodeActionLiteralOptions) + codeActionLiteralSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientCodeActionLiteralOptions.ClientCodeActionLiteralOptions) , {-| Whether code action supports the `isPreferred` property. @since 3.15.0 -} - _isPreferredSupport :: (Maybe Bool) + isPreferredSupport :: (Maybe Bool) , {-| Whether code action supports the `disabled` property. @since 3.16.0 -} - _disabledSupport :: (Maybe Bool) + disabledSupport :: (Maybe Bool) , {-| Whether code action supports the `data` property which is preserved between a `textDocument/codeAction` and a @@ -54,14 +54,14 @@ data CodeActionClientCapabilities = CodeActionClientCapabilities @since 3.16.0 -} - _dataSupport :: (Maybe Bool) + dataSupport :: (Maybe Bool) , {-| Whether the client supports resolving additional code action properties via a separate `codeAction/resolve` request. @since 3.16.0 -} - _resolveSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientCodeActionResolveOptions.ClientCodeActionResolveOptions) + resolveSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientCodeActionResolveOptions.ClientCodeActionResolveOptions) , {-| Whether the client honors the change annotations in text edits and resource operations returned via the @@ -71,7 +71,7 @@ data CodeActionClientCapabilities = CodeActionClientCapabilities @since 3.16.0 -} - _honorsChangeAnnotations :: (Maybe Bool) + honorsChangeAnnotations :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionContext.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionContext.hs index 52afab40..14d44f1e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionContext.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionContext.hs @@ -32,20 +32,20 @@ data CodeActionContext = CodeActionContext 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] + 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]) + 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) + triggerKind :: (Maybe Language.LSP.Protocol.Internal.Types.CodeActionTriggerKind.CodeActionTriggerKind) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionDisabled.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionDisabled.hs index 25e6978b..2fba66c4 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionDisabled.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionDisabled.hs @@ -30,7 +30,7 @@ data CodeActionDisabled = CodeActionDisabled This is displayed in the code actions UI. -} - _reason :: Data.Text.Text + reason :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionOptions.hs index 18e225f4..4895090c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionOptions.hs @@ -25,21 +25,21 @@ data CodeActionOptions = CodeActionOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + 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]) + 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) + resolveProvider :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionParams.hs index d5332a25..4a574449 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionParams.hs @@ -28,24 +28,24 @@ 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) + 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) + 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 + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The range for which the command was invoked. -} - _range :: Language.LSP.Protocol.Internal.Types.Range.Range + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| Context carrying additional information. -} - _context :: Language.LSP.Protocol.Internal.Types.CodeActionContext.CodeActionContext + context :: Language.LSP.Protocol.Internal.Types.CodeActionContext.CodeActionContext } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionRegistrationOptions.hs index 258574d8..7f831426 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeActionRegistrationOptions.hs @@ -27,25 +27,25 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + 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]) + 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) + resolveProvider :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeDescription.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeDescription.hs index 81e9b7fc..0b947ee0 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeDescription.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeDescription.hs @@ -27,7 +27,7 @@ data CodeDescription = CodeDescription { {-| An URI to open with more information about the diagnostic error. -} - _href :: Language.LSP.Protocol.Types.Uri.Uri + href :: Language.LSP.Protocol.Types.Uri.Uri } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLens.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLens.hs index b3579d91..c01626b0 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLens.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLens.hs @@ -31,16 +31,16 @@ 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 + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| The command this code lens represents. -} - _command :: (Maybe Language.LSP.Protocol.Internal.Types.Command.Command) + command :: (Maybe Language.LSP.Protocol.Internal.Types.Command.Command) , {-| A data entry field that is preserved on a code lens item between a `CodeLensRequest` -} - _data_ :: (Maybe Data.Aeson.Value) + data_ :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensClientCapabilities.hs index 9dcb01a6..54351950 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensClientCapabilities.hs @@ -24,7 +24,7 @@ data CodeLensClientCapabilities = CodeLensClientCapabilities { {-| Whether code lens supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensOptions.hs index f494bdc3..be4a4945 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensOptions.hs @@ -24,11 +24,11 @@ data CodeLensOptions = CodeLensOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| Code lens has a resolve provider as well. -} - _resolveProvider :: (Maybe Bool) + resolveProvider :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensParams.hs index 66776f2c..3b57079e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensParams.hs @@ -26,16 +26,16 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The document to request code lens for. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensRegistrationOptions.hs index e2f79764..7bc4eaa6 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensRegistrationOptions.hs @@ -26,15 +26,15 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| Code lens has a resolve provider as well. -} - _resolveProvider :: (Maybe Bool) + resolveProvider :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensWorkspaceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensWorkspaceClientCapabilities.hs index 5c56421b..7ddbd6e9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensWorkspaceClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CodeLensWorkspaceClientCapabilities.hs @@ -30,7 +30,7 @@ data CodeLensWorkspaceClientCapabilities = CodeLensWorkspaceClientCapabilities useful for situation where a server for example detect a project wide change that requires such a calculation. -} - _refreshSupport :: (Maybe Bool) + refreshSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Color.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Color.hs index f446d234..4ebfb69e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Color.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Color.hs @@ -24,19 +24,19 @@ data Color = Color { {-| The red component of this color in the range [0-1]. -} - _red :: Float + red :: Float , {-| The green component of this color in the range [0-1]. -} - _green :: Float + green :: Float , {-| The blue component of this color in the range [0-1]. -} - _blue :: Float + blue :: Float , {-| The alpha component of this color in the range [0-1]. -} - _alpha :: Float + alpha :: Float } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorInformation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorInformation.hs index aaea9346..64592309 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorInformation.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorInformation.hs @@ -26,11 +26,11 @@ data ColorInformation = ColorInformation { {-| The range in the document where this color appears. -} - _range :: Language.LSP.Protocol.Internal.Types.Range.Range + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| The actual color value for this color range. -} - _color :: Language.LSP.Protocol.Internal.Types.Color.Color + color :: Language.LSP.Protocol.Internal.Types.Color.Color } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentation.hs index 42fcfc16..927aecbf 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentation.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentation.hs @@ -28,18 +28,18 @@ data ColorPresentation = ColorPresentation picker header. By default this is also the text that is inserted when selecting this color presentation. -} - _label :: Data.Text.Text + 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) + 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]) + additionalTextEdits :: (Maybe [Language.LSP.Protocol.Internal.Types.TextEdit.TextEdit]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentationParams.hs index b87f5990..85a2e985 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentationParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ColorPresentationParams.hs @@ -28,24 +28,24 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The color to request presentations for. -} - _color :: Language.LSP.Protocol.Internal.Types.Color.Color + 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 + range :: Language.LSP.Protocol.Internal.Types.Range.Range } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Command.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Command.hs index 8a0e348d..df504f77 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Command.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Command.hs @@ -29,16 +29,16 @@ data Command = Command { {-| Title of the command, like `save`. -} - _title :: Data.Text.Text + title :: Data.Text.Text , {-| The identifier of the actual command handler. -} - _command :: Data.Text.Text + command :: Data.Text.Text , {-| Arguments that the command handler should be invoked with. -} - _arguments :: (Maybe [Data.Aeson.Value]) + arguments :: (Maybe [Data.Aeson.Value]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionClientCapabilities.hs index 4de72d09..e3412ad2 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionClientCapabilities.hs @@ -28,16 +28,16 @@ data CompletionClientCapabilities = CompletionClientCapabilities { {-| Whether completion supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| The client supports the following `CompletionItem` specific capabilities. -} - _completionItem :: (Maybe Language.LSP.Protocol.Internal.Types.ClientCompletionItemOptions.ClientCompletionItemOptions) + completionItem :: (Maybe Language.LSP.Protocol.Internal.Types.ClientCompletionItemOptions.ClientCompletionItemOptions) , {-| -} - _completionItemKind :: (Maybe Language.LSP.Protocol.Internal.Types.ClientCompletionItemOptionsKind.ClientCompletionItemOptionsKind) + completionItemKind :: (Maybe Language.LSP.Protocol.Internal.Types.ClientCompletionItemOptionsKind.ClientCompletionItemOptionsKind) , {-| Defines how the client handles whitespace and indentation when accepting a completion item that uses multi line @@ -45,19 +45,19 @@ data CompletionClientCapabilities = CompletionClientCapabilities @since 3.17.0 -} - _insertTextMode :: (Maybe Language.LSP.Protocol.Internal.Types.InsertTextMode.InsertTextMode) + 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) + contextSupport :: (Maybe Bool) , {-| The client supports the following `CompletionList` specific capabilities. @since 3.17.0 -} - _completionList :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionListCapabilities.CompletionListCapabilities) + completionList :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionListCapabilities.CompletionListCapabilities) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionContext.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionContext.hs index 5f41aaf8..e9241712 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionContext.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionContext.hs @@ -26,12 +26,12 @@ data CompletionContext = CompletionContext { {-| How the completion was triggered. -} - _triggerKind :: Language.LSP.Protocol.Internal.Types.CompletionTriggerKind.CompletionTriggerKind + 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) + triggerCharacter :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItem.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItem.hs index 6e1481e1..50c469cd 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItem.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItem.hs @@ -42,38 +42,38 @@ data CompletionItem = CompletionItem If label details are provided the label itself should be an unqualified name of the completion item. -} - _label :: Data.Text.Text + label :: Data.Text.Text , {-| Additional details for the label @since 3.17.0 -} - _labelDetails :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionItemLabelDetails.CompletionItemLabelDetails) + 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) + 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]) + 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) + 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)) + 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) + deprecated :: (Maybe Bool) , {-| Select this item when showing. @@ -81,19 +81,19 @@ data CompletionItem = CompletionItem tool / client decides which item that is. The rule is that the *first* item of those that match best is selected. -} - _preselect :: (Maybe Bool) + 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) + 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) + filterText :: (Maybe Data.Text.Text) , {-| A string that should be inserted into a document when selecting this completion. When `falsy` the `CompletionItem.label` @@ -107,7 +107,7 @@ data CompletionItem = CompletionItem recommended to use `textEdit` instead since it avoids additional client side interpretation. -} - _insertText :: (Maybe Data.Text.Text) + 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 @@ -116,7 +116,7 @@ data CompletionItem = CompletionItem Please note that the insertTextFormat doesn't apply to `additionalTextEdits`. -} - _insertTextFormat :: (Maybe Language.LSP.Protocol.Internal.Types.InsertTextFormat.InsertTextFormat) + 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 @@ -124,7 +124,7 @@ data CompletionItem = CompletionItem @since 3.16.0 -} - _insertTextMode :: (Maybe Language.LSP.Protocol.Internal.Types.InsertTextMode.InsertTextMode) + 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 @@ -147,7 +147,7 @@ data CompletionItem = CompletionItem @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)) + 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. @@ -160,7 +160,7 @@ data CompletionItem = CompletionItem @since 3.17.0 -} - _textEditText :: (Maybe Data.Text.Text) + 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) @@ -170,24 +170,24 @@ data CompletionItem = CompletionItem (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]) + 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]) + 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) + 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) + data_ :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemDefaults.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemDefaults.hs index 306a65b5..390ec066 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemDefaults.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemDefaults.hs @@ -44,31 +44,31 @@ data CompletionItemDefaults = CompletionItemDefaults @since 3.17.0 -} - _commitCharacters :: (Maybe [Data.Text.Text]) + commitCharacters :: (Maybe [Data.Text.Text]) , {-| A default edit range. @since 3.17.0 -} - _editRange :: (Maybe (Language.LSP.Protocol.Internal.Types.Range.Range Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.EditRangeWithInsertReplace.EditRangeWithInsertReplace)) + editRange :: (Maybe (Language.LSP.Protocol.Internal.Types.Range.Range Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.EditRangeWithInsertReplace.EditRangeWithInsertReplace)) , {-| A default insert text format. @since 3.17.0 -} - _insertTextFormat :: (Maybe Language.LSP.Protocol.Internal.Types.InsertTextFormat.InsertTextFormat) + insertTextFormat :: (Maybe Language.LSP.Protocol.Internal.Types.InsertTextFormat.InsertTextFormat) , {-| A default insert text mode. @since 3.17.0 -} - _insertTextMode :: (Maybe Language.LSP.Protocol.Internal.Types.InsertTextMode.InsertTextMode) + insertTextMode :: (Maybe Language.LSP.Protocol.Internal.Types.InsertTextMode.InsertTextMode) , {-| A default data value. @since 3.17.0 -} - _data_ :: (Maybe Data.Aeson.Value) + data_ :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemLabelDetails.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemLabelDetails.hs index b2bc9e0e..5fb2a978 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemLabelDetails.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemLabelDetails.hs @@ -28,12 +28,12 @@ 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) + 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) + description :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemTagOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemTagOptions.hs index 046451eb..ef753321 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemTagOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionItemTagOptions.hs @@ -26,7 +26,7 @@ data CompletionItemTagOptions = CompletionItemTagOptions { {-| The tags supported by the client. -} - _valueSet :: [Language.LSP.Protocol.Internal.Types.CompletionItemTag.CompletionItemTag] + valueSet :: [Language.LSP.Protocol.Internal.Types.CompletionItemTag.CompletionItemTag] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionList.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionList.hs index 623a3aa0..3d2ebbac 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionList.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionList.hs @@ -30,7 +30,7 @@ data CompletionList = CompletionList Recomputed lists have all their items replaced (not appended) in the incomplete completion sessions. -} - _isIncomplete :: Bool + 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 @@ -46,11 +46,11 @@ data CompletionList = CompletionList @since 3.17.0 -} - _itemDefaults :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionItemDefaults.CompletionItemDefaults) + itemDefaults :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionItemDefaults.CompletionItemDefaults) , {-| The completion items. -} - _items :: [Language.LSP.Protocol.Internal.Types.CompletionItem.CompletionItem] + items :: [Language.LSP.Protocol.Internal.Types.CompletionItem.CompletionItem] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionListCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionListCapabilities.hs index 57200fb2..7ab88c22 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionListCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionListCapabilities.hs @@ -35,7 +35,7 @@ data CompletionListCapabilities = CompletionListCapabilities @since 3.17.0 -} - _itemDefaults :: (Maybe [Data.Text.Text]) + itemDefaults :: (Maybe [Data.Text.Text]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionOptions.hs index 6b39c72d..ba46bd3c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionOptions.hs @@ -26,7 +26,7 @@ data CompletionOptions = CompletionOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + 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 @@ -37,7 +37,7 @@ data CompletionOptions = CompletionOptions 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]) + 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 @@ -48,19 +48,19 @@ data CompletionOptions = CompletionOptions @since 3.2.0 -} - _allCommitCharacters :: (Maybe [Data.Text.Text]) + allCommitCharacters :: (Maybe [Data.Text.Text]) , {-| The server provides support to resolve additional information for a completion item. -} - _resolveProvider :: (Maybe Bool) + resolveProvider :: (Maybe Bool) , {-| The server supports the following `CompletionItem` specific capabilities. @since 3.17.0 -} - _completionItem :: (Maybe Language.LSP.Protocol.Internal.Types.ServerCompletionItemOptions.ServerCompletionItemOptions) + completionItem :: (Maybe Language.LSP.Protocol.Internal.Types.ServerCompletionItemOptions.ServerCompletionItemOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionParams.hs index d2a614eb..58282d8f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionParams.hs @@ -28,25 +28,25 @@ data CompletionParams = CompletionParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + 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) + 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) + context :: (Maybe Language.LSP.Protocol.Internal.Types.CompletionContext.CompletionContext) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionRegistrationOptions.hs index d5118401..40c1ea7b 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CompletionRegistrationOptions.hs @@ -28,11 +28,11 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + 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 @@ -43,7 +43,7 @@ data CompletionRegistrationOptions = CompletionRegistrationOptions 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]) + 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 @@ -54,19 +54,19 @@ data CompletionRegistrationOptions = CompletionRegistrationOptions @since 3.2.0 -} - _allCommitCharacters :: (Maybe [Data.Text.Text]) + allCommitCharacters :: (Maybe [Data.Text.Text]) , {-| The server provides support to resolve additional information for a completion item. -} - _resolveProvider :: (Maybe Bool) + resolveProvider :: (Maybe Bool) , {-| The server supports the following `CompletionItem` specific capabilities. @since 3.17.0 -} - _completionItem :: (Maybe Language.LSP.Protocol.Internal.Types.ServerCompletionItemOptions.ServerCompletionItemOptions) + completionItem :: (Maybe Language.LSP.Protocol.Internal.Types.ServerCompletionItemOptions.ServerCompletionItemOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationItem.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationItem.hs index 9bb24c35..cdfe7f35 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationItem.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationItem.hs @@ -26,11 +26,11 @@ data ConfigurationItem = ConfigurationItem { {-| The scope to get the configuration section for. -} - _scopeUri :: (Maybe Language.LSP.Protocol.Types.Uri.Uri) + scopeUri :: (Maybe Language.LSP.Protocol.Types.Uri.Uri) , {-| The configuration section asked for. -} - _section :: (Maybe Data.Text.Text) + section :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationParams.hs index 7f32b64b..0d11486c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ConfigurationParams.hs @@ -25,7 +25,7 @@ data ConfigurationParams = ConfigurationParams { {-| -} - _items :: [Language.LSP.Protocol.Internal.Types.ConfigurationItem.ConfigurationItem] + items :: [Language.LSP.Protocol.Internal.Types.ConfigurationItem.ConfigurationItem] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFile.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFile.hs index 451f7ede..7a8bce30 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFile.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFile.hs @@ -30,19 +30,19 @@ data CreateFile = CreateFile @since 3.16.0 -} - _annotationId :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier) + annotationId :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier) , {-| A create -} - _kind :: (Language.LSP.Protocol.Types.Singletons.AString "create") + kind :: (Language.LSP.Protocol.Types.Singletons.AString "create") , {-| The resource to create. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + uri :: Language.LSP.Protocol.Types.Uri.Uri , {-| Additional options -} - _options :: (Maybe Language.LSP.Protocol.Internal.Types.CreateFileOptions.CreateFileOptions) + options :: (Maybe Language.LSP.Protocol.Internal.Types.CreateFileOptions.CreateFileOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFileOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFileOptions.hs index d1aa5b56..f1d08c74 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFileOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFileOptions.hs @@ -24,11 +24,11 @@ data CreateFileOptions = CreateFileOptions { {-| Overwrite existing file. Overwrite wins over `ignoreIfExists` -} - _overwrite :: (Maybe Bool) + overwrite :: (Maybe Bool) , {-| Ignore if exists. -} - _ignoreIfExists :: (Maybe Bool) + ignoreIfExists :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFilesParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFilesParams.hs index b2f39503..730fd272 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFilesParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/CreateFilesParams.hs @@ -28,7 +28,7 @@ data CreateFilesParams = CreateFilesParams { {-| An array of all files/folders created in this operation. -} - _files :: [Language.LSP.Protocol.Internal.Types.FileCreate.FileCreate] + files :: [Language.LSP.Protocol.Internal.Types.FileCreate.FileCreate] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationClientCapabilities.hs index c7322126..8a99807e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationClientCapabilities.hs @@ -26,11 +26,11 @@ data DeclarationClientCapabilities = DeclarationClientCapabilities the client supports the new `DeclarationRegistrationOptions` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| The client supports additional metadata in the form of declaration links. -} - _linkSupport :: (Maybe Bool) + linkSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationOptions.hs index 84ea366e..d2666b8a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationOptions.hs @@ -24,7 +24,7 @@ data DeclarationOptions = DeclarationOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationParams.hs index 60d015e1..970f38a0 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationParams.hs @@ -27,20 +27,20 @@ data DeclarationParams = DeclarationParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationRegistrationOptions.hs index e5b1c0b8..784a1412 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeclarationRegistrationOptions.hs @@ -26,17 +26,17 @@ data DeclarationRegistrationOptions = DeclarationRegistrationOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + 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) + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionClientCapabilities.hs index bed65fe0..d75f9091 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionClientCapabilities.hs @@ -24,13 +24,13 @@ data DefinitionClientCapabilities = DefinitionClientCapabilities { {-| Whether definition supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| The client supports additional metadata in the form of definition links. @since 3.14.0 -} - _linkSupport :: (Maybe Bool) + linkSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionOptions.hs index d373c882..d682645a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionOptions.hs @@ -24,7 +24,7 @@ data DefinitionOptions = DefinitionOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionParams.hs index 2f1c5143..2315011e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionParams.hs @@ -27,20 +27,20 @@ data DefinitionParams = DefinitionParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionRegistrationOptions.hs index 16c665f3..3cf1d1a3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DefinitionRegistrationOptions.hs @@ -26,11 +26,11 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFile.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFile.hs index b9d989f3..fa7e1aa3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFile.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFile.hs @@ -30,19 +30,19 @@ data DeleteFile = DeleteFile @since 3.16.0 -} - _annotationId :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier) + annotationId :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier) , {-| A delete -} - _kind :: (Language.LSP.Protocol.Types.Singletons.AString "delete") + kind :: (Language.LSP.Protocol.Types.Singletons.AString "delete") , {-| The file to delete. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + uri :: Language.LSP.Protocol.Types.Uri.Uri , {-| Delete options. -} - _options :: (Maybe Language.LSP.Protocol.Internal.Types.DeleteFileOptions.DeleteFileOptions) + options :: (Maybe Language.LSP.Protocol.Internal.Types.DeleteFileOptions.DeleteFileOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFileOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFileOptions.hs index 3c98601a..2e964b90 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFileOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFileOptions.hs @@ -24,11 +24,11 @@ data DeleteFileOptions = DeleteFileOptions { {-| Delete the content recursively if a folder is denoted. -} - _recursive :: (Maybe Bool) + recursive :: (Maybe Bool) , {-| Ignore the operation if the file doesn't exist. -} - _ignoreIfNotExists :: (Maybe Bool) + ignoreIfNotExists :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFilesParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFilesParams.hs index f36d0b89..a0c82701 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFilesParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DeleteFilesParams.hs @@ -28,7 +28,7 @@ data DeleteFilesParams = DeleteFilesParams { {-| An array of all files/folders deleted in this operation. -} - _files :: [Language.LSP.Protocol.Internal.Types.FileDelete.FileDelete] + files :: [Language.LSP.Protocol.Internal.Types.FileDelete.FileDelete] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Diagnostic.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Diagnostic.hs index abf14693..23b76449 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Diagnostic.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Diagnostic.hs @@ -32,51 +32,51 @@ data Diagnostic = Diagnostic { {-| The range at which the message applies -} - _range :: Language.LSP.Protocol.Internal.Types.Range.Range + 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) + 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)) + 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) + 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) + source :: (Maybe Data.Text.Text) , {-| The diagnostic's message. It usually appears in the user interface -} - _message :: Data.Text.Text + message :: Data.Text.Text , {-| Additional metadata about the diagnostic. @since 3.15.0 -} - _tags :: (Maybe [Language.LSP.Protocol.Internal.Types.DiagnosticTag.DiagnosticTag]) + 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]) + 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) + data_ :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticClientCapabilities.hs index 70124389..de3a373b 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticClientCapabilities.hs @@ -28,11 +28,11 @@ data DiagnosticClientCapabilities = DiagnosticClientCapabilities the client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| Whether the clients supports related documents for document diagnostic pulls. -} - _relatedDocumentSupport :: (Maybe Bool) + relatedDocumentSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticOptions.hs index d09c42e4..9ce02b1d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticOptions.hs @@ -27,23 +27,23 @@ data DiagnosticOptions = DiagnosticOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| An optional identifier under which the diagnostics are managed by the client. -} - _identifier :: (Maybe Data.Text.Text) + 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 + interFileDependencies :: Bool , {-| The server provides support for workspace diagnostics as well. -} - _workspaceDiagnostics :: Bool + workspaceDiagnostics :: Bool } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRegistrationOptions.hs index 5afb0546..8cbb5af4 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRegistrationOptions.hs @@ -29,32 +29,32 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| An optional identifier under which the diagnostics are managed by the client. -} - _identifier :: (Maybe Data.Text.Text) + 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 + interFileDependencies :: Bool , {-| The server provides support for workspace diagnostics as well. -} - _workspaceDiagnostics :: Bool + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRelatedInformation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRelatedInformation.hs index 35a0f8b1..6ffd1256 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRelatedInformation.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticRelatedInformation.hs @@ -28,11 +28,11 @@ data DiagnosticRelatedInformation = DiagnosticRelatedInformation { {-| The location of this related diagnostic information. -} - _location :: Language.LSP.Protocol.Internal.Types.Location.Location + location :: Language.LSP.Protocol.Internal.Types.Location.Location , {-| The message of this related diagnostic information. -} - _message :: Data.Text.Text + message :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticServerCancellationData.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticServerCancellationData.hs index aacce550..b9354f69 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticServerCancellationData.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticServerCancellationData.hs @@ -26,7 +26,7 @@ data DiagnosticServerCancellationData = DiagnosticServerCancellationData { {-| -} - _retriggerRequest :: Bool + retriggerRequest :: Bool } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticWorkspaceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticWorkspaceClientCapabilities.hs index 347c76c7..515be00c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticWorkspaceClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DiagnosticWorkspaceClientCapabilities.hs @@ -32,7 +32,7 @@ data DiagnosticWorkspaceClientCapabilities = DiagnosticWorkspaceClientCapabiliti is useful for situation where a server for example detects a project wide change that requires such a calculation. -} - _refreshSupport :: (Maybe Bool) + refreshSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationClientCapabilities.hs index 3c48d33d..5275b695 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationClientCapabilities.hs @@ -24,7 +24,7 @@ data DidChangeConfigurationClientCapabilities = DidChangeConfigurationClientCapa { {-| Did change configuration notification supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationParams.hs index 8c4e144c..34f96234 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationParams.hs @@ -25,7 +25,7 @@ data DidChangeConfigurationParams = DidChangeConfigurationParams { {-| The actual changed settings -} - _settings :: Data.Aeson.Value + settings :: Data.Aeson.Value } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationRegistrationOptions.hs index b4586463..30af6c76 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeConfigurationRegistrationOptions.hs @@ -25,7 +25,7 @@ data DidChangeConfigurationRegistrationOptions = DidChangeConfigurationRegistrat { {-| -} - _section :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? [Data.Text.Text])) + section :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? [Data.Text.Text])) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeNotebookDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeNotebookDocumentParams.hs index 228b95a1..804cd676 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeNotebookDocumentParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeNotebookDocumentParams.hs @@ -31,7 +31,7 @@ data DidChangeNotebookDocumentParams = DidChangeNotebookDocumentParams 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 + notebookDocument :: Language.LSP.Protocol.Internal.Types.VersionedNotebookDocumentIdentifier.VersionedNotebookDocumentIdentifier , {-| The actual changes to the notebook document. @@ -47,7 +47,7 @@ data DidChangeNotebookDocumentParams = DidChangeNotebookDocumentParams - apply the `NotebookChangeEvent`s in a single notification in the order you receive them. -} - _change :: Language.LSP.Protocol.Internal.Types.NotebookDocumentChangeEvent.NotebookDocumentChangeEvent + change :: Language.LSP.Protocol.Internal.Types.NotebookDocumentChangeEvent.NotebookDocumentChangeEvent } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeTextDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeTextDocumentParams.hs index 2c825889..058a4e05 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeTextDocumentParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeTextDocumentParams.hs @@ -28,7 +28,7 @@ data DidChangeTextDocumentParams = DidChangeTextDocumentParams to the version after all provided content changes have been applied. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier.VersionedTextDocumentIdentifier + 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 @@ -42,7 +42,7 @@ data DidChangeTextDocumentParams = DidChangeTextDocumentParams - apply the `TextDocumentContentChangeEvent`s in a single notification in the order you receive them. -} - _contentChanges :: [Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent.TextDocumentContentChangeEvent] + contentChanges :: [Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent.TextDocumentContentChangeEvent] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesClientCapabilities.hs index 16929eb2..785dda38 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesClientCapabilities.hs @@ -26,14 +26,14 @@ data DidChangeWatchedFilesClientCapabilities = DidChangeWatchedFilesClientCapabi that the current protocol doesn't support static configuration for file changes from the server side. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| Whether the client has support for `RelativePattern` or not. @since 3.17.0 -} - _relativePatternSupport :: (Maybe Bool) + relativePatternSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesParams.hs index dd346fa8..c445d4b7 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesParams.hs @@ -25,7 +25,7 @@ data DidChangeWatchedFilesParams = DidChangeWatchedFilesParams { {-| The actual file events. -} - _changes :: [Language.LSP.Protocol.Internal.Types.FileEvent.FileEvent] + changes :: [Language.LSP.Protocol.Internal.Types.FileEvent.FileEvent] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesRegistrationOptions.hs index eb219819..7b1543d6 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWatchedFilesRegistrationOptions.hs @@ -25,7 +25,7 @@ data DidChangeWatchedFilesRegistrationOptions = DidChangeWatchedFilesRegistratio { {-| The watchers to register. -} - _watchers :: [Language.LSP.Protocol.Internal.Types.FileSystemWatcher.FileSystemWatcher] + watchers :: [Language.LSP.Protocol.Internal.Types.FileSystemWatcher.FileSystemWatcher] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWorkspaceFoldersParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWorkspaceFoldersParams.hs index 33808b58..cd3923b6 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWorkspaceFoldersParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidChangeWorkspaceFoldersParams.hs @@ -25,7 +25,7 @@ data DidChangeWorkspaceFoldersParams = DidChangeWorkspaceFoldersParams { {-| The actual workspace folder change event. -} - _event :: Language.LSP.Protocol.Internal.Types.WorkspaceFoldersChangeEvent.WorkspaceFoldersChangeEvent + event :: Language.LSP.Protocol.Internal.Types.WorkspaceFoldersChangeEvent.WorkspaceFoldersChangeEvent } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseNotebookDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseNotebookDocumentParams.hs index c17ecdb8..5b10341e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseNotebookDocumentParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseNotebookDocumentParams.hs @@ -28,12 +28,12 @@ data DidCloseNotebookDocumentParams = DidCloseNotebookDocumentParams { {-| The notebook document that got closed. -} - _notebookDocument :: Language.LSP.Protocol.Internal.Types.NotebookDocumentIdentifier.NotebookDocumentIdentifier + 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] + cellTextDocuments :: [Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseTextDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseTextDocumentParams.hs index 2408ad95..a5a4f4b3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseTextDocumentParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidCloseTextDocumentParams.hs @@ -25,7 +25,7 @@ data DidCloseTextDocumentParams = DidCloseTextDocumentParams { {-| The document that was closed. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenNotebookDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenNotebookDocumentParams.hs index 6a0da1ac..8040e44b 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenNotebookDocumentParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenNotebookDocumentParams.hs @@ -28,12 +28,12 @@ data DidOpenNotebookDocumentParams = DidOpenNotebookDocumentParams { {-| The notebook document that got opened. -} - _notebookDocument :: Language.LSP.Protocol.Internal.Types.NotebookDocument.NotebookDocument + 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] + cellTextDocuments :: [Language.LSP.Protocol.Internal.Types.TextDocumentItem.TextDocumentItem] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenTextDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenTextDocumentParams.hs index e25da5ee..46c073e8 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenTextDocumentParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidOpenTextDocumentParams.hs @@ -25,7 +25,7 @@ data DidOpenTextDocumentParams = DidOpenTextDocumentParams { {-| The document that was opened. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentItem.TextDocumentItem + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentItem.TextDocumentItem } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveNotebookDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveNotebookDocumentParams.hs index 87322312..31057e09 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveNotebookDocumentParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveNotebookDocumentParams.hs @@ -27,7 +27,7 @@ data DidSaveNotebookDocumentParams = DidSaveNotebookDocumentParams { {-| The notebook document that got saved. -} - _notebookDocument :: Language.LSP.Protocol.Internal.Types.NotebookDocumentIdentifier.NotebookDocumentIdentifier + notebookDocument :: Language.LSP.Protocol.Internal.Types.NotebookDocumentIdentifier.NotebookDocumentIdentifier } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveTextDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveTextDocumentParams.hs index 744418bf..0c70985e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveTextDocumentParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DidSaveTextDocumentParams.hs @@ -26,12 +26,12 @@ data DidSaveTextDocumentParams = DidSaveTextDocumentParams { {-| The document that was saved. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + 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) + text :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorClientCapabilities.hs index bca2c1fc..19b7ec5d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorClientCapabilities.hs @@ -26,7 +26,7 @@ data DocumentColorClientCapabilities = DocumentColorClientCapabilities the client supports the new `DocumentColorRegistrationOptions` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorOptions.hs index f800cf54..79d99b0a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorOptions.hs @@ -24,7 +24,7 @@ data DocumentColorOptions = DocumentColorOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorParams.hs index 7e718f82..d82a1e4f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorParams.hs @@ -26,16 +26,16 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorRegistrationOptions.hs index 89c6d7a1..1c3c6708 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentColorRegistrationOptions.hs @@ -27,16 +27,16 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticParams.hs index 72951d2c..a54f2bdf 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticParams.hs @@ -29,24 +29,24 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The additional identifier provided during registration. -} - _identifier :: (Maybe Data.Text.Text) + identifier :: (Maybe Data.Text.Text) , {-| The result id of a previous response if provided. -} - _previousResultId :: (Maybe Data.Text.Text) + previousResultId :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReportPartialResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReportPartialResult.hs index 53e05197..e7bf972d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReportPartialResult.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentDiagnosticReportPartialResult.hs @@ -30,7 +30,7 @@ data DocumentDiagnosticReportPartialResult = DocumentDiagnosticReportPartialResu { {-| -} - _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)) + 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) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingClientCapabilities.hs index 244db738..2d8f1988 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingClientCapabilities.hs @@ -24,7 +24,7 @@ data DocumentFormattingClientCapabilities = DocumentFormattingClientCapabilities { {-| Whether formatting supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingOptions.hs index 48958a07..489bc92a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingOptions.hs @@ -24,7 +24,7 @@ data DocumentFormattingOptions = DocumentFormattingOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingParams.hs index a66af384..18ff0f81 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingParams.hs @@ -27,15 +27,15 @@ 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The document to format. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The format options. -} - _options :: Language.LSP.Protocol.Internal.Types.FormattingOptions.FormattingOptions + options :: Language.LSP.Protocol.Internal.Types.FormattingOptions.FormattingOptions } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingRegistrationOptions.hs index b9d03a93..628262b9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentFormattingRegistrationOptions.hs @@ -26,11 +26,11 @@ data DocumentFormattingRegistrationOptions = DocumentFormattingRegistrationOptio 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlight.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlight.hs index 1b30cc76..b91e97a8 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlight.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlight.hs @@ -28,11 +28,11 @@ data DocumentHighlight = DocumentHighlight { {-| The range this highlight applies to. -} - _range :: Language.LSP.Protocol.Internal.Types.Range.Range + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| The highlight kind, default is `DocumentHighlightKind.Text`. -} - _kind :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentHighlightKind.DocumentHighlightKind) + kind :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentHighlightKind.DocumentHighlightKind) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightClientCapabilities.hs index c9d71e51..627256b4 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightClientCapabilities.hs @@ -24,7 +24,7 @@ data DocumentHighlightClientCapabilities = DocumentHighlightClientCapabilities { {-| Whether document highlight supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightOptions.hs index cab9e74d..e621444d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightOptions.hs @@ -24,7 +24,7 @@ data DocumentHighlightOptions = DocumentHighlightOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightParams.hs index ea1bf328..48d2f7dd 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightParams.hs @@ -27,20 +27,20 @@ data DocumentHighlightParams = DocumentHighlightParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightRegistrationOptions.hs index 15fc547e..293e5b98 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentHighlightRegistrationOptions.hs @@ -26,11 +26,11 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLink.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLink.hs index c2958ad3..d792768a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLink.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLink.hs @@ -29,11 +29,11 @@ data DocumentLink = DocumentLink { {-| The range this link applies to. -} - _range :: Language.LSP.Protocol.Internal.Types.Range.Range + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| The uri this link points to. If missing a resolve request is sent later. -} - _target :: (Maybe Language.LSP.Protocol.Types.Uri.Uri) + target :: (Maybe Language.LSP.Protocol.Types.Uri.Uri) , {-| The tooltip text when you hover over this link. @@ -43,12 +43,12 @@ data DocumentLink = DocumentLink @since 3.15.0 -} - _tooltip :: (Maybe Data.Text.Text) + 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) + data_ :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkClientCapabilities.hs index c0c7e62c..392a3857 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkClientCapabilities.hs @@ -24,13 +24,13 @@ data DocumentLinkClientCapabilities = DocumentLinkClientCapabilities { {-| Whether document link supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| Whether the client supports the `tooltip` property on `DocumentLink`. @since 3.15.0 -} - _tooltipSupport :: (Maybe Bool) + tooltipSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkOptions.hs index 29958d00..55e1f0da 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkOptions.hs @@ -24,11 +24,11 @@ data DocumentLinkOptions = DocumentLinkOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| Document links have a resolve provider as well. -} - _resolveProvider :: (Maybe Bool) + resolveProvider :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkParams.hs index 1342433e..2f3ff991 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkParams.hs @@ -26,16 +26,16 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The document to provide document links for. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkRegistrationOptions.hs index 2dceceec..6be6bfe3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentLinkRegistrationOptions.hs @@ -26,15 +26,15 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| Document links have a resolve provider as well. -} - _resolveProvider :: (Maybe Bool) + resolveProvider :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingClientCapabilities.hs index bc71ee0d..ed386c3a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingClientCapabilities.hs @@ -24,7 +24,7 @@ data DocumentOnTypeFormattingClientCapabilities = DocumentOnTypeFormattingClient { {-| Whether on type formatting supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingOptions.hs index 510aef89..90eacfe4 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingOptions.hs @@ -25,11 +25,11 @@ data DocumentOnTypeFormattingOptions = DocumentOnTypeFormattingOptions { {-| A character on which formatting should be triggered, like `{`. -} - _firstTriggerCharacter :: Data.Text.Text + firstTriggerCharacter :: Data.Text.Text , {-| More trigger characters. -} - _moreTriggerCharacter :: (Maybe [Data.Text.Text]) + moreTriggerCharacter :: (Maybe [Data.Text.Text]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingParams.hs index 8ec8993f..85feeb0c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingParams.hs @@ -28,24 +28,24 @@ data DocumentOnTypeFormattingParams = DocumentOnTypeFormattingParams { {-| The document to format. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + 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 + 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 + ch :: Data.Text.Text , {-| The formatting options. -} - _options :: Language.LSP.Protocol.Internal.Types.FormattingOptions.FormattingOptions + options :: Language.LSP.Protocol.Internal.Types.FormattingOptions.FormattingOptions } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingRegistrationOptions.hs index 14fccfa8..16ccdfa6 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentOnTypeFormattingRegistrationOptions.hs @@ -27,15 +27,15 @@ data DocumentOnTypeFormattingRegistrationOptions = DocumentOnTypeFormattingRegis 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) + 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 + firstTriggerCharacter :: Data.Text.Text , {-| More trigger characters. -} - _moreTriggerCharacter :: (Maybe [Data.Text.Text]) + moreTriggerCharacter :: (Maybe [Data.Text.Text]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingClientCapabilities.hs index 6e8b1ada..a37e5a74 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingClientCapabilities.hs @@ -24,7 +24,7 @@ data DocumentRangeFormattingClientCapabilities = DocumentRangeFormattingClientCa { {-| Whether range formatting supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingOptions.hs index 2e845306..aa28a305 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingOptions.hs @@ -24,7 +24,7 @@ data DocumentRangeFormattingOptions = DocumentRangeFormattingOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingParams.hs index 78c36225..b7c6fcb9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingParams.hs @@ -28,19 +28,19 @@ 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The document to format. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The range to format -} - _range :: Language.LSP.Protocol.Internal.Types.Range.Range + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| The format options -} - _options :: Language.LSP.Protocol.Internal.Types.FormattingOptions.FormattingOptions + options :: Language.LSP.Protocol.Internal.Types.FormattingOptions.FormattingOptions } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingRegistrationOptions.hs index 66361c9e..194f7da0 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentRangeFormattingRegistrationOptions.hs @@ -26,11 +26,11 @@ data DocumentRangeFormattingRegistrationOptions = DocumentRangeFormattingRegistr 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbol.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbol.hs index 63d78ba9..c65e9fc2 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbol.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbol.hs @@ -32,42 +32,42 @@ 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 + name :: Data.Text.Text , {-| More detail for this symbol, e.g the signature of a function. -} - _detail :: (Maybe Data.Text.Text) + detail :: (Maybe Data.Text.Text) , {-| The kind of this symbol. -} - _kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind + 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]) + tags :: (Maybe [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag]) , {-| Indicates if this symbol is deprecated. @deprecated Use tags instead -} - _deprecated :: (Maybe Bool) + 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 + 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 + 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]) + children :: (Maybe [Language.LSP.Protocol.Internal.Types.DocumentSymbol.DocumentSymbol]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolClientCapabilities.hs index 76d17fc0..77c2c13d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolClientCapabilities.hs @@ -26,16 +26,16 @@ data DocumentSymbolClientCapabilities = DocumentSymbolClientCapabilities { {-| Whether document symbol supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| Specific capabilities for the `SymbolKind` in the `textDocument/documentSymbol` request. -} - _symbolKind :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSymbolKindOptions.ClientSymbolKindOptions) + symbolKind :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSymbolKindOptions.ClientSymbolKindOptions) , {-| The client supports hierarchical document symbols. -} - _hierarchicalDocumentSymbolSupport :: (Maybe Bool) + hierarchicalDocumentSymbolSupport :: (Maybe Bool) , {-| The client supports tags on `SymbolInformation`. Tags are supported on `DocumentSymbol` if `hierarchicalDocumentSymbolSupport` is set to true. @@ -43,14 +43,14 @@ data DocumentSymbolClientCapabilities = DocumentSymbolClientCapabilities @since 3.16.0 -} - _tagSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSymbolTagOptions.ClientSymbolTagOptions) + tagSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSymbolTagOptions.ClientSymbolTagOptions) , {-| The client supports an additional label presented in the UI when registering a document symbol provider. @since 3.16.0 -} - _labelSupport :: (Maybe Bool) + labelSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolOptions.hs index 63bd7178..ad4e4e5e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolOptions.hs @@ -25,14 +25,14 @@ data DocumentSymbolOptions = DocumentSymbolOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + 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) + label :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolParams.hs index 7510b8b6..a13cc73f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolParams.hs @@ -26,16 +26,16 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolRegistrationOptions.hs index 941c8ccb..7f8fb898 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/DocumentSymbolRegistrationOptions.hs @@ -27,18 +27,18 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + 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) + label :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/EditRangeWithInsertReplace.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/EditRangeWithInsertReplace.hs index c5b2a33f..4d11c759 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/EditRangeWithInsertReplace.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/EditRangeWithInsertReplace.hs @@ -28,11 +28,11 @@ data EditRangeWithInsertReplace = EditRangeWithInsertReplace { {-| -} - _insert :: Language.LSP.Protocol.Internal.Types.Range.Range + insert :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| -} - _replace :: Language.LSP.Protocol.Internal.Types.Range.Range + replace :: Language.LSP.Protocol.Internal.Types.Range.Range } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandClientCapabilities.hs index d4186c5b..4b624d5a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandClientCapabilities.hs @@ -24,7 +24,7 @@ data ExecuteCommandClientCapabilities = ExecuteCommandClientCapabilities { {-| Execute command supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandOptions.hs index b86c92e4..4b2142ec 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandOptions.hs @@ -25,11 +25,11 @@ data ExecuteCommandOptions = ExecuteCommandOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| The commands to be executed on the server -} - _commands :: [Data.Text.Text] + commands :: [Data.Text.Text] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandParams.hs index 6618cbc4..db0d2f32 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandParams.hs @@ -27,15 +27,15 @@ 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The identifier of the actual command handler. -} - _command :: Data.Text.Text + command :: Data.Text.Text , {-| Arguments that the command should be invoked with. -} - _arguments :: (Maybe [Data.Aeson.Value]) + arguments :: (Maybe [Data.Aeson.Value]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandRegistrationOptions.hs index 06483c40..83c6591d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecuteCommandRegistrationOptions.hs @@ -25,11 +25,11 @@ data ExecuteCommandRegistrationOptions = ExecuteCommandRegistrationOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| The commands to be executed on the server -} - _commands :: [Data.Text.Text] + commands :: [Data.Text.Text] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecutionSummary.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecutionSummary.hs index 4959c9e4..0c5eb3ff 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecutionSummary.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ExecutionSummary.hs @@ -26,12 +26,12 @@ data ExecutionSummary = ExecutionSummary indicating the execution order of a cell inside a notebook. -} - _executionOrder :: Language.LSP.Protocol.Types.Common.UInt + executionOrder :: Language.LSP.Protocol.Types.Common.UInt , {-| Whether the execution was successful or not if known by the client. -} - _success :: (Maybe Bool) + success :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileCreate.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileCreate.hs index 56a24f51..26e74444 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileCreate.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileCreate.hs @@ -27,7 +27,7 @@ data FileCreate = FileCreate { {-| A file:// URI for the location of the file/folder being created. -} - _uri :: Data.Text.Text + uri :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileDelete.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileDelete.hs index 4931ff38..9f921e30 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileDelete.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileDelete.hs @@ -27,7 +27,7 @@ data FileDelete = FileDelete { {-| A file:// URI for the location of the file/folder being deleted. -} - _uri :: Data.Text.Text + uri :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileEvent.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileEvent.hs index ef9362b5..017779b3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileEvent.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileEvent.hs @@ -26,11 +26,11 @@ data FileEvent = FileEvent { {-| The file's uri. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + uri :: Language.LSP.Protocol.Types.Uri.Uri , {-| The change type. -} - _type_ :: Language.LSP.Protocol.Internal.Types.FileChangeType.FileChangeType + type_ :: Language.LSP.Protocol.Internal.Types.FileChangeType.FileChangeType } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationClientCapabilities.hs index c9f979da..3fa1fa0e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationClientCapabilities.hs @@ -29,31 +29,31 @@ data FileOperationClientCapabilities = FileOperationClientCapabilities { {-| Whether the client supports dynamic registration for file requests/notifications. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| The client has support for sending didCreateFiles notifications. -} - _didCreate :: (Maybe Bool) + didCreate :: (Maybe Bool) , {-| The client has support for sending willCreateFiles requests. -} - _willCreate :: (Maybe Bool) + willCreate :: (Maybe Bool) , {-| The client has support for sending didRenameFiles notifications. -} - _didRename :: (Maybe Bool) + didRename :: (Maybe Bool) , {-| The client has support for sending willRenameFiles requests. -} - _willRename :: (Maybe Bool) + willRename :: (Maybe Bool) , {-| The client has support for sending didDeleteFiles notifications. -} - _didDelete :: (Maybe Bool) + didDelete :: (Maybe Bool) , {-| The client has support for sending willDeleteFiles requests. -} - _willDelete :: (Maybe Bool) + willDelete :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationFilter.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationFilter.hs index 13ea2e94..81352c55 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationFilter.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationFilter.hs @@ -29,11 +29,11 @@ data FileOperationFilter = FileOperationFilter { {-| A Uri scheme like `file` or `untitled`. -} - _scheme :: (Maybe Data.Text.Text) + scheme :: (Maybe Data.Text.Text) , {-| The actual file operation pattern. -} - _pattern :: Language.LSP.Protocol.Internal.Types.FileOperationPattern.FileOperationPattern + pattern :: Language.LSP.Protocol.Internal.Types.FileOperationPattern.FileOperationPattern } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationOptions.hs index b26be007..ede482bd 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationOptions.hs @@ -27,27 +27,27 @@ data FileOperationOptions = FileOperationOptions { {-| The server is interested in receiving didCreateFiles notifications. -} - _didCreate :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions) + 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) + 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) + 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) + 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) + 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) + willDelete :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationRegistrationOptions.FileOperationRegistrationOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPattern.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPattern.hs index a172ae30..e4cc49dd 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPattern.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPattern.hs @@ -36,17 +36,17 @@ data FileOperationPattern = FileOperationPattern - `[]` 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 + 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) + matches :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationPatternKind.FileOperationPatternKind) , {-| Additional options used during matching. -} - _options :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationPatternOptions.FileOperationPatternOptions) + options :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationPatternOptions.FileOperationPatternOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPatternOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPatternOptions.hs index 13183cd4..3daa0d65 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPatternOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationPatternOptions.hs @@ -26,7 +26,7 @@ data FileOperationPatternOptions = FileOperationPatternOptions { {-| The pattern should be matched ignoring casing. -} - _ignoreCase :: (Maybe Bool) + ignoreCase :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationRegistrationOptions.hs index b0d13a38..b6dcda33 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileOperationRegistrationOptions.hs @@ -27,7 +27,7 @@ data FileOperationRegistrationOptions = FileOperationRegistrationOptions { {-| The actual filters. -} - _filters :: [Language.LSP.Protocol.Internal.Types.FileOperationFilter.FileOperationFilter] + filters :: [Language.LSP.Protocol.Internal.Types.FileOperationFilter.FileOperationFilter] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileRename.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileRename.hs index c65c3756..024ad369 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileRename.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileRename.hs @@ -27,11 +27,11 @@ data FileRename = FileRename { {-| A file:// URI for the original location of the file/folder being renamed. -} - _oldUri :: Data.Text.Text + oldUri :: Data.Text.Text , {-| A file:// URI for the new location of the file/folder being renamed. -} - _newUri :: Data.Text.Text + newUri :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileSystemWatcher.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileSystemWatcher.hs index f9d56308..089365c5 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileSystemWatcher.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FileSystemWatcher.hs @@ -28,13 +28,13 @@ data FileSystemWatcher = FileSystemWatcher @since 3.17.0 support for relative patterns. -} - _globPattern :: Language.LSP.Protocol.Internal.Types.GlobPattern.GlobPattern + 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) + kind :: (Maybe Language.LSP.Protocol.Internal.Types.WatchKind.WatchKind) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRange.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRange.hs index 79371c97..1aa5a5e3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRange.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRange.hs @@ -28,26 +28,26 @@ 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 + 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) + 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 + 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) + 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) + 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 @@ -55,7 +55,7 @@ data FoldingRange = FoldingRange @since 3.17.0 -} - _collapsedText :: (Maybe Data.Text.Text) + collapsedText :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeClientCapabilities.hs index c0b825cb..bd51453b 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeClientCapabilities.hs @@ -29,31 +29,31 @@ data FoldingRangeClientCapabilities = FoldingRangeClientCapabilities `FoldingRangeRegistrationOptions` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + 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) + 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) + lineFoldingOnly :: (Maybe Bool) , {-| Specific options for the folding range kind. @since 3.17.0 -} - _foldingRangeKind :: (Maybe Language.LSP.Protocol.Internal.Types.ClientFoldingRangeKindOptions.ClientFoldingRangeKindOptions) + foldingRangeKind :: (Maybe Language.LSP.Protocol.Internal.Types.ClientFoldingRangeKindOptions.ClientFoldingRangeKindOptions) , {-| Specific options for the folding range. @since 3.17.0 -} - _foldingRange :: (Maybe Language.LSP.Protocol.Internal.Types.ClientFoldingRangeOptions.ClientFoldingRangeOptions) + foldingRange :: (Maybe Language.LSP.Protocol.Internal.Types.ClientFoldingRangeOptions.ClientFoldingRangeOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeOptions.hs index dafdcb2e..e6c283c8 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeOptions.hs @@ -24,7 +24,7 @@ data FoldingRangeOptions = FoldingRangeOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeParams.hs index 98f26009..32ddcfb1 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeParams.hs @@ -26,16 +26,16 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeRegistrationOptions.hs index 1a8f6758..1793f839 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FoldingRangeRegistrationOptions.hs @@ -27,16 +27,16 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FormattingOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FormattingOptions.hs index 1220bb9b..29ef6712 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FormattingOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FormattingOptions.hs @@ -24,29 +24,29 @@ data FormattingOptions = FormattingOptions { {-| Size of a tab in spaces. -} - _tabSize :: Language.LSP.Protocol.Types.Common.UInt + tabSize :: Language.LSP.Protocol.Types.Common.UInt , {-| Prefer spaces over tabs. -} - _insertSpaces :: Bool + insertSpaces :: Bool , {-| Trim trailing whitespace on a line. @since 3.15.0 -} - _trimTrailingWhitespace :: (Maybe Bool) + 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) + insertFinalNewline :: (Maybe Bool) , {-| Trim all newlines after the final newline at the end of the file. @since 3.15.0 -} - _trimFinalNewlines :: (Maybe Bool) + trimFinalNewlines :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FullDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FullDocumentDiagnosticReport.hs index 312b50e8..d66aa2a0 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FullDocumentDiagnosticReport.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/FullDocumentDiagnosticReport.hs @@ -29,17 +29,17 @@ data FullDocumentDiagnosticReport = FullDocumentDiagnosticReport { {-| A full document diagnostic report. -} - _kind :: (Language.LSP.Protocol.Types.Singletons.AString "full") + 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) + resultId :: (Maybe Data.Text.Text) , {-| The actual items. -} - _items :: [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic] + items :: [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/GeneralClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/GeneralClientCapabilities.hs index 1e98ef0f..af07a291 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/GeneralClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/GeneralClientCapabilities.hs @@ -35,19 +35,19 @@ data GeneralClientCapabilities = GeneralClientCapabilities @since 3.17.0 -} - _staleRequestSupport :: (Maybe Language.LSP.Protocol.Internal.Types.StaleRequestSupportOptions.StaleRequestSupportOptions) + staleRequestSupport :: (Maybe Language.LSP.Protocol.Internal.Types.StaleRequestSupportOptions.StaleRequestSupportOptions) , {-| Client capabilities specific to regular expressions. @since 3.16.0 -} - _regularExpressions :: (Maybe Language.LSP.Protocol.Internal.Types.RegularExpressionsClientCapabilities.RegularExpressionsClientCapabilities) + 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) + 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 @@ -68,7 +68,7 @@ data GeneralClientCapabilities = GeneralClientCapabilities @since 3.17.0 -} - _positionEncodings :: (Maybe [Language.LSP.Protocol.Internal.Types.PositionEncodingKind.PositionEncodingKind]) + positionEncodings :: (Maybe [Language.LSP.Protocol.Internal.Types.PositionEncodingKind.PositionEncodingKind]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Hover.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Hover.hs index aa17db3d..a7274806 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Hover.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Hover.hs @@ -27,12 +27,12 @@ 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])) + 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) + range :: (Maybe Language.LSP.Protocol.Internal.Types.Range.Range) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverClientCapabilities.hs index 70028053..ad29cfa8 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverClientCapabilities.hs @@ -25,12 +25,12 @@ data HoverClientCapabilities = HoverClientCapabilities { {-| Whether hover supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + 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]) + contentFormat :: (Maybe [Language.LSP.Protocol.Internal.Types.MarkupKind.MarkupKind]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverOptions.hs index c4313484..8590fa4c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverOptions.hs @@ -24,7 +24,7 @@ data HoverOptions = HoverOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverParams.hs index f7cf4f6b..f8820c18 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverParams.hs @@ -27,15 +27,15 @@ data HoverParams = HoverParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverRegistrationOptions.hs index 39c37ee7..d2aaf3f8 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/HoverRegistrationOptions.hs @@ -26,11 +26,11 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationClientCapabilities.hs index da434a52..733431a7 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationClientCapabilities.hs @@ -26,13 +26,13 @@ data ImplementationClientCapabilities = ImplementationClientCapabilities the client supports the new `ImplementationRegistrationOptions` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| The client supports additional metadata in the form of definition links. @since 3.14.0 -} - _linkSupport :: (Maybe Bool) + linkSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationOptions.hs index 287b8b1a..6b6a3ce5 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationOptions.hs @@ -24,7 +24,7 @@ data ImplementationOptions = ImplementationOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationParams.hs index d8f8097d..8699bda1 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationParams.hs @@ -27,20 +27,20 @@ data ImplementationParams = ImplementationParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationRegistrationOptions.hs index 60358637..d4ebac33 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ImplementationRegistrationOptions.hs @@ -27,16 +27,16 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeError.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeError.hs index 319b3d09..ac79bbcc 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeError.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeError.hs @@ -28,7 +28,7 @@ data InitializeError = InitializeError (2) user selects retry or cancel (3) if user selected retry the initialize method is sent again. -} - _retry :: Bool + retry :: Bool } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeParams.hs index 8049badd..9e16f746 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeParams.hs @@ -32,7 +32,7 @@ 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The process Id of the parent process that started the server. @@ -40,13 +40,13 @@ data InitializeParams = InitializeParams 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) + 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 Language.LSP.Protocol.Internal.Types.ClientInfo.ClientInfo) + clientInfo :: (Maybe Language.LSP.Protocol.Internal.Types.ClientInfo.ClientInfo) , {-| The locale the client is currently showing the user interface in. This must not necessarily be the locale of the operating @@ -57,14 +57,14 @@ data InitializeParams = InitializeParams @since 3.16.0 -} - _locale :: (Maybe Data.Text.Text) + 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)) + 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 @@ -72,19 +72,19 @@ data InitializeParams = InitializeParams @deprecated in favour of workspaceFolders. -} - _rootUri :: (Language.LSP.Protocol.Types.Uri.Uri Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + 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 + capabilities :: Language.LSP.Protocol.Internal.Types.ClientCapabilities.ClientCapabilities , {-| User provided initialization options. -} - _initializationOptions :: (Maybe Data.Aeson.Value) + initializationOptions :: (Maybe Data.Aeson.Value) , {-| The initial trace setting. If omitted trace is disabled ('off'). -} - _trace :: (Maybe Language.LSP.Protocol.Internal.Types.TraceValue.TraceValue) + trace :: (Maybe Language.LSP.Protocol.Internal.Types.TraceValue.TraceValue) , {-| The workspace folders configured in the client when the server starts. @@ -94,7 +94,7 @@ data InitializeParams = InitializeParams @since 3.6.0 -} - _workspaceFolders :: (Maybe ([Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + 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) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeResult.hs index 3d2f587d..20e65c63 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeResult.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InitializeResult.hs @@ -26,13 +26,13 @@ data InitializeResult = InitializeResult { {-| The capabilities the language server provides. -} - _capabilities :: Language.LSP.Protocol.Internal.Types.ServerCapabilities.ServerCapabilities + capabilities :: Language.LSP.Protocol.Internal.Types.ServerCapabilities.ServerCapabilities , {-| Information about the server. @since 3.15.0 -} - _serverInfo :: (Maybe Language.LSP.Protocol.Internal.Types.ServerInfo.ServerInfo) + serverInfo :: (Maybe Language.LSP.Protocol.Internal.Types.ServerInfo.ServerInfo) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHint.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHint.hs index 03688dba..b39f6cc9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHint.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHint.hs @@ -36,19 +36,19 @@ data InlayHint = InlayHint If multiple hints have the same position, they will be shown in the order they appear in the response. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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]) + 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) + kind :: (Maybe Language.LSP.Protocol.Internal.Types.InlayHintKind.InlayHintKind) , {-| Optional text edits that are performed when accepting this inlay hint. @@ -56,11 +56,11 @@ data InlayHint = InlayHint 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]) + 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)) + tooltip :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.MarkupContent.MarkupContent)) , {-| Render padding before the hint. @@ -68,7 +68,7 @@ data InlayHint = InlayHint background color of the hint itself. That means padding can be used to visually align/separate an inlay hint. -} - _paddingLeft :: (Maybe Bool) + paddingLeft :: (Maybe Bool) , {-| Render padding after the hint. @@ -76,12 +76,12 @@ data InlayHint = InlayHint background color of the hint itself. That means padding can be used to visually align/separate an inlay hint. -} - _paddingRight :: (Maybe Bool) + 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) + data_ :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintClientCapabilities.hs index 0640a68e..fbd5ee98 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintClientCapabilities.hs @@ -27,12 +27,12 @@ data InlayHintClientCapabilities = InlayHintClientCapabilities { {-| Whether inlay hints support dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| Indicates which properties a client can resolve lazily on an inlay hint. -} - _resolveSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientInlayHintResolveOptions.ClientInlayHintResolveOptions) + resolveSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientInlayHintResolveOptions.ClientInlayHintResolveOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintLabelPart.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintLabelPart.hs index f6550f5f..23b20610 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintLabelPart.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintLabelPart.hs @@ -31,13 +31,13 @@ data InlayHintLabelPart = InlayHintLabelPart { {-| The value of this label part. -} - _value :: Data.Text.Text + 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)) + 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. @@ -51,14 +51,14 @@ data InlayHintLabelPart = InlayHintLabelPart 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) + 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) + command :: (Maybe Language.LSP.Protocol.Internal.Types.Command.Command) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintOptions.hs index 60b23366..1bcbc7ec 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintOptions.hs @@ -26,12 +26,12 @@ data InlayHintOptions = InlayHintOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| The server provides support to resolve additional information for an inlay hint item. -} - _resolveProvider :: (Maybe Bool) + resolveProvider :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintParams.hs index 7dcaab00..39fe6ddd 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintParams.hs @@ -29,15 +29,15 @@ 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + 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 + range :: Language.LSP.Protocol.Internal.Types.Range.Range } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintRegistrationOptions.hs index 7b2e8d7c..cbbd209c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintRegistrationOptions.hs @@ -28,22 +28,22 @@ data InlayHintRegistrationOptions = InlayHintRegistrationOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| The server provides support to resolve additional information for an inlay hint item. -} - _resolveProvider :: (Maybe Bool) + 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) + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintWorkspaceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintWorkspaceClientCapabilities.hs index ad50026f..34b281a2 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintWorkspaceClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlayHintWorkspaceClientCapabilities.hs @@ -32,7 +32,7 @@ data InlayHintWorkspaceClientCapabilities = InlayHintWorkspaceClientCapabilities is useful for situation where a server for example detects a project wide change that requires such a calculation. -} - _refreshSupport :: (Maybe Bool) + refreshSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueClientCapabilities.hs index 85155a64..6e7b943b 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueClientCapabilities.hs @@ -26,7 +26,7 @@ data InlineValueClientCapabilities = InlineValueClientCapabilities { {-| Whether implementation supports dynamic registration for inline value providers. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueContext.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueContext.hs index c6a830d7..ef36bf59 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueContext.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueContext.hs @@ -25,12 +25,12 @@ data InlineValueContext = InlineValueContext { {-| The stack frame (as a DAP Id) where the execution has stopped. -} - _frameId :: Language.LSP.Protocol.Types.Common.Int32 + 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 + stoppedLocation :: Language.LSP.Protocol.Internal.Types.Range.Range } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueEvaluatableExpression.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueEvaluatableExpression.hs index 64015642..7f6b5f56 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueEvaluatableExpression.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueEvaluatableExpression.hs @@ -31,11 +31,11 @@ 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 + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| If specified the expression overrides the extracted expression. -} - _expression :: (Maybe Data.Text.Text) + expression :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueOptions.hs index 8f860e53..d2769ab5 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueOptions.hs @@ -26,7 +26,7 @@ data InlineValueOptions = InlineValueOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueParams.hs index 366619a3..7bfe4b4d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueParams.hs @@ -30,20 +30,20 @@ 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + 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 + 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 + context :: Language.LSP.Protocol.Internal.Types.InlineValueContext.InlineValueContext } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueRegistrationOptions.hs index ac062b23..80f426d9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueRegistrationOptions.hs @@ -28,17 +28,17 @@ data InlineValueRegistrationOptions = InlineValueRegistrationOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + 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) + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueText.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueText.hs index f660e39a..6b2e1212 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueText.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueText.hs @@ -28,11 +28,11 @@ data InlineValueText = InlineValueText { {-| The document range for which the inline value applies. -} - _range :: Language.LSP.Protocol.Internal.Types.Range.Range + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| The text of the inline value. -} - _text :: Data.Text.Text + text :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueVariableLookup.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueVariableLookup.hs index 96a15663..aaf71659 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueVariableLookup.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueVariableLookup.hs @@ -31,15 +31,15 @@ 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 + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| If specified the name of the variable to look up. -} - _variableName :: (Maybe Data.Text.Text) + variableName :: (Maybe Data.Text.Text) , {-| How to perform the lookup. -} - _caseSensitiveLookup :: Bool + caseSensitiveLookup :: Bool } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueWorkspaceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueWorkspaceClientCapabilities.hs index 581562af..ce69af3c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueWorkspaceClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InlineValueWorkspaceClientCapabilities.hs @@ -32,7 +32,7 @@ data InlineValueWorkspaceClientCapabilities = InlineValueWorkspaceClientCapabili useful for situation where a server for example detects a project wide change that requires such a calculation. -} - _refreshSupport :: (Maybe Bool) + refreshSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertReplaceEdit.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertReplaceEdit.hs index 49af416a..5c6eb59d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertReplaceEdit.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/InsertReplaceEdit.hs @@ -28,15 +28,15 @@ data InsertReplaceEdit = InsertReplaceEdit { {-| The string to be inserted. -} - _newText :: Data.Text.Text + newText :: Data.Text.Text , {-| The range if the insert is requested -} - _insert :: Language.LSP.Protocol.Internal.Types.Range.Range + insert :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| The range if the replace is requested. -} - _replace :: Language.LSP.Protocol.Internal.Types.Range.Range + replace :: Language.LSP.Protocol.Internal.Types.Range.Range } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeClientCapabilities.hs index a12bcf11..e43a5980 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeClientCapabilities.hs @@ -28,7 +28,7 @@ data LinkedEditingRangeClientCapabilities = LinkedEditingRangeClientCapabilities the client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeOptions.hs index 3a706cac..f34bb5a7 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeOptions.hs @@ -24,7 +24,7 @@ data LinkedEditingRangeOptions = LinkedEditingRangeOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeParams.hs index a0dc9bc7..a58574f8 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeParams.hs @@ -27,15 +27,15 @@ data LinkedEditingRangeParams = LinkedEditingRangeParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeRegistrationOptions.hs index 3ef1357c..ffd38044 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRangeRegistrationOptions.hs @@ -27,16 +27,16 @@ data LinkedEditingRangeRegistrationOptions = LinkedEditingRangeRegistrationOptio 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRanges.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRanges.hs index 6976d212..0566c5ef 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRanges.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LinkedEditingRanges.hs @@ -29,13 +29,13 @@ 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] + 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) + wordPattern :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Location.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Location.hs index 9904f861..037a2ef2 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Location.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Location.hs @@ -27,11 +27,11 @@ data Location = Location { {-| -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + uri :: Language.LSP.Protocol.Types.Uri.Uri , {-| -} - _range :: Language.LSP.Protocol.Internal.Types.Range.Range + range :: Language.LSP.Protocol.Internal.Types.Range.Range } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LocationLink.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LocationLink.hs index ede95d66..9210d186 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LocationLink.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LocationLink.hs @@ -30,22 +30,22 @@ data LocationLink = LocationLink 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) + originSelectionRange :: (Maybe Language.LSP.Protocol.Internal.Types.Range.Range) , {-| The target resource identifier of this link. -} - _targetUri :: Language.LSP.Protocol.Types.Uri.Uri + 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 + 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 + targetSelectionRange :: Language.LSP.Protocol.Internal.Types.Range.Range } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LocationUriOnly.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LocationUriOnly.hs index 3715f5f2..467c5d2b 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LocationUriOnly.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LocationUriOnly.hs @@ -28,7 +28,7 @@ data LocationUriOnly = LocationUriOnly { {-| -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + uri :: Language.LSP.Protocol.Types.Uri.Uri } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogMessageParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogMessageParams.hs index 0c5e52bf..b9db421e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogMessageParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogMessageParams.hs @@ -26,11 +26,11 @@ data LogMessageParams = LogMessageParams { {-| The message type. See `MessageType` -} - _type_ :: Language.LSP.Protocol.Internal.Types.MessageType.MessageType + type_ :: Language.LSP.Protocol.Internal.Types.MessageType.MessageType , {-| The actual message. -} - _message :: Data.Text.Text + message :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogTraceParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogTraceParams.hs index 0f5346c0..8b26dc85 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogTraceParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/LogTraceParams.hs @@ -25,11 +25,11 @@ data LogTraceParams = LogTraceParams { {-| -} - _message :: Data.Text.Text + message :: Data.Text.Text , {-| -} - _verbose :: (Maybe Data.Text.Text) + verbose :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkdownClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkdownClientCapabilities.hs index e5a75691..bac53da6 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkdownClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkdownClientCapabilities.hs @@ -27,18 +27,18 @@ data MarkdownClientCapabilities = MarkdownClientCapabilities { {-| The name of the parser. -} - _parser :: Data.Text.Text + parser :: Data.Text.Text , {-| The version of the parser. -} - _version :: (Maybe Data.Text.Text) + 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]) + allowedTags :: (Maybe [Data.Text.Text]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkedStringWithLanguage.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkedStringWithLanguage.hs index fc4558fd..6c769b0a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkedStringWithLanguage.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkedStringWithLanguage.hs @@ -28,11 +28,11 @@ data MarkedStringWithLanguage = MarkedStringWithLanguage { {-| -} - _language :: Data.Text.Text + language :: Data.Text.Text , {-| -} - _value :: Data.Text.Text + value :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkupContent.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkupContent.hs index cb63d949..3857aaf2 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkupContent.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MarkupContent.hs @@ -47,11 +47,11 @@ data MarkupContent = MarkupContent { {-| The type of the Markup -} - _kind :: Language.LSP.Protocol.Internal.Types.MarkupKind.MarkupKind + kind :: Language.LSP.Protocol.Internal.Types.MarkupKind.MarkupKind , {-| The content itself -} - _value :: Data.Text.Text + value :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MessageActionItem.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MessageActionItem.hs index 56dca65e..3e14e4eb 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MessageActionItem.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MessageActionItem.hs @@ -25,7 +25,7 @@ data MessageActionItem = MessageActionItem { {-| A short title like 'Retry', 'Open Log' etc. -} - _title :: Data.Text.Text + title :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Moniker.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Moniker.hs index 70ffa4a4..615578e7 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Moniker.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Moniker.hs @@ -29,20 +29,20 @@ data Moniker = Moniker { {-| The scheme of the moniker. For example tsc or .Net -} - _scheme :: Data.Text.Text + 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 + identifier :: Data.Text.Text , {-| The scope in which the moniker is unique -} - _unique :: Language.LSP.Protocol.Internal.Types.UniquenessLevel.UniquenessLevel + unique :: Language.LSP.Protocol.Internal.Types.UniquenessLevel.UniquenessLevel , {-| The moniker kind if known. -} - _kind :: (Maybe Language.LSP.Protocol.Internal.Types.MonikerKind.MonikerKind) + kind :: (Maybe Language.LSP.Protocol.Internal.Types.MonikerKind.MonikerKind) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerClientCapabilities.hs index 2d0cd88f..fd471e80 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerClientCapabilities.hs @@ -28,7 +28,7 @@ data MonikerClientCapabilities = MonikerClientCapabilities the client supports the new `MonikerRegistrationOptions` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerOptions.hs index fc9c3d74..70a3a424 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerOptions.hs @@ -24,7 +24,7 @@ data MonikerOptions = MonikerOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerParams.hs index ffd168ee..5f06bb7f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerParams.hs @@ -27,20 +27,20 @@ data MonikerParams = MonikerParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerRegistrationOptions.hs index a4c48721..71818137 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/MonikerRegistrationOptions.hs @@ -26,11 +26,11 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCell.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCell.hs index 1015f204..f8e92cf7 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCell.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCell.hs @@ -34,23 +34,23 @@ data NotebookCell = NotebookCell { {-| The cell's kind -} - _kind :: Language.LSP.Protocol.Internal.Types.NotebookCellKind.NotebookCellKind + kind :: Language.LSP.Protocol.Internal.Types.NotebookCellKind.NotebookCellKind , {-| The URI of the cell's text document content. -} - _document :: Language.LSP.Protocol.Types.Uri.Uri + 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) + metadata :: (Maybe Data.Aeson.Object) , {-| Additional execution summary information if supported by the client. -} - _executionSummary :: (Maybe Language.LSP.Protocol.Internal.Types.ExecutionSummary.ExecutionSummary) + executionSummary :: (Maybe Language.LSP.Protocol.Internal.Types.ExecutionSummary.ExecutionSummary) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellArrayChange.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellArrayChange.hs index edd09133..5fe9de56 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellArrayChange.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellArrayChange.hs @@ -28,15 +28,15 @@ data NotebookCellArrayChange = NotebookCellArrayChange { {-| The start oftest of the cell that changed. -} - _start :: Language.LSP.Protocol.Types.Common.UInt + start :: Language.LSP.Protocol.Types.Common.UInt , {-| The deleted cells -} - _deleteCount :: Language.LSP.Protocol.Types.Common.UInt + deleteCount :: Language.LSP.Protocol.Types.Common.UInt , {-| The new cells, if any -} - _cells :: (Maybe [Language.LSP.Protocol.Internal.Types.NotebookCell.NotebookCell]) + cells :: (Maybe [Language.LSP.Protocol.Internal.Types.NotebookCell.NotebookCell]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellLanguage.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellLanguage.hs index fff54e69..8282f262 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellLanguage.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellLanguage.hs @@ -26,7 +26,7 @@ data NotebookCellLanguage = NotebookCellLanguage { {-| -} - _language :: Data.Text.Text + language :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellTextDocumentFilter.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellTextDocumentFilter.hs index 1db3be25..98a172b4 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellTextDocumentFilter.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookCellTextDocumentFilter.hs @@ -32,14 +32,14 @@ data NotebookCellTextDocumentFilter = NotebookCellTextDocumentFilter 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) + 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) + language :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocument.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocument.hs index 593d6bf2..3461ebca 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocument.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocument.hs @@ -30,27 +30,27 @@ data NotebookDocument = NotebookDocument { {-| The notebook document's uri. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + uri :: Language.LSP.Protocol.Types.Uri.Uri , {-| The type of the notebook. -} - _notebookType :: Data.Text.Text + 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 + 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) + metadata :: (Maybe Data.Aeson.Object) , {-| The cells of a notebook. -} - _cells :: [Language.LSP.Protocol.Internal.Types.NotebookCell.NotebookCell] + cells :: [Language.LSP.Protocol.Internal.Types.NotebookCell.NotebookCell] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentCellChangeStructure.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentCellChangeStructure.hs index 9fc80766..131abbb1 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentCellChangeStructure.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentCellChangeStructure.hs @@ -30,15 +30,15 @@ data NotebookDocumentCellChangeStructure = NotebookDocumentCellChangeStructure { {-| The change to the cell array. -} - _array :: Language.LSP.Protocol.Internal.Types.NotebookCellArrayChange.NotebookCellArrayChange + array :: Language.LSP.Protocol.Internal.Types.NotebookCellArrayChange.NotebookCellArrayChange , {-| Additional opened cell text documents. -} - _didOpen :: (Maybe [Language.LSP.Protocol.Internal.Types.TextDocumentItem.TextDocumentItem]) + didOpen :: (Maybe [Language.LSP.Protocol.Internal.Types.TextDocumentItem.TextDocumentItem]) , {-| Additional closed cell text documents. -} - _didClose :: (Maybe [Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier]) + didClose :: (Maybe [Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentCellChanges.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentCellChanges.hs index 6029be44..30199230 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentCellChanges.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentCellChanges.hs @@ -31,16 +31,16 @@ data NotebookDocumentCellChanges = NotebookDocumentCellChanges Changes to the cell structure to add or remove cells. -} - _structure :: (Maybe Language.LSP.Protocol.Internal.Types.NotebookDocumentCellChangeStructure.NotebookDocumentCellChangeStructure) + structure :: (Maybe Language.LSP.Protocol.Internal.Types.NotebookDocumentCellChangeStructure.NotebookDocumentCellChangeStructure) , {-| Changes to notebook cells properties like its kind, execution summary or metadata. -} - _data_ :: (Maybe [Language.LSP.Protocol.Internal.Types.NotebookCell.NotebookCell]) + data_ :: (Maybe [Language.LSP.Protocol.Internal.Types.NotebookCell.NotebookCell]) , {-| Changes to the text content of notebook cells. -} - _textContent :: (Maybe [Language.LSP.Protocol.Internal.Types.NotebookDocumentCellContentChanges.NotebookDocumentCellContentChanges]) + textContent :: (Maybe [Language.LSP.Protocol.Internal.Types.NotebookDocumentCellContentChanges.NotebookDocumentCellContentChanges]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentCellContentChanges.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentCellContentChanges.hs index 05271385..d37603fb 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentCellContentChanges.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentCellContentChanges.hs @@ -29,11 +29,11 @@ data NotebookDocumentCellContentChanges = NotebookDocumentCellContentChanges { {-| -} - _document :: Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier.VersionedTextDocumentIdentifier + document :: Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier.VersionedTextDocumentIdentifier , {-| -} - _changes :: [Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent.TextDocumentContentChangeEvent] + changes :: [Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent.TextDocumentContentChangeEvent] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentChangeEvent.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentChangeEvent.hs index bf5fbb9b..e51b6fd7 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentChangeEvent.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentChangeEvent.hs @@ -30,11 +30,11 @@ data NotebookDocumentChangeEvent = NotebookDocumentChangeEvent Note: should always be an object literal (e.g. LSPObject) -} - _metadata :: (Maybe Data.Aeson.Object) + metadata :: (Maybe Data.Aeson.Object) , {-| Changes to cells -} - _cells :: (Maybe Language.LSP.Protocol.Internal.Types.NotebookDocumentCellChanges.NotebookDocumentCellChanges) + cells :: (Maybe Language.LSP.Protocol.Internal.Types.NotebookDocumentCellChanges.NotebookDocumentCellChanges) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentClientCapabilities.hs index 14d86206..085a7f14 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentClientCapabilities.hs @@ -29,7 +29,7 @@ data NotebookDocumentClientCapabilities = NotebookDocumentClientCapabilities @since 3.17.0 -} - _synchronization :: Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncClientCapabilities.NotebookDocumentSyncClientCapabilities + synchronization :: Language.LSP.Protocol.Internal.Types.NotebookDocumentSyncClientCapabilities.NotebookDocumentSyncClientCapabilities } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterNotebookType.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterNotebookType.hs index f926e292..22fdf121 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterNotebookType.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterNotebookType.hs @@ -28,15 +28,15 @@ data NotebookDocumentFilterNotebookType = NotebookDocumentFilterNotebookType { {-| The type of the enclosing notebook. -} - _notebookType :: Data.Text.Text + notebookType :: Data.Text.Text , {-| A Uri `Uri.scheme`, like `file` or `untitled`. -} - _scheme :: (Maybe Data.Text.Text) + scheme :: (Maybe Data.Text.Text) , {-| A glob pattern. -} - _pattern :: (Maybe Data.Text.Text) + pattern :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterPattern.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterPattern.hs index 44f44f32..3fb882f1 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterPattern.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterPattern.hs @@ -28,15 +28,15 @@ data NotebookDocumentFilterPattern = NotebookDocumentFilterPattern { {-| The type of the enclosing notebook. -} - _notebookType :: (Maybe Data.Text.Text) + notebookType :: (Maybe Data.Text.Text) , {-| A Uri `Uri.scheme`, like `file` or `untitled`. -} - _scheme :: (Maybe Data.Text.Text) + scheme :: (Maybe Data.Text.Text) , {-| A glob pattern. -} - _pattern :: Data.Text.Text + pattern :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterScheme.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterScheme.hs index 050fe1e3..28deb0a1 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterScheme.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterScheme.hs @@ -28,15 +28,15 @@ data NotebookDocumentFilterScheme = NotebookDocumentFilterScheme { {-| The type of the enclosing notebook. -} - _notebookType :: (Maybe Data.Text.Text) + notebookType :: (Maybe Data.Text.Text) , {-| A Uri `Uri.scheme`, like `file` or `untitled`. -} - _scheme :: Data.Text.Text + scheme :: Data.Text.Text , {-| A glob pattern. -} - _pattern :: (Maybe Data.Text.Text) + pattern :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterWithCells.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterWithCells.hs index 946661d0..d9bb8e87 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterWithCells.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterWithCells.hs @@ -30,11 +30,11 @@ data NotebookDocumentFilterWithCells = NotebookDocumentFilterWithCells value is provided it matches against the notebook type. '*' matches every notebook. -} - _notebook :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter.NotebookDocumentFilter)) + notebook :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter.NotebookDocumentFilter)) , {-| The cells of the matching notebook to be synced. -} - _cells :: [Language.LSP.Protocol.Internal.Types.NotebookCellLanguage.NotebookCellLanguage] + cells :: [Language.LSP.Protocol.Internal.Types.NotebookCellLanguage.NotebookCellLanguage] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterWithNotebook.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterWithNotebook.hs index c7bd3246..2f91006f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterWithNotebook.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentFilterWithNotebook.hs @@ -30,11 +30,11 @@ data NotebookDocumentFilterWithNotebook = NotebookDocumentFilterWithNotebook 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) + notebook :: (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter.NotebookDocumentFilter) , {-| The cells of the matching notebook to be synced. -} - _cells :: (Maybe [Language.LSP.Protocol.Internal.Types.NotebookCellLanguage.NotebookCellLanguage]) + cells :: (Maybe [Language.LSP.Protocol.Internal.Types.NotebookCellLanguage.NotebookCellLanguage]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentIdentifier.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentIdentifier.hs index d4739753..3a16dec3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentIdentifier.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentIdentifier.hs @@ -27,7 +27,7 @@ data NotebookDocumentIdentifier = NotebookDocumentIdentifier { {-| The notebook document's uri. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + uri :: Language.LSP.Protocol.Types.Uri.Uri } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncClientCapabilities.hs index 623a92c4..965bd875 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncClientCapabilities.hs @@ -29,11 +29,11 @@ data NotebookDocumentSyncClientCapabilities = NotebookDocumentSyncClientCapabili `(TextDocumentRegistrationOptions & StaticRegistrationOptions)` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| The client supports sending execution summary data per cell. -} - _executionSummarySupport :: (Maybe Bool) + executionSummarySupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncOptions.hs index fd2cb826..f149aab9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncOptions.hs @@ -38,12 +38,12 @@ data NotebookDocumentSyncOptions = NotebookDocumentSyncOptions { {-| The notebooks to be synced -} - _notebookSelector :: [(Language.LSP.Protocol.Internal.Types.NotebookDocumentFilterWithNotebook.NotebookDocumentFilterWithNotebook Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilterWithCells.NotebookDocumentFilterWithCells)] + notebookSelector :: [(Language.LSP.Protocol.Internal.Types.NotebookDocumentFilterWithNotebook.NotebookDocumentFilterWithNotebook Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilterWithCells.NotebookDocumentFilterWithCells)] , {-| Whether save notification should be forwarded to the server. Will only be honored if mode === `notebook`. -} - _save :: (Maybe Bool) + save :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncRegistrationOptions.hs index f061f5bb..8dc2cf41 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/NotebookDocumentSyncRegistrationOptions.hs @@ -29,17 +29,17 @@ data NotebookDocumentSyncRegistrationOptions = NotebookDocumentSyncRegistrationO { {-| The notebooks to be synced -} - _notebookSelector :: [(Language.LSP.Protocol.Internal.Types.NotebookDocumentFilterWithNotebook.NotebookDocumentFilterWithNotebook Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilterWithCells.NotebookDocumentFilterWithCells)] + notebookSelector :: [(Language.LSP.Protocol.Internal.Types.NotebookDocumentFilterWithNotebook.NotebookDocumentFilterWithNotebook Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilterWithCells.NotebookDocumentFilterWithCells)] , {-| Whether save notification should be forwarded to the server. Will only be honored if mode === `notebook`. -} - _save :: (Maybe Bool) + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/OptionalVersionedTextDocumentIdentifier.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/OptionalVersionedTextDocumentIdentifier.hs index 5a1bb0a0..cb3e268a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/OptionalVersionedTextDocumentIdentifier.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/OptionalVersionedTextDocumentIdentifier.hs @@ -25,7 +25,7 @@ data OptionalVersionedTextDocumentIdentifier = OptionalVersionedTextDocumentIden { {-| The text document's uri. -} - _uri :: Language.LSP.Protocol.Types.Uri.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 @@ -33,7 +33,7 @@ data OptionalVersionedTextDocumentIdentifier = OptionalVersionedTextDocumentIden `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) + version :: (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ParameterInformation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ParameterInformation.hs index b17610e6..65bfc9f0 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ParameterInformation.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ParameterInformation.hs @@ -38,13 +38,13 @@ data ParameterInformation = ParameterInformation *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 + 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)) + documentation :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.MarkupContent.MarkupContent)) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PartialResultParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PartialResultParams.hs index 8d7d1b57..b412a414 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PartialResultParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PartialResultParams.hs @@ -26,7 +26,7 @@ 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Position.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Position.hs index 2f8cdbd9..e448d7f4 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Position.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Position.hs @@ -53,7 +53,7 @@ data Position = Position 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 + line :: Language.LSP.Protocol.Types.Common.UInt , {-| Character offset on a line in a document (zero-based). @@ -63,7 +63,7 @@ data Position = Position If the character value is greater than the line length it defaults back to the line length. -} - _character :: Language.LSP.Protocol.Types.Common.UInt + character :: Language.LSP.Protocol.Types.Common.UInt } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameDefaultBehavior.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameDefaultBehavior.hs index 7d512190..6a6fd557 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameDefaultBehavior.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameDefaultBehavior.hs @@ -25,7 +25,7 @@ data PrepareRenameDefaultBehavior = PrepareRenameDefaultBehavior { {-| -} - _defaultBehavior :: Bool + defaultBehavior :: Bool } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameParams.hs index b7162acf..11638fa8 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenameParams.hs @@ -27,15 +27,15 @@ data PrepareRenameParams = PrepareRenameParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenamePlaceholder.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenamePlaceholder.hs index ca2afb64..243eceb9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenamePlaceholder.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PrepareRenamePlaceholder.hs @@ -27,11 +27,11 @@ data PrepareRenamePlaceholder = PrepareRenamePlaceholder { {-| -} - _range :: Language.LSP.Protocol.Internal.Types.Range.Range + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| -} - _placeholder :: Data.Text.Text + placeholder :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PreviousResultId.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PreviousResultId.hs index 60eb0fb1..040019bf 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PreviousResultId.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PreviousResultId.hs @@ -29,11 +29,11 @@ data PreviousResultId = PreviousResultId The URI for which the client knowns a result id. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + uri :: Language.LSP.Protocol.Types.Uri.Uri , {-| The value of the previous result id. -} - _value :: Data.Text.Text + value :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ProgressParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ProgressParams.hs index e58898f4..9bdf2a2d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ProgressParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ProgressParams.hs @@ -26,11 +26,11 @@ data ProgressParams = ProgressParams { {-| The progress token provided by the client or server. -} - _token :: Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken + token :: Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken , {-| The progress data. -} - _value :: Data.Aeson.Value + value :: Data.Aeson.Value } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsClientCapabilities.hs index 474cf9dd..db700de0 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsClientCapabilities.hs @@ -25,27 +25,27 @@ data PublishDiagnosticsClientCapabilities = PublishDiagnosticsClientCapabilities { {-| Whether the clients accepts diagnostics with related information. -} - _relatedInformation :: (Maybe Bool) + 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 Language.LSP.Protocol.Internal.Types.ClientDiagnosticsTagOptions.ClientDiagnosticsTagOptions) + tagSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientDiagnosticsTagOptions.ClientDiagnosticsTagOptions) , {-| Whether the client interprets the version property of the `textDocument/publishDiagnostics` notification's parameter. @since 3.15.0 -} - _versionSupport :: (Maybe Bool) + versionSupport :: (Maybe Bool) , {-| Client supports a codeDescription property @since 3.16.0 -} - _codeDescriptionSupport :: (Maybe Bool) + codeDescriptionSupport :: (Maybe Bool) , {-| Whether code action supports the `data` property which is preserved between a `textDocument/publishDiagnostics` and @@ -53,7 +53,7 @@ data PublishDiagnosticsClientCapabilities = PublishDiagnosticsClientCapabilities @since 3.16.0 -} - _dataSupport :: (Maybe Bool) + dataSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsParams.hs index ff5df513..e75a1c96 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/PublishDiagnosticsParams.hs @@ -26,17 +26,17 @@ data PublishDiagnosticsParams = PublishDiagnosticsParams { {-| The URI for which diagnostic information is reported. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + 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) + version :: (Maybe Language.LSP.Protocol.Types.Common.Int32) , {-| An array of diagnostic information items. -} - _diagnostics :: [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic] + diagnostics :: [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Range.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Range.hs index ad47d343..04f4db82 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Range.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Range.hs @@ -35,11 +35,11 @@ data Range = Range { {-| The range's start position. -} - _start :: Language.LSP.Protocol.Internal.Types.Position.Position + start :: Language.LSP.Protocol.Internal.Types.Position.Position , {-| The range's end position. -} - _end :: Language.LSP.Protocol.Internal.Types.Position.Position + end :: Language.LSP.Protocol.Internal.Types.Position.Position } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceClientCapabilities.hs index 55c896a0..a0c8c81d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceClientCapabilities.hs @@ -24,7 +24,7 @@ data ReferenceClientCapabilities = ReferenceClientCapabilities { {-| Whether references supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceContext.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceContext.hs index fc38d67b..20f0129f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceContext.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceContext.hs @@ -25,7 +25,7 @@ data ReferenceContext = ReferenceContext { {-| Include the declaration of the current symbol. -} - _includeDeclaration :: Bool + includeDeclaration :: Bool } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceOptions.hs index 8f544ed2..0bd4b8f3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceOptions.hs @@ -24,7 +24,7 @@ data ReferenceOptions = ReferenceOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceParams.hs index 0d160ae3..ab9cc445 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceParams.hs @@ -28,24 +28,24 @@ data ReferenceParams = ReferenceParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| -} - _context :: Language.LSP.Protocol.Internal.Types.ReferenceContext.ReferenceContext + context :: Language.LSP.Protocol.Internal.Types.ReferenceContext.ReferenceContext } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceRegistrationOptions.hs index c5b52f58..0ef2d3c9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ReferenceRegistrationOptions.hs @@ -26,11 +26,11 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Registration.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Registration.hs index 0e767868..172c63e2 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Registration.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Registration.hs @@ -27,15 +27,15 @@ data Registration = Registration The id used to register the request. The id can be used to deregister the request again. -} - _id :: Data.Text.Text + id :: Data.Text.Text , {-| The method / capability to register for. -} - _method :: Data.Text.Text + method :: Data.Text.Text , {-| Options necessary for the registration. -} - _registerOptions :: (Maybe Data.Aeson.Value) + registerOptions :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegistrationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegistrationParams.hs index a499d4d3..46c5b0d3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegistrationParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegistrationParams.hs @@ -25,7 +25,7 @@ data RegistrationParams = RegistrationParams { {-| -} - _registrations :: [Language.LSP.Protocol.Internal.Types.Registration.Registration] + registrations :: [Language.LSP.Protocol.Internal.Types.Registration.Registration] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegularExpressionsClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegularExpressionsClientCapabilities.hs index 7972080e..d84d224b 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegularExpressionsClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RegularExpressionsClientCapabilities.hs @@ -28,11 +28,11 @@ data RegularExpressionsClientCapabilities = RegularExpressionsClientCapabilities { {-| The engine's name. -} - _engine :: Language.LSP.Protocol.Internal.Types.RegularExpressionEngineKind.RegularExpressionEngineKind + engine :: Language.LSP.Protocol.Internal.Types.RegularExpressionEngineKind.RegularExpressionEngineKind , {-| The engine's version. -} - _version :: (Maybe Data.Text.Text) + version :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedFullDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedFullDocumentDiagnosticReport.hs index e7ac0dd8..ca2c5540 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedFullDocumentDiagnosticReport.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedFullDocumentDiagnosticReport.hs @@ -33,17 +33,17 @@ data RelatedFullDocumentDiagnosticReport = RelatedFullDocumentDiagnosticReport { {-| A full document diagnostic report. -} - _kind :: (Language.LSP.Protocol.Types.Singletons.AString "full") + 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) + resultId :: (Maybe Data.Text.Text) , {-| The actual items. -} - _items :: [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic] + 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 @@ -53,7 +53,7 @@ data RelatedFullDocumentDiagnosticReport = RelatedFullDocumentDiagnosticReport @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))) + 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) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedUnchangedDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedUnchangedDocumentDiagnosticReport.hs index 97417d9e..b963d722 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedUnchangedDocumentDiagnosticReport.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelatedUnchangedDocumentDiagnosticReport.hs @@ -35,12 +35,12 @@ data RelatedUnchangedDocumentDiagnosticReport = RelatedUnchangedDocumentDiagnost only return `unchanged` if result ids are provided. -} - _kind :: (Language.LSP.Protocol.Types.Singletons.AString "unchanged") + 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 + resultId :: Data.Text.Text , {-| Diagnostics of related documents. This information is useful in programming languages where code in a file A can generate @@ -50,7 +50,7 @@ data RelatedUnchangedDocumentDiagnosticReport = RelatedUnchangedDocumentDiagnost @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))) + 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) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelativePattern.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelativePattern.hs index 229e51f1..eb8e8f7c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelativePattern.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RelativePattern.hs @@ -32,11 +32,11 @@ 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) + 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 + pattern :: Language.LSP.Protocol.Internal.Types.Pattern.Pattern } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameClientCapabilities.hs index f3cc32c0..6d1040c7 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameClientCapabilities.hs @@ -25,14 +25,14 @@ data RenameClientCapabilities = RenameClientCapabilities { {-| Whether rename supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| Client supports testing for validity of rename operations before execution. @since 3.12.0 -} - _prepareSupport :: (Maybe Bool) + prepareSupport :: (Maybe Bool) , {-| Client supports the default behavior result. @@ -41,7 +41,7 @@ data RenameClientCapabilities = RenameClientCapabilities @since 3.16.0 -} - _prepareSupportDefaultBehavior :: (Maybe Language.LSP.Protocol.Internal.Types.PrepareSupportDefaultBehavior.PrepareSupportDefaultBehavior) + 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 @@ -51,7 +51,7 @@ data RenameClientCapabilities = RenameClientCapabilities @since 3.16.0 -} - _honorsChangeAnnotations :: (Maybe Bool) + honorsChangeAnnotations :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFile.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFile.hs index c09256b4..500893c1 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFile.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFile.hs @@ -30,23 +30,23 @@ data RenameFile = RenameFile @since 3.16.0 -} - _annotationId :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier) + annotationId :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier) , {-| A rename -} - _kind :: (Language.LSP.Protocol.Types.Singletons.AString "rename") + kind :: (Language.LSP.Protocol.Types.Singletons.AString "rename") , {-| The old (existing) location. -} - _oldUri :: Language.LSP.Protocol.Types.Uri.Uri + oldUri :: Language.LSP.Protocol.Types.Uri.Uri , {-| The new location. -} - _newUri :: Language.LSP.Protocol.Types.Uri.Uri + newUri :: Language.LSP.Protocol.Types.Uri.Uri , {-| Rename options. -} - _options :: (Maybe Language.LSP.Protocol.Internal.Types.RenameFileOptions.RenameFileOptions) + options :: (Maybe Language.LSP.Protocol.Internal.Types.RenameFileOptions.RenameFileOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFileOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFileOptions.hs index 8ee51446..a7eee7e7 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFileOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFileOptions.hs @@ -24,11 +24,11 @@ data RenameFileOptions = RenameFileOptions { {-| Overwrite target if existing. Overwrite wins over `ignoreIfExists` -} - _overwrite :: (Maybe Bool) + overwrite :: (Maybe Bool) , {-| Ignores if target exists. -} - _ignoreIfExists :: (Maybe Bool) + ignoreIfExists :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFilesParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFilesParams.hs index ac0424ea..47f3cba3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFilesParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameFilesParams.hs @@ -29,7 +29,7 @@ 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] + files :: [Language.LSP.Protocol.Internal.Types.FileRename.FileRename] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameOptions.hs index d3ee4b59..8d5e4477 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameOptions.hs @@ -24,13 +24,13 @@ data RenameOptions = RenameOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| Renames should be checked and tested before being executed. @since version 3.12.0 -} - _prepareProvider :: (Maybe Bool) + prepareProvider :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameParams.hs index de1d4151..b96cb71f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameParams.hs @@ -28,21 +28,21 @@ 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The document to rename. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position at which this request was sent. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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 + newName :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameRegistrationOptions.hs index 98dce899..c81a1e71 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/RenameRegistrationOptions.hs @@ -26,17 +26,17 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| Renames should be checked and tested before being executed. @since version 3.12.0 -} - _prepareProvider :: (Maybe Bool) + prepareProvider :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ResourceOperation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ResourceOperation.hs index b65aceed..34399a70 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ResourceOperation.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ResourceOperation.hs @@ -26,13 +26,13 @@ data ResourceOperation = ResourceOperation { {-| The resource operation kind. -} - _kind :: Data.Text.Text + kind :: Data.Text.Text , {-| An optional annotation identifier describing the operation. @since 3.16.0 -} - _annotationId :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier) + annotationId :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SaveOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SaveOptions.hs index f3ff75f0..4ddde1ac 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SaveOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SaveOptions.hs @@ -24,7 +24,7 @@ data SaveOptions = SaveOptions { {-| The client is supposed to include the content on save. -} - _includeText :: (Maybe Bool) + includeText :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRange.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRange.hs index 4cb349f8..fd0e5f1e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRange.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRange.hs @@ -26,11 +26,11 @@ data SelectionRange = SelectionRange { {-| The `Range` of this selection range. -} - _range :: Language.LSP.Protocol.Internal.Types.Range.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) + parent :: (Maybe Language.LSP.Protocol.Internal.Types.SelectionRange.SelectionRange) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeClientCapabilities.hs index ed99760d..5ccd0fa1 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeClientCapabilities.hs @@ -26,7 +26,7 @@ data SelectionRangeClientCapabilities = SelectionRangeClientCapabilities the client supports the new `SelectionRangeRegistrationOptions` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeOptions.hs index bf4f8b94..62fc0e22 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeOptions.hs @@ -24,7 +24,7 @@ data SelectionRangeOptions = SelectionRangeOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeParams.hs index 249280cf..93aa1480 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeParams.hs @@ -27,20 +27,20 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The positions inside the text document. -} - _positions :: [Language.LSP.Protocol.Internal.Types.Position.Position] + positions :: [Language.LSP.Protocol.Internal.Types.Position.Position] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeRegistrationOptions.hs index 054b8b1c..bd4254b4 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SelectionRangeRegistrationOptions.hs @@ -26,17 +26,17 @@ data SelectionRangeRegistrationOptions = SelectionRangeRegistrationOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + 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) + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokens.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokens.hs index f80dd3c4..5b235a11 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokens.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokens.hs @@ -28,11 +28,11 @@ data SemanticTokens = SemanticTokens A server can then instead of computing all semantic tokens again simply send a delta. -} - _resultId :: (Maybe Data.Text.Text) + resultId :: (Maybe Data.Text.Text) , {-| The actual tokens. -} - _data_ :: [Language.LSP.Protocol.Types.Common.UInt] + data_ :: [Language.LSP.Protocol.Types.Common.UInt] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensClientCapabilities.hs index 2d95dbca..7a30e75a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensClientCapabilities.hs @@ -29,7 +29,7 @@ data SemanticTokensClientCapabilities = SemanticTokensClientCapabilities the client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + 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 @@ -40,27 +40,27 @@ data SemanticTokensClientCapabilities = SemanticTokensClientCapabilities range provider the client might not render a minimap correctly or might even decide to not show any semantic tokens at all. -} - _requests :: Language.LSP.Protocol.Internal.Types.ClientSemanticTokensRequestOptions.ClientSemanticTokensRequestOptions + requests :: Language.LSP.Protocol.Internal.Types.ClientSemanticTokensRequestOptions.ClientSemanticTokensRequestOptions , {-| The token types that the client supports. -} - _tokenTypes :: [Data.Text.Text] + tokenTypes :: [Data.Text.Text] , {-| The token modifiers that the client supports. -} - _tokenModifiers :: [Data.Text.Text] + tokenModifiers :: [Data.Text.Text] , {-| The token formats the clients supports. -} - _formats :: [Language.LSP.Protocol.Internal.Types.TokenFormat.TokenFormat] + formats :: [Language.LSP.Protocol.Internal.Types.TokenFormat.TokenFormat] , {-| Whether the client supports tokens that can overlap each other. -} - _overlappingTokenSupport :: (Maybe Bool) + overlappingTokenSupport :: (Maybe Bool) , {-| Whether the client supports tokens that can span multiple lines. -} - _multilineTokenSupport :: (Maybe Bool) + multilineTokenSupport :: (Maybe Bool) , {-| Whether the client allows the server to actively cancel a semantic token request, e.g. supports returning @@ -69,7 +69,7 @@ data SemanticTokensClientCapabilities = SemanticTokensClientCapabilities @since 3.17.0 -} - _serverCancelSupport :: (Maybe Bool) + serverCancelSupport :: (Maybe Bool) , {-| Whether the client uses semantic tokens to augment existing syntax tokens. If set to `true` client side created syntax @@ -82,7 +82,7 @@ data SemanticTokensClientCapabilities = SemanticTokensClientCapabilities @since 3.17.0 -} - _augmentsSyntaxTokens :: (Maybe Bool) + augmentsSyntaxTokens :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDelta.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDelta.hs index e4d53a21..dbc76e1c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDelta.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDelta.hs @@ -26,11 +26,11 @@ data SemanticTokensDelta = SemanticTokensDelta { {-| -} - _resultId :: (Maybe Data.Text.Text) + 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] + edits :: [Language.LSP.Protocol.Internal.Types.SemanticTokensEdit.SemanticTokensEdit] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaParams.hs index a91579be..59a6b46d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaParams.hs @@ -27,21 +27,21 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + 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 + previousResultId :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaPartialResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaPartialResult.hs index 82a22ac9..eaa1fdb3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaPartialResult.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensDeltaPartialResult.hs @@ -25,7 +25,7 @@ data SemanticTokensDeltaPartialResult = SemanticTokensDeltaPartialResult { {-| -} - _edits :: [Language.LSP.Protocol.Internal.Types.SemanticTokensEdit.SemanticTokensEdit] + edits :: [Language.LSP.Protocol.Internal.Types.SemanticTokensEdit.SemanticTokensEdit] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensEdit.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensEdit.hs index 84922e55..6f743a5c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensEdit.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensEdit.hs @@ -24,15 +24,15 @@ data SemanticTokensEdit = SemanticTokensEdit { {-| The start offset of the edit. -} - _start :: Language.LSP.Protocol.Types.Common.UInt + start :: Language.LSP.Protocol.Types.Common.UInt , {-| The count of elements to remove. -} - _deleteCount :: Language.LSP.Protocol.Types.Common.UInt + deleteCount :: Language.LSP.Protocol.Types.Common.UInt , {-| The elements to insert. -} - _data_ :: (Maybe [Language.LSP.Protocol.Types.Common.UInt]) + data_ :: (Maybe [Language.LSP.Protocol.Types.Common.UInt]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensFullDelta.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensFullDelta.hs index a1e6506b..f6c2bc5a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensFullDelta.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensFullDelta.hs @@ -27,7 +27,7 @@ data SemanticTokensFullDelta = SemanticTokensFullDelta { {-| The server supports deltas for full documents. -} - _delta :: (Maybe Bool) + delta :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensLegend.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensLegend.hs index 594a058f..d3cc67b3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensLegend.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensLegend.hs @@ -25,11 +25,11 @@ data SemanticTokensLegend = SemanticTokensLegend { {-| The token types a server uses. -} - _tokenTypes :: [Data.Text.Text] + tokenTypes :: [Data.Text.Text] , {-| The token modifiers a server uses. -} - _tokenModifiers :: [Data.Text.Text] + tokenModifiers :: [Data.Text.Text] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensOptions.hs index e937d05a..7af2e306 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensOptions.hs @@ -27,20 +27,20 @@ data SemanticTokensOptions = SemanticTokensOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| The legend used by the server -} - _legend :: Language.LSP.Protocol.Internal.Types.SemanticTokensLegend.SemanticTokensLegend + 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))) + 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.|? Language.LSP.Protocol.Internal.Types.SemanticTokensFullDelta.SemanticTokensFullDelta)) + full :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.SemanticTokensFullDelta.SemanticTokensFullDelta)) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensParams.hs index 9676da5e..af85ed80 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensParams.hs @@ -26,16 +26,16 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensPartialResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensPartialResult.hs index 7d7f5918..6d4a72cd 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensPartialResult.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensPartialResult.hs @@ -24,7 +24,7 @@ data SemanticTokensPartialResult = SemanticTokensPartialResult { {-| -} - _data_ :: [Language.LSP.Protocol.Types.Common.UInt] + data_ :: [Language.LSP.Protocol.Types.Common.UInt] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRangeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRangeParams.hs index 42a64413..8989191f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRangeParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRangeParams.hs @@ -27,20 +27,20 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The range the semantic tokens are requested for. -} - _range :: Language.LSP.Protocol.Internal.Types.Range.Range + range :: Language.LSP.Protocol.Internal.Types.Range.Range } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRegistrationOptions.hs index 87cd6560..79a17ccb 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensRegistrationOptions.hs @@ -30,29 +30,29 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| The legend used by the server -} - _legend :: Language.LSP.Protocol.Internal.Types.SemanticTokensLegend.SemanticTokensLegend + 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))) + 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.|? Language.LSP.Protocol.Internal.Types.SemanticTokensFullDelta.SemanticTokensFullDelta)) + full :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.SemanticTokensFullDelta.SemanticTokensFullDelta)) , {-| 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensWorkspaceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensWorkspaceClientCapabilities.hs index a1e2d910..3ac80bb6 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensWorkspaceClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SemanticTokensWorkspaceClientCapabilities.hs @@ -30,7 +30,7 @@ data SemanticTokensWorkspaceClientCapabilities = SemanticTokensWorkspaceClientCa and is useful for situation where a server for example detects a project wide change that requires such a calculation. -} - _refreshSupport :: (Maybe Bool) + refreshSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerCapabilities.hs index 119aa752..520baf5c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerCapabilities.hs @@ -84,167 +84,167 @@ data ServerCapabilities = ServerCapabilities @since 3.17.0 -} - _positionEncoding :: (Maybe Language.LSP.Protocol.Internal.Types.PositionEncodingKind.PositionEncodingKind) + 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)) + 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)) + 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) + 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)) + 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) + 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))) + 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)) + 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))) + 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))) + 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)) + 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)) + 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)) + 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)) + 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) + codeLensProvider :: (Maybe Language.LSP.Protocol.Internal.Types.CodeLensOptions.CodeLensOptions) , {-| The server provides document link support. -} - _documentLinkProvider :: (Maybe Language.LSP.Protocol.Internal.Types.DocumentLinkOptions.DocumentLinkOptions) + 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))) + 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)) + 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)) + 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)) + 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) + 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)) + 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))) + 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))) + 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) + 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))) + 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))) + 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)) + 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))) + 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))) + 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))) + 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))) + 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)) + 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 Language.LSP.Protocol.Internal.Types.WorkspaceOptions.WorkspaceOptions) + workspace :: (Maybe Language.LSP.Protocol.Internal.Types.WorkspaceOptions.WorkspaceOptions) , {-| Experimental server capabilities. -} - _experimental :: (Maybe Data.Aeson.Value) + experimental :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerCompletionItemOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerCompletionItemOptions.hs index c2d66ad2..b8911cb7 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerCompletionItemOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerCompletionItemOptions.hs @@ -29,7 +29,7 @@ data ServerCompletionItemOptions = ServerCompletionItemOptions @since 3.17.0 -} - _labelDetailsSupport :: (Maybe Bool) + labelDetailsSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerInfo.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerInfo.hs index 5ef1cc87..90433265 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerInfo.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ServerInfo.hs @@ -29,11 +29,11 @@ data ServerInfo = ServerInfo { {-| The name of the server as defined by the server. -} - _name :: Data.Text.Text + name :: Data.Text.Text , {-| The server's version as defined by the server. -} - _version :: (Maybe Data.Text.Text) + version :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SetTraceParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SetTraceParams.hs index a175bb9e..b8ac650d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SetTraceParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SetTraceParams.hs @@ -25,7 +25,7 @@ data SetTraceParams = SetTraceParams { {-| -} - _value :: Language.LSP.Protocol.Internal.Types.TraceValue.TraceValue + value :: Language.LSP.Protocol.Internal.Types.TraceValue.TraceValue } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentClientCapabilities.hs index 834726a2..ad8c7a1e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentClientCapabilities.hs @@ -27,7 +27,7 @@ data ShowDocumentClientCapabilities = ShowDocumentClientCapabilities The client has support for the showDocument request. -} - _support :: Bool + support :: Bool } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentParams.hs index 7e927c84..06b4d1b6 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentParams.hs @@ -28,27 +28,27 @@ data ShowDocumentParams = ShowDocumentParams { {-| The uri to show. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + 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) + 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) + 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) + selection :: (Maybe Language.LSP.Protocol.Internal.Types.Range.Range) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentResult.hs index 6956bee1..833dae3d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentResult.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowDocumentResult.hs @@ -26,7 +26,7 @@ data ShowDocumentResult = ShowDocumentResult { {-| A boolean indicating if the show was successful. -} - _success :: Bool + success :: Bool } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageParams.hs index 925480e2..47dff698 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageParams.hs @@ -26,11 +26,11 @@ data ShowMessageParams = ShowMessageParams { {-| The message type. See `MessageType` -} - _type_ :: Language.LSP.Protocol.Internal.Types.MessageType.MessageType + type_ :: Language.LSP.Protocol.Internal.Types.MessageType.MessageType , {-| The actual message. -} - _message :: Data.Text.Text + message :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestClientCapabilities.hs index 16588041..46ae0ba9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestClientCapabilities.hs @@ -25,7 +25,7 @@ data ShowMessageRequestClientCapabilities = ShowMessageRequestClientCapabilities { {-| Capabilities specific to the `MessageActionItem` type. -} - _messageActionItem :: (Maybe Language.LSP.Protocol.Internal.Types.ClientShowMessageActionItemOptions.ClientShowMessageActionItemOptions) + messageActionItem :: (Maybe Language.LSP.Protocol.Internal.Types.ClientShowMessageActionItemOptions.ClientShowMessageActionItemOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestParams.hs index 5ca64ab2..589fbd8e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/ShowMessageRequestParams.hs @@ -27,15 +27,15 @@ data ShowMessageRequestParams = ShowMessageRequestParams { {-| The message type. See `MessageType` -} - _type_ :: Language.LSP.Protocol.Internal.Types.MessageType.MessageType + type_ :: Language.LSP.Protocol.Internal.Types.MessageType.MessageType , {-| The actual message. -} - _message :: Data.Text.Text + message :: Data.Text.Text , {-| The message action items to present. -} - _actions :: (Maybe [Language.LSP.Protocol.Internal.Types.MessageActionItem.MessageActionItem]) + actions :: (Maybe [Language.LSP.Protocol.Internal.Types.MessageActionItem.MessageActionItem]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelp.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelp.hs index 7982e8d7..3375a021 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelp.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelp.hs @@ -27,7 +27,7 @@ data SignatureHelp = SignatureHelp { {-| One or more signatures. -} - _signatures :: [Language.LSP.Protocol.Internal.Types.SignatureInformation.SignatureInformation] + 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 @@ -39,7 +39,7 @@ data SignatureHelp = SignatureHelp In future version of the protocol this property might become mandatory to better express this. -} - _activeSignature :: (Maybe Language.LSP.Protocol.Types.Common.UInt) + activeSignature :: (Maybe Language.LSP.Protocol.Types.Common.UInt) , {-| The active parameter of the active signature. @@ -58,7 +58,7 @@ data SignatureHelp = SignatureHelp mandatory (but still nullable) to better express the active parameter if the active signature does have any. -} - _activeParameter :: (Maybe (Language.LSP.Protocol.Types.Common.UInt Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + activeParameter :: (Maybe (Language.LSP.Protocol.Types.Common.UInt Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpClientCapabilities.hs index a301f33f..093cbc44 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpClientCapabilities.hs @@ -25,12 +25,12 @@ data SignatureHelpClientCapabilities = SignatureHelpClientCapabilities { {-| Whether signature help supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| The client supports the following `SignatureInformation` specific properties. -} - _signatureInformation :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSignatureInformationOptions.ClientSignatureInformationOptions) + signatureInformation :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSignatureInformationOptions.ClientSignatureInformationOptions) , {-| The client supports to send additional context information for a `textDocument/signatureHelp` request. A client that opts into @@ -39,7 +39,7 @@ data SignatureHelpClientCapabilities = SignatureHelpClientCapabilities @since 3.15.0 -} - _contextSupport :: (Maybe Bool) + contextSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpContext.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpContext.hs index 543f742a..c13ab70b 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpContext.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpContext.hs @@ -29,27 +29,27 @@ data SignatureHelpContext = SignatureHelpContext { {-| Action that caused signature help to be triggered. -} - _triggerKind :: Language.LSP.Protocol.Internal.Types.SignatureHelpTriggerKind.SignatureHelpTriggerKind + 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) + 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 + 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) + activeSignatureHelp :: (Maybe Language.LSP.Protocol.Internal.Types.SignatureHelp.SignatureHelp) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpOptions.hs index 6ab24d94..ae1366b2 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpOptions.hs @@ -25,11 +25,11 @@ data SignatureHelpOptions = SignatureHelpOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| List of characters that trigger signature help automatically. -} - _triggerCharacters :: (Maybe [Data.Text.Text]) + triggerCharacters :: (Maybe [Data.Text.Text]) , {-| List of characters that re-trigger signature help. @@ -38,7 +38,7 @@ data SignatureHelpOptions = SignatureHelpOptions @since 3.15.0 -} - _retriggerCharacters :: (Maybe [Data.Text.Text]) + retriggerCharacters :: (Maybe [Data.Text.Text]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpParams.hs index 6417c6fe..0433f0db 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpParams.hs @@ -28,22 +28,22 @@ data SignatureHelpParams = SignatureHelpParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + 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) + context :: (Maybe Language.LSP.Protocol.Internal.Types.SignatureHelpContext.SignatureHelpContext) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpRegistrationOptions.hs index 4e3d279e..53f2b28c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureHelpRegistrationOptions.hs @@ -27,15 +27,15 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| List of characters that trigger signature help automatically. -} - _triggerCharacters :: (Maybe [Data.Text.Text]) + triggerCharacters :: (Maybe [Data.Text.Text]) , {-| List of characters that re-trigger signature help. @@ -44,7 +44,7 @@ data SignatureHelpRegistrationOptions = SignatureHelpRegistrationOptions @since 3.15.0 -} - _retriggerCharacters :: (Maybe [Data.Text.Text]) + retriggerCharacters :: (Maybe [Data.Text.Text]) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureInformation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureInformation.hs index 6fc7283f..5cf108f8 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureInformation.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SignatureInformation.hs @@ -30,16 +30,16 @@ data SignatureInformation = SignatureInformation The label of this signature. Will be shown in the UI. -} - _label :: Data.Text.Text + 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)) + 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]) + parameters :: (Maybe [Language.LSP.Protocol.Internal.Types.ParameterInformation.ParameterInformation]) , {-| The index of the active parameter. @@ -53,7 +53,7 @@ data SignatureInformation = SignatureInformation @since 3.16.0 -} - _activeParameter :: (Maybe (Language.LSP.Protocol.Types.Common.UInt Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + activeParameter :: (Maybe (Language.LSP.Protocol.Types.Common.UInt Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/StaleRequestSupportOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/StaleRequestSupportOptions.hs index fd1f9c45..cf0f3cf8 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/StaleRequestSupportOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/StaleRequestSupportOptions.hs @@ -26,13 +26,13 @@ data StaleRequestSupportOptions = StaleRequestSupportOptions { {-| The client will actively cancel the request. -} - _cancel :: Bool + cancel :: Bool , {-| The list of requests for which the client will retry the request if it receives a response with error code `ContentModified` -} - _retryOnContentModified :: [Data.Text.Text] + retryOnContentModified :: [Data.Text.Text] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/StaticRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/StaticRegistrationOptions.hs index 385b4df7..2d46cc78 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/StaticRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/StaticRegistrationOptions.hs @@ -27,7 +27,7 @@ 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolInformation.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolInformation.hs index cee77a4e..b547477f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolInformation.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/SymbolInformation.hs @@ -29,30 +29,30 @@ data SymbolInformation = SymbolInformation { {-| The name of this symbol. -} - _name :: Data.Text.Text + name :: Data.Text.Text , {-| The kind of this symbol. -} - _kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind + 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]) + 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) + containerName :: (Maybe Data.Text.Text) , {-| Indicates if this symbol is deprecated. @deprecated Use tags instead -} - _deprecated :: (Maybe Bool) + 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 @@ -64,7 +64,7 @@ data SymbolInformation = SymbolInformation syntax tree. It can therefore not be used to re-construct a hierarchy of the symbols. -} - _location :: Language.LSP.Protocol.Internal.Types.Location.Location + location :: Language.LSP.Protocol.Internal.Types.Location.Location } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentChangeRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentChangeRegistrationOptions.hs index 8d488fa7..186a7099 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentChangeRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentChangeRegistrationOptions.hs @@ -27,11 +27,11 @@ data TextDocumentChangeRegistrationOptions = TextDocumentChangeRegistrationOptio 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) + 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 + syncKind :: Language.LSP.Protocol.Internal.Types.TextDocumentSyncKind.TextDocumentSyncKind } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentClientCapabilities.hs index 0effbbf1..32bde2f7 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentClientCapabilities.hs @@ -54,152 +54,152 @@ data TextDocumentClientCapabilities = TextDocumentClientCapabilities { {-| Defines which synchronization capabilities the client supports. -} - _synchronization :: (Maybe Language.LSP.Protocol.Internal.Types.TextDocumentSyncClientCapabilities.TextDocumentSyncClientCapabilities) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + diagnostic :: (Maybe Language.LSP.Protocol.Internal.Types.DiagnosticClientCapabilities.DiagnosticClientCapabilities) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentContentChangePartial.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentContentChangePartial.hs index bed00931..e29d4bc1 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentContentChangePartial.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentContentChangePartial.hs @@ -27,17 +27,17 @@ data TextDocumentContentChangePartial = TextDocumentContentChangePartial { {-| The range of the document that changed. -} - _range :: Language.LSP.Protocol.Internal.Types.Range.Range + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| The optional length of the range that got replaced. @deprecated use range instead. -} - _rangeLength :: (Maybe Language.LSP.Protocol.Types.Common.UInt) + rangeLength :: (Maybe Language.LSP.Protocol.Types.Common.UInt) , {-| The new text for the provided range. -} - _text :: Data.Text.Text + text :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentContentChangeWholeDocument.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentContentChangeWholeDocument.hs index 12771dd3..38febc0a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentContentChangeWholeDocument.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentContentChangeWholeDocument.hs @@ -26,7 +26,7 @@ data TextDocumentContentChangeWholeDocument = TextDocumentContentChangeWholeDocu { {-| The new text of the whole document. -} - _text :: Data.Text.Text + text :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentEdit.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentEdit.hs index 998ffeaa..e06fad78 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentEdit.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentEdit.hs @@ -30,14 +30,14 @@ data TextDocumentEdit = TextDocumentEdit { {-| The text document to change. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.OptionalVersionedTextDocumentIdentifier.OptionalVersionedTextDocumentIdentifier + 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)] + 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) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilterLanguage.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilterLanguage.hs index 950759e3..5a81d134 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilterLanguage.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilterLanguage.hs @@ -28,15 +28,15 @@ data TextDocumentFilterLanguage = TextDocumentFilterLanguage { {-| A language id, like `typescript`. -} - _language :: Data.Text.Text + language :: Data.Text.Text , {-| A Uri `Uri.scheme`, like `file` or `untitled`. -} - _scheme :: (Maybe Data.Text.Text) + scheme :: (Maybe Data.Text.Text) , {-| A glob pattern, like **​/*.{ts,js}. See TextDocumentFilter for examples. -} - _pattern :: (Maybe Data.Text.Text) + pattern :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilterPattern.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilterPattern.hs index feb684bb..bcc851bb 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilterPattern.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilterPattern.hs @@ -28,15 +28,15 @@ data TextDocumentFilterPattern = TextDocumentFilterPattern { {-| A language id, like `typescript`. -} - _language :: (Maybe Data.Text.Text) + language :: (Maybe Data.Text.Text) , {-| A Uri `Uri.scheme`, like `file` or `untitled`. -} - _scheme :: (Maybe Data.Text.Text) + scheme :: (Maybe Data.Text.Text) , {-| A glob pattern, like **​/*.{ts,js}. See TextDocumentFilter for examples. -} - _pattern :: Data.Text.Text + pattern :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilterScheme.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilterScheme.hs index 0bcea9c4..dda5f295 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilterScheme.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentFilterScheme.hs @@ -28,15 +28,15 @@ data TextDocumentFilterScheme = TextDocumentFilterScheme { {-| A language id, like `typescript`. -} - _language :: (Maybe Data.Text.Text) + language :: (Maybe Data.Text.Text) , {-| A Uri `Uri.scheme`, like `file` or `untitled`. -} - _scheme :: Data.Text.Text + scheme :: Data.Text.Text , {-| A glob pattern, like **​/*.{ts,js}. See TextDocumentFilter for examples. -} - _pattern :: (Maybe Data.Text.Text) + pattern :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentIdentifier.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentIdentifier.hs index 8f2ebeae..326ea7c0 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentIdentifier.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentIdentifier.hs @@ -25,7 +25,7 @@ data TextDocumentIdentifier = TextDocumentIdentifier { {-| The text document's uri. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + uri :: Language.LSP.Protocol.Types.Uri.Uri } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentItem.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentItem.hs index ca367fa6..5e552d5f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentItem.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentItem.hs @@ -28,20 +28,20 @@ data TextDocumentItem = TextDocumentItem { {-| The text document's uri. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + uri :: Language.LSP.Protocol.Types.Uri.Uri , {-| The text document's language identifier. -} - _languageId :: Language.LSP.Protocol.Internal.Types.LanguageKind.LanguageKind + languageId :: Language.LSP.Protocol.Internal.Types.LanguageKind.LanguageKind , {-| The version number of this document (it will increase after each change, including undo/redo). -} - _version :: Language.LSP.Protocol.Types.Common.Int32 + version :: Language.LSP.Protocol.Types.Common.Int32 , {-| The content of the opened text document. -} - _text :: Data.Text.Text + text :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentPositionParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentPositionParams.hs index 821b9d34..41b6ed9a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentPositionParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentPositionParams.hs @@ -27,11 +27,11 @@ data TextDocumentPositionParams = TextDocumentPositionParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + position :: Language.LSP.Protocol.Internal.Types.Position.Position } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentRegistrationOptions.hs index 0e0e3232..ad0d4f4f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentRegistrationOptions.hs @@ -26,7 +26,7 @@ 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) + 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) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSaveRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSaveRegistrationOptions.hs index 08e54729..f0171c6d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSaveRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSaveRegistrationOptions.hs @@ -26,11 +26,11 @@ 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) + 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) + includeText :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncClientCapabilities.hs index f982b2ea..a1226b93 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncClientCapabilities.hs @@ -24,21 +24,21 @@ data TextDocumentSyncClientCapabilities = TextDocumentSyncClientCapabilities { {-| Whether text document synchronization supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| The client supports sending will save notifications. -} - _willSave :: (Maybe Bool) + 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) + willSaveWaitUntil :: (Maybe Bool) , {-| The client supports did save notifications. -} - _didSave :: (Maybe Bool) + didSave :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncOptions.hs index 450c3f09..d7d996c5 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextDocumentSyncOptions.hs @@ -27,27 +27,27 @@ data TextDocumentSyncOptions = TextDocumentSyncOptions Open and close notifications are sent to the server. If omitted open close notification should not be sent. -} - _openClose :: (Maybe Bool) + 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) + 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) + 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) + 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)) + save :: (Maybe (Bool Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.SaveOptions.SaveOptions)) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextEdit.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextEdit.hs index ee3e7d55..e5c44c0c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextEdit.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TextEdit.hs @@ -27,12 +27,12 @@ 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 + range :: Language.LSP.Protocol.Internal.Types.Range.Range , {-| The string to be inserted. For delete operations use an empty string. -} - _newText :: Data.Text.Text + newText :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionClientCapabilities.hs index 4af79a02..0934ba5c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionClientCapabilities.hs @@ -26,13 +26,13 @@ data TypeDefinitionClientCapabilities = TypeDefinitionClientCapabilities the client supports the new `TypeDefinitionRegistrationOptions` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| The client supports additional metadata in the form of definition links. Since 3.14.0 -} - _linkSupport :: (Maybe Bool) + linkSupport :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionOptions.hs index fe06dcdd..e013a808 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionOptions.hs @@ -24,7 +24,7 @@ data TypeDefinitionOptions = TypeDefinitionOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionParams.hs index 667cc8c5..52cf62c2 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionParams.hs @@ -27,20 +27,20 @@ data TypeDefinitionParams = TypeDefinitionParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionRegistrationOptions.hs index 7c4d1153..6408f364 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeDefinitionRegistrationOptions.hs @@ -27,16 +27,16 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyClientCapabilities.hs index 7c62a157..135184a1 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyClientCapabilities.hs @@ -26,7 +26,7 @@ data TypeHierarchyClientCapabilities = TypeHierarchyClientCapabilities the client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)` return value for the corresponding server capability as well. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyItem.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyItem.hs index f007f693..5c9b286a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyItem.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyItem.hs @@ -30,41 +30,41 @@ data TypeHierarchyItem = TypeHierarchyItem { {-| The name of this item. -} - _name :: Data.Text.Text + name :: Data.Text.Text , {-| The kind of this item. -} - _kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind + kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind , {-| Tags for this item. -} - _tags :: (Maybe [Language.LSP.Protocol.Internal.Types.SymbolTag.SymbolTag]) + 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) + detail :: (Maybe Data.Text.Text) , {-| The resource identifier of this item. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + 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 + 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 + 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) + data_ :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyOptions.hs index 312a481b..288fbba0 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyOptions.hs @@ -26,7 +26,7 @@ data TypeHierarchyOptions = TypeHierarchyOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyPrepareParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyPrepareParams.hs index a67c1d77..b8af5e3a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyPrepareParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyPrepareParams.hs @@ -29,15 +29,15 @@ data TypeHierarchyPrepareParams = TypeHierarchyPrepareParams { {-| The text document. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The position inside the text document. -} - _position :: Language.LSP.Protocol.Internal.Types.Position.Position + 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyRegistrationOptions.hs index a689a465..ecbe051d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchyRegistrationOptions.hs @@ -29,16 +29,16 @@ 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) + documentSelector :: (Language.LSP.Protocol.Internal.Types.DocumentSelector.DocumentSelector Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) , {-| -} - _workDoneProgress :: (Maybe Bool) + 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) + id :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySubtypesParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySubtypesParams.hs index 7d2136f0..2600fe55 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySubtypesParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySubtypesParams.hs @@ -28,16 +28,16 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| -} - _item :: Language.LSP.Protocol.Internal.Types.TypeHierarchyItem.TypeHierarchyItem + item :: Language.LSP.Protocol.Internal.Types.TypeHierarchyItem.TypeHierarchyItem } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySupertypesParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySupertypesParams.hs index 1b01261a..dc5f02ef 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySupertypesParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/TypeHierarchySupertypesParams.hs @@ -28,16 +28,16 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| -} - _item :: Language.LSP.Protocol.Internal.Types.TypeHierarchyItem.TypeHierarchyItem + item :: Language.LSP.Protocol.Internal.Types.TypeHierarchyItem.TypeHierarchyItem } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UInitializeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UInitializeParams.hs index 3f80e55f..14735a19 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UInitializeParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UInitializeParams.hs @@ -31,7 +31,7 @@ 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The process Id of the parent process that started the server. @@ -39,13 +39,13 @@ data UInitializeParams = UInitializeParams 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) + 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 Language.LSP.Protocol.Internal.Types.ClientInfo.ClientInfo) + clientInfo :: (Maybe Language.LSP.Protocol.Internal.Types.ClientInfo.ClientInfo) , {-| The locale the client is currently showing the user interface in. This must not necessarily be the locale of the operating @@ -56,14 +56,14 @@ data UInitializeParams = UInitializeParams @since 3.16.0 -} - _locale :: (Maybe Data.Text.Text) + 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)) + 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 @@ -71,19 +71,19 @@ data UInitializeParams = UInitializeParams @deprecated in favour of workspaceFolders. -} - _rootUri :: (Language.LSP.Protocol.Types.Uri.Uri Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) + 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 + capabilities :: Language.LSP.Protocol.Internal.Types.ClientCapabilities.ClientCapabilities , {-| User provided initialization options. -} - _initializationOptions :: (Maybe Data.Aeson.Value) + initializationOptions :: (Maybe Data.Aeson.Value) , {-| The initial trace setting. If omitted trace is disabled ('off'). -} - _trace :: (Maybe Language.LSP.Protocol.Internal.Types.TraceValue.TraceValue) + trace :: (Maybe Language.LSP.Protocol.Internal.Types.TraceValue.TraceValue) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnchangedDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnchangedDocumentDiagnosticReport.hs index d64ca9f1..f3053fa1 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnchangedDocumentDiagnosticReport.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnchangedDocumentDiagnosticReport.hs @@ -32,12 +32,12 @@ data UnchangedDocumentDiagnosticReport = UnchangedDocumentDiagnosticReport only return `unchanged` if result ids are provided. -} - _kind :: (Language.LSP.Protocol.Types.Singletons.AString "unchanged") + 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 + resultId :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Unregistration.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Unregistration.hs index 63ce75b3..0de84b94 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Unregistration.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/Unregistration.hs @@ -26,11 +26,11 @@ data Unregistration = Unregistration The id used to unregister the request or notification. Usually an id provided during the register request. -} - _id :: Data.Text.Text + id :: Data.Text.Text , {-| The method to unregister for. -} - _method :: Data.Text.Text + method :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnregistrationParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnregistrationParams.hs index 9c86f445..378c5695 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnregistrationParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/UnregistrationParams.hs @@ -25,7 +25,7 @@ data UnregistrationParams = UnregistrationParams { {-| -} - _unregisterations :: [Language.LSP.Protocol.Internal.Types.Unregistration.Unregistration] + unregisterations :: [Language.LSP.Protocol.Internal.Types.Unregistration.Unregistration] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedNotebookDocumentIdentifier.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedNotebookDocumentIdentifier.hs index 23034681..1302d09c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedNotebookDocumentIdentifier.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedNotebookDocumentIdentifier.hs @@ -27,11 +27,11 @@ data VersionedNotebookDocumentIdentifier = VersionedNotebookDocumentIdentifier { {-| The version number of this notebook document. -} - _version :: Language.LSP.Protocol.Types.Common.Int32 + version :: Language.LSP.Protocol.Types.Common.Int32 , {-| The notebook document's uri. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + uri :: Language.LSP.Protocol.Types.Uri.Uri } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedTextDocumentIdentifier.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedTextDocumentIdentifier.hs index e7b6e475..ad600716 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedTextDocumentIdentifier.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/VersionedTextDocumentIdentifier.hs @@ -25,11 +25,11 @@ data VersionedTextDocumentIdentifier = VersionedTextDocumentIdentifier { {-| The text document's uri. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + uri :: Language.LSP.Protocol.Types.Uri.Uri , {-| The version number of this document. -} - _version :: Language.LSP.Protocol.Types.Common.Int32 + version :: Language.LSP.Protocol.Types.Common.Int32 } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WillSaveTextDocumentParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WillSaveTextDocumentParams.hs index 23b6e113..43adfdfa 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WillSaveTextDocumentParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WillSaveTextDocumentParams.hs @@ -26,11 +26,11 @@ data WillSaveTextDocumentParams = WillSaveTextDocumentParams { {-| The document that will be saved. -} - _textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier + textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier , {-| The 'TextDocumentSaveReason'. -} - _reason :: Language.LSP.Protocol.Internal.Types.TextDocumentSaveReason.TextDocumentSaveReason + reason :: Language.LSP.Protocol.Internal.Types.TextDocumentSaveReason.TextDocumentSaveReason } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WindowClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WindowClientCapabilities.hs index 80ce8987..a93b661f 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WindowClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WindowClientCapabilities.hs @@ -34,19 +34,19 @@ data WindowClientCapabilities = WindowClientCapabilities @since 3.15.0 -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| Capabilities specific to the showMessage request. @since 3.16.0 -} - _showMessage :: (Maybe Language.LSP.Protocol.Internal.Types.ShowMessageRequestClientCapabilities.ShowMessageRequestClientCapabilities) + 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) + showDocument :: (Maybe Language.LSP.Protocol.Internal.Types.ShowDocumentClientCapabilities.ShowDocumentClientCapabilities) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressBegin.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressBegin.hs index f20e9362..def0df87 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressBegin.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressBegin.hs @@ -26,20 +26,20 @@ data WorkDoneProgressBegin = WorkDoneProgressBegin { {-| -} - _kind :: (Language.LSP.Protocol.Types.Singletons.AString "begin") + 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 + 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) + cancellable :: (Maybe Bool) , {-| Optional, more detailed associated progress message. Contains complementary information to the `title`. @@ -47,7 +47,7 @@ data WorkDoneProgressBegin = WorkDoneProgressBegin 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) + 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 @@ -56,7 +56,7 @@ data WorkDoneProgressBegin = WorkDoneProgressBegin 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) + percentage :: (Maybe Language.LSP.Protocol.Types.Common.UInt) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCancelParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCancelParams.hs index 032bf7cb..4abc1d08 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCancelParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCancelParams.hs @@ -25,7 +25,7 @@ data WorkDoneProgressCancelParams = WorkDoneProgressCancelParams { {-| The token to be used to report progress. -} - _token :: Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken + token :: Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCreateParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCreateParams.hs index 0df2be5a..0774ed2a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCreateParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressCreateParams.hs @@ -25,7 +25,7 @@ data WorkDoneProgressCreateParams = WorkDoneProgressCreateParams { {-| The token to be used to report progress. -} - _token :: Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken + token :: Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressEnd.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressEnd.hs index 4a0e8048..9a35eba3 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressEnd.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressEnd.hs @@ -26,12 +26,12 @@ data WorkDoneProgressEnd = WorkDoneProgressEnd { {-| -} - _kind :: (Language.LSP.Protocol.Types.Singletons.AString "end") + 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) + message :: (Maybe Data.Text.Text) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressOptions.hs index 4f07dac0..d880f85c 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressOptions.hs @@ -24,7 +24,7 @@ data WorkDoneProgressOptions = WorkDoneProgressOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressParams.hs index e940cb74..03698fea 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressParams.hs @@ -25,7 +25,7 @@ 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) + workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressReport.hs index fae32854..d827bb8e 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressReport.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkDoneProgressReport.hs @@ -26,14 +26,14 @@ data WorkDoneProgressReport = WorkDoneProgressReport { {-| -} - _kind :: (Language.LSP.Protocol.Types.Singletons.AString "report") + 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) + cancellable :: (Maybe Bool) , {-| Optional, more detailed associated progress message. Contains complementary information to the `title`. @@ -41,7 +41,7 @@ data WorkDoneProgressReport = WorkDoneProgressReport 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) + 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 @@ -50,7 +50,7 @@ data WorkDoneProgressReport = WorkDoneProgressReport 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) + percentage :: (Maybe Language.LSP.Protocol.Types.Common.UInt) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceClientCapabilities.hs index 9cb0732f..33afa87a 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceClientCapabilities.hs @@ -37,80 +37,80 @@ data WorkspaceClientCapabilities = WorkspaceClientCapabilities to the workspace by supporting the request 'workspace/applyEdit' -} - _applyEdit :: (Maybe Bool) + applyEdit :: (Maybe Bool) , {-| Capabilities specific to `WorkspaceEdit`s. -} - _workspaceEdit :: (Maybe Language.LSP.Protocol.Internal.Types.WorkspaceEditClientCapabilities.WorkspaceEditClientCapabilities) + 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) + 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) + 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) + 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) + executeCommand :: (Maybe Language.LSP.Protocol.Internal.Types.ExecuteCommandClientCapabilities.ExecuteCommandClientCapabilities) , {-| The client has support for workspace folders. @since 3.6.0 -} - _workspaceFolders :: (Maybe Bool) + workspaceFolders :: (Maybe Bool) , {-| The client supports `workspace/configuration` requests. @since 3.6.0 -} - _configuration :: (Maybe Bool) + 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) + 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) + 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) + 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) + 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) + 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) + diagnostics :: (Maybe Language.LSP.Protocol.Internal.Types.DiagnosticWorkspaceClientCapabilities.DiagnosticWorkspaceClientCapabilities) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticParams.hs index 1ff442bf..d81977ad 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticParams.hs @@ -29,21 +29,21 @@ 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) + 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) + partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken) , {-| The additional identifier provided during registration. -} - _identifier :: (Maybe Data.Text.Text) + identifier :: (Maybe Data.Text.Text) , {-| The currently known diagnostic reports with their previous result ids. -} - _previousResultIds :: [Language.LSP.Protocol.Internal.Types.PreviousResultId.PreviousResultId] + previousResultIds :: [Language.LSP.Protocol.Internal.Types.PreviousResultId.PreviousResultId] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReport.hs index cfa9b4c9..69b07bca 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReport.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReport.hs @@ -27,7 +27,7 @@ data WorkspaceDiagnosticReport = WorkspaceDiagnosticReport { {-| -} - _items :: [Language.LSP.Protocol.Internal.Types.WorkspaceDocumentDiagnosticReport.WorkspaceDocumentDiagnosticReport] + items :: [Language.LSP.Protocol.Internal.Types.WorkspaceDocumentDiagnosticReport.WorkspaceDocumentDiagnosticReport] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReportPartialResult.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReportPartialResult.hs index 9e2f88cd..bc8cd5cf 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReportPartialResult.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceDiagnosticReportPartialResult.hs @@ -27,7 +27,7 @@ data WorkspaceDiagnosticReportPartialResult = WorkspaceDiagnosticReportPartialRe { {-| -} - _items :: [Language.LSP.Protocol.Internal.Types.WorkspaceDocumentDiagnosticReport.WorkspaceDocumentDiagnosticReport] + items :: [Language.LSP.Protocol.Internal.Types.WorkspaceDocumentDiagnosticReport.WorkspaceDocumentDiagnosticReport] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEdit.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEdit.hs index 1ce55953..4fe13b91 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEdit.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEdit.hs @@ -44,7 +44,7 @@ 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])) + 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 @@ -57,7 +57,7 @@ data WorkspaceEdit = WorkspaceEdit 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)))]) + 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. @@ -66,7 +66,7 @@ data WorkspaceEdit = WorkspaceEdit @since 3.16.0 -} - _changeAnnotations :: (Maybe (Data.Map.Map Language.LSP.Protocol.Internal.Types.ChangeAnnotationIdentifier.ChangeAnnotationIdentifier Language.LSP.Protocol.Internal.Types.ChangeAnnotation.ChangeAnnotation)) + 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) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEditClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEditClientCapabilities.hs index 26b0f088..369ec6e9 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEditClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceEditClientCapabilities.hs @@ -27,21 +27,21 @@ data WorkspaceEditClientCapabilities = WorkspaceEditClientCapabilities { {-| The client supports versioned document changes in `WorkspaceEdit`s -} - _documentChanges :: (Maybe Bool) + 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]) + 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) + failureHandling :: (Maybe Language.LSP.Protocol.Internal.Types.FailureHandlingKind.FailureHandlingKind) , {-| Whether the client normalizes line endings to the client specific setting. @@ -51,14 +51,14 @@ data WorkspaceEditClientCapabilities = WorkspaceEditClientCapabilities @since 3.16.0 -} - _normalizesLineEndings :: (Maybe Bool) + 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 Language.LSP.Protocol.Internal.Types.ChangeAnnotationsSupportOptions.ChangeAnnotationsSupportOptions) + changeAnnotationSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ChangeAnnotationsSupportOptions.ChangeAnnotationsSupportOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFolder.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFolder.hs index 8dad56ec..b5c79bec 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFolder.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFolder.hs @@ -26,12 +26,12 @@ data WorkspaceFolder = WorkspaceFolder { {-| The associated URI for this workspace folder. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + 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 + name :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersChangeEvent.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersChangeEvent.hs index dfb24611..d1878d57 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersChangeEvent.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersChangeEvent.hs @@ -25,11 +25,11 @@ data WorkspaceFoldersChangeEvent = WorkspaceFoldersChangeEvent { {-| The array of added workspace folders -} - _added :: [Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder] + added :: [Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder] , {-| The array of the removed workspace folders -} - _removed :: [Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder] + removed :: [Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder] } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersInitializeParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersInitializeParams.hs index 3a88a8b7..9c433fd8 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersInitializeParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersInitializeParams.hs @@ -31,7 +31,7 @@ data WorkspaceFoldersInitializeParams = WorkspaceFoldersInitializeParams @since 3.6.0 -} - _workspaceFolders :: (Maybe ([Language.LSP.Protocol.Internal.Types.WorkspaceFolder.WorkspaceFolder] Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null)) + 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) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersServerCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersServerCapabilities.hs index 20272e8a..36ee2de4 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersServerCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFoldersServerCapabilities.hs @@ -25,7 +25,7 @@ data WorkspaceFoldersServerCapabilities = WorkspaceFoldersServerCapabilities { {-| The server has support for workspace folders -} - _supported :: (Maybe Bool) + supported :: (Maybe Bool) , {-| Whether the server wants to receive workspace folder change notifications. @@ -35,7 +35,7 @@ data WorkspaceFoldersServerCapabilities = WorkspaceFoldersServerCapabilities 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)) + changeNotifications :: (Maybe (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Bool)) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFullDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFullDocumentDiagnosticReport.hs index 206b1547..664f6dbf 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFullDocumentDiagnosticReport.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceFullDocumentDiagnosticReport.hs @@ -30,26 +30,26 @@ data WorkspaceFullDocumentDiagnosticReport = WorkspaceFullDocumentDiagnosticRepo { {-| A full document diagnostic report. -} - _kind :: (Language.LSP.Protocol.Types.Singletons.AString "full") + 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) + resultId :: (Maybe Data.Text.Text) , {-| The actual items. -} - _items :: [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic] + items :: [Language.LSP.Protocol.Internal.Types.Diagnostic.Diagnostic] , {-| The URI for which diagnostic information is reported. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + 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) + version :: (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceOptions.hs index f98f777d..f9953b4d 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceOptions.hs @@ -31,13 +31,13 @@ data WorkspaceOptions = WorkspaceOptions @since 3.6.0 -} - _workspaceFolders :: (Maybe Language.LSP.Protocol.Internal.Types.WorkspaceFoldersServerCapabilities.WorkspaceFoldersServerCapabilities) + workspaceFolders :: (Maybe Language.LSP.Protocol.Internal.Types.WorkspaceFoldersServerCapabilities.WorkspaceFoldersServerCapabilities) , {-| The server is interested in notifications/requests for operations on files. @since 3.16.0 -} - _fileOperations :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationOptions.FileOperationOptions) + fileOperations :: (Maybe Language.LSP.Protocol.Internal.Types.FileOperationOptions.FileOperationOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbol.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbol.hs index 044b1d71..52862770 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbol.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbol.hs @@ -34,24 +34,24 @@ data WorkspaceSymbol = WorkspaceSymbol { {-| The name of this symbol. -} - _name :: Data.Text.Text + name :: Data.Text.Text , {-| The kind of this symbol. -} - _kind :: Language.LSP.Protocol.Internal.Types.SymbolKind.SymbolKind + 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]) + 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) + 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 @@ -59,12 +59,12 @@ data WorkspaceSymbol = WorkspaceSymbol See SymbolInformation#location for more details. -} - _location :: (Language.LSP.Protocol.Internal.Types.Location.Location Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.LocationUriOnly.LocationUriOnly) + location :: (Language.LSP.Protocol.Internal.Types.Location.Location Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.LocationUriOnly.LocationUriOnly) , {-| 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) + data_ :: (Maybe Data.Aeson.Value) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolClientCapabilities.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolClientCapabilities.hs index b83f222e..70418cf8 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolClientCapabilities.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolClientCapabilities.hs @@ -27,18 +27,18 @@ data WorkspaceSymbolClientCapabilities = WorkspaceSymbolClientCapabilities { {-| Symbol request supports dynamic registration. -} - _dynamicRegistration :: (Maybe Bool) + dynamicRegistration :: (Maybe Bool) , {-| Specific capabilities for the `SymbolKind` in the `workspace/symbol` request. -} - _symbolKind :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSymbolKindOptions.ClientSymbolKindOptions) + symbolKind :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSymbolKindOptions.ClientSymbolKindOptions) , {-| The client supports tags on `SymbolInformation`. Clients supporting tags have to handle unknown tags gracefully. @since 3.16.0 -} - _tagSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSymbolTagOptions.ClientSymbolTagOptions) + tagSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSymbolTagOptions.ClientSymbolTagOptions) , {-| The client support partial workspace symbols. The client will send the request `workspaceSymbol/resolve` to the server to resolve additional @@ -46,7 +46,7 @@ data WorkspaceSymbolClientCapabilities = WorkspaceSymbolClientCapabilities @since 3.17.0 -} - _resolveSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSymbolResolveOptions.ClientSymbolResolveOptions) + resolveSupport :: (Maybe Language.LSP.Protocol.Internal.Types.ClientSymbolResolveOptions.ClientSymbolResolveOptions) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolOptions.hs index b28b88a7..69c1a69b 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolOptions.hs @@ -24,14 +24,14 @@ data WorkspaceSymbolOptions = WorkspaceSymbolOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| The server provides support to resolve additional information for a workspace symbol. @since 3.17.0 -} - _resolveProvider :: (Maybe Bool) + resolveProvider :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolParams.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolParams.hs index d68efcf2..b3f89916 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolParams.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolParams.hs @@ -26,17 +26,17 @@ 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) + 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) + 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 + query :: Data.Text.Text } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolRegistrationOptions.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolRegistrationOptions.hs index 9044e58c..88528f62 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolRegistrationOptions.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceSymbolRegistrationOptions.hs @@ -24,14 +24,14 @@ data WorkspaceSymbolRegistrationOptions = WorkspaceSymbolRegistrationOptions { {-| -} - _workDoneProgress :: (Maybe Bool) + workDoneProgress :: (Maybe Bool) , {-| The server provides support to resolve additional information for a workspace symbol. @since 3.17.0 -} - _resolveProvider :: (Maybe Bool) + resolveProvider :: (Maybe Bool) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceUnchangedDocumentDiagnosticReport.hs b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceUnchangedDocumentDiagnosticReport.hs index 3648a4b4..37b08c50 100644 --- a/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceUnchangedDocumentDiagnosticReport.hs +++ b/lsp-types/generated/Language/LSP/Protocol/Internal/Types/WorkspaceUnchangedDocumentDiagnosticReport.hs @@ -32,21 +32,21 @@ data WorkspaceUnchangedDocumentDiagnosticReport = WorkspaceUnchangedDocumentDiag only return `unchanged` if result ids are provided. -} - _kind :: (Language.LSP.Protocol.Types.Singletons.AString "unchanged") + 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 + resultId :: Data.Text.Text , {-| The URI for which diagnostic information is reported. -} - _uri :: Language.LSP.Protocol.Types.Uri.Uri + 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) + version :: (Language.LSP.Protocol.Types.Common.Int32 Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Types.Common.Null) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable) diff --git a/lsp-types/generator/CodeGen.hs b/lsp-types/generator/CodeGen.hs index c59433ba..562ef1d8 100644 --- a/lsp-types/generator/CodeGen.hs +++ b/lsp-types/generator/CodeGen.hs @@ -218,7 +218,7 @@ makeConstrName context n = -- | Make a name for a field. makeFieldName :: T.Text -> T.Text -makeFieldName n = "_" <> sanitizeName n +makeFieldName n = sanitizeName n buildTables :: MetaModel -> (SymbolTable, StructTable, MetaTable) buildTables (MetaModel{structures, enumerations, typeAliases}) = diff --git a/lsp-types/lens/Language/LSP/Protocol/Lens.hs b/lsp-types/lens/Language/LSP/Protocol/Lens.hs new file mode 100644 index 00000000..ce626829 --- /dev/null +++ b/lsp-types/lens/Language/LSP/Protocol/Lens.hs @@ -0,0 +1,39 @@ +-- | Lenses for the LSP types that can't easily be derived with @generic-lens@ or similar. +module Language.LSP.Protocol.Lens ( + versionedTextDocumentIdentifier, + workDoneProgressBegin, + workDoneProgressEnd, + workDoneProgressReport, +) +where + +import Control.Lens +import Data.Aeson + +import Language.LSP.Protocol.Types + +-- 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 + +-- | 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/lsp-types.cabal b/lsp-types/lsp-types.cabal index ae90700a..083252ea 100644 --- a/lsp-types/lsp-types.cabal +++ b/lsp-types/lsp-types.cabal @@ -71,8 +71,6 @@ library , hashable ^>=1.4 , indexed-traversable ^>=0.1 , indexed-traversable-instances ^>=0.1 - , lens >=5.1 && <5.3 - , lens-aeson ^>=1.2 , mod ^>=0.2 , mtl >=2.2 && <2.4 , network-uri ^>=2.6 @@ -101,7 +99,6 @@ library Data.Row.Aeson Data.Row.Hashable Language.LSP.Protocol.Capabilities - Language.LSP.Protocol.Lens Language.LSP.Protocol.Message Language.LSP.Protocol.Types Language.LSP.Protocol.Meta @@ -109,7 +106,6 @@ library Language.LSP.Protocol.Utils.SMethodMap other-modules: - Language.LSP.Protocol.Message.Lens Language.LSP.Protocol.Message.LspId Language.LSP.Protocol.Message.Meta Language.LSP.Protocol.Message.Method @@ -119,12 +115,10 @@ library Language.LSP.Protocol.Types.CodeAction Language.LSP.Protocol.Types.Common Language.LSP.Protocol.Types.Edit - Language.LSP.Protocol.Types.Lens Language.LSP.Protocol.Types.Location Language.LSP.Protocol.Types.LspEnum Language.LSP.Protocol.Types.MarkupContent Language.LSP.Protocol.Types.Orphans - Language.LSP.Protocol.Types.Progress Language.LSP.Protocol.Types.SemanticTokens Language.LSP.Protocol.Types.Singletons Language.LSP.Protocol.Types.Uri @@ -610,6 +604,21 @@ library lsp-types-quickcheck , template-haskell , text >=1 && <2.2 +library lsp-types-lens + visibility: public + hs-source-dirs: lens + default-language: GHC2021 + + exposed-modules: + Language.LSP.Protocol.Lens + + build-depends: + , aeson >=2 + , base >=4.11 && <5 + , lsp-types + , lens >=5.1 && <5.3 + , text >=1 && <2.2 + executable generator hs-source-dirs: generator default-language: GHC2021 diff --git a/lsp-types/src/Language/LSP/Protocol/Capabilities.hs b/lsp-types/src/Language/LSP/Protocol/Capabilities.hs index a04a8814..2c98fa39 100644 --- a/lsp-types/src/Language/LSP/Protocol/Capabilities.hs +++ b/lsp-types/src/Language/LSP/Protocol/Capabilities.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module Language.LSP.Protocol.Capabilities ( @@ -8,10 +9,8 @@ module Language.LSP.Protocol.Capabilities ( dynamicRegistrationSupported, ) where -import Control.Lens import Data.Maybe import Data.Set qualified as Set -import Language.LSP.Protocol.Lens qualified as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import Prelude hiding (min) @@ -34,37 +33,37 @@ capsForVersion (LSPVersion maj min) = caps where caps = ClientCapabilities - { _workspace = Just w - , _textDocument = Just td - , _window = Just window - , _general = since 3 16 general - , _notebookDocument = since 3 17 $ NotebookDocumentClientCapabilities $ NotebookDocumentSyncClientCapabilities dynamicReg (Just True) - , _experimental = Nothing + { workspace = Just w + , textDocument = Just td + , window = Just window + , general = since 3 16 general + , notebookDocument = since 3 17 $ NotebookDocumentClientCapabilities $ NotebookDocumentSyncClientCapabilities dynamicReg (Just True) + , experimental = Nothing } w = WorkspaceClientCapabilities - { _applyEdit = Just True - , _workspaceEdit = + { applyEdit = Just True + , workspaceEdit = Just ( WorkspaceEditClientCapabilities (Just True) (since 3 13 resourceOperations) Nothing (since 3 16 True) - (since 3 16 (ChangeAnnotationsSupportOptions{_groupsOnLabel = Just True})) + (since 3 16 (ChangeAnnotationsSupportOptions{groupsOnLabel = Just True})) ) - , _didChangeConfiguration = Just (DidChangeConfigurationClientCapabilities dynamicReg) - , _didChangeWatchedFiles = Just (DidChangeWatchedFilesClientCapabilities dynamicReg (Just True)) - , _symbol = Just symbolCapabilities - , _executeCommand = Just (ExecuteCommandClientCapabilities dynamicReg) - , _codeLens = Just (CodeLensWorkspaceClientCapabilities $ Just True) - , _workspaceFolders = since 3 6 True - , _configuration = since 3 6 True - , _semanticTokens = since 3 16 (SemanticTokensWorkspaceClientCapabilities $ Just True) - , _inlayHint = since 3 17 (InlayHintWorkspaceClientCapabilities $ Just True) - , _fileOperations = since 3 16 fileOperations - , _inlineValue = since 3 17 (InlineValueWorkspaceClientCapabilities $ Just True) - , _diagnostics = since 3 17 (DiagnosticWorkspaceClientCapabilities $ Just True) + , didChangeConfiguration = Just (DidChangeConfigurationClientCapabilities dynamicReg) + , didChangeWatchedFiles = Just (DidChangeWatchedFilesClientCapabilities dynamicReg (Just True)) + , symbol = Just symbolCapabilities + , executeCommand = Just (ExecuteCommandClientCapabilities dynamicReg) + , codeLens = Just (CodeLensWorkspaceClientCapabilities $ Just True) + , workspaceFolders = since 3 6 True + , configuration = since 3 6 True + , semanticTokens = since 3 16 (SemanticTokensWorkspaceClientCapabilities $ Just True) + , inlayHint = since 3 17 (InlayHintWorkspaceClientCapabilities $ Just True) + , fileOperations = since 3 16 fileOperations + , inlineValue = since 3 17 (InlineValueWorkspaceClientCapabilities $ Just True) + , diagnostics = since 3 17 (DiagnosticWorkspaceClientCapabilities $ Just True) } resourceOperations = @@ -86,9 +85,9 @@ capsForVersion (LSPVersion maj min) = caps symbolCapabilities = WorkspaceSymbolClientCapabilities dynamicReg - (since 3 4 (ClientSymbolKindOptions{_valueSet = Just sKs})) - (since 3 16 (ClientSymbolTagOptions{_valueSet = [SymbolTag_Deprecated]})) - (since 3 17 (ClientSymbolResolveOptions{_properties = []})) + (since 3 4 (ClientSymbolKindOptions{valueSet = Just sKs})) + (since 3 16 (ClientSymbolTagOptions{valueSet = [SymbolTag_Deprecated]})) + (since 3 17 (ClientSymbolResolveOptions{properties = []})) sKs | maj >= 3 && min >= 4 = oldSKs ++ newSKs @@ -131,87 +130,87 @@ capsForVersion (LSPVersion maj min) = caps semanticTokensCapabilities = SemanticTokensClientCapabilities - { _dynamicRegistration = Just True - , _requests = ClientSemanticTokensRequestOptions{_range = Just (InL True), _full = Just (InR (ClientSemanticTokensRequestFullDelta{_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 + { dynamicRegistration = Just True + , requests = ClientSemanticTokensRequestOptions{range = Just (InL True), full = Just (InR (ClientSemanticTokensRequestFullDelta{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 - , _linkedEditingRange = since 3 16 (LinkedEditingRangeClientCapabilities dynamicReg) - , _moniker = since 3 16 (MonikerClientCapabilities dynamicReg) - , _inlayHint = since 3 17 inlayHintCapabilities - , _typeHierarchy = since 3 17 (TypeHierarchyClientCapabilities dynamicReg) - , _inlineValue = since 3 17 (InlineValueClientCapabilities dynamicReg) - , _diagnostic = since 3 17 (DiagnosticClientCapabilities dynamicReg (Just True)) + { 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 + , linkedEditingRange = since 3 16 (LinkedEditingRangeClientCapabilities dynamicReg) + , moniker = since 3 16 (MonikerClientCapabilities dynamicReg) + , inlayHint = since 3 17 inlayHintCapabilities + , typeHierarchy = since 3 17 (TypeHierarchyClientCapabilities dynamicReg) + , inlineValue = since 3 17 (InlineValueClientCapabilities dynamicReg) + , diagnostic = since 3 17 (DiagnosticClientCapabilities dynamicReg (Just True)) } sync = TextDocumentSyncClientCapabilities - { _dynamicRegistration = dynamicReg - , _willSave = Just True - , _willSaveWaitUntil = Just True - , _didSave = Just True + { dynamicRegistration = dynamicReg + , willSave = Just True + , willSaveWaitUntil = Just True + , didSave = Just True } completionCapability = CompletionClientCapabilities - { _dynamicRegistration = dynamicReg - , _completionItem = Just completionItemCapabilities - , _completionItemKind = since 3 4 (ClientCompletionItemOptionsKind{_valueSet = Just ciKs}) - , _insertTextMode = since 3 17 InsertTextMode_AsIs - , _contextSupport = since 3 3 True - , _completionList = since 3 17 (CompletionListCapabilities{_itemDefaults = Just []}) + { dynamicRegistration = dynamicReg + , completionItem = Just completionItemCapabilities + , completionItemKind = since 3 4 (ClientCompletionItemOptionsKind{valueSet = Just ciKs}) + , insertTextMode = since 3 17 InsertTextMode_AsIs + , contextSupport = since 3 3 True + , completionList = since 3 17 (CompletionListCapabilities{itemDefaults = Just []}) } inlayHintCapabilities = InlayHintClientCapabilities - { _dynamicRegistration = dynamicReg - , _resolveSupport = Just (ClientInlayHintResolveOptions{_properties = []}) + { dynamicRegistration = dynamicReg + , resolveSupport = Just (ClientInlayHintResolveOptions{properties = []}) } completionItemCapabilities = ClientCompletionItemOptions - { _snippetSupport = Just True - , _commitCharactersSupport = Just True - , _documentationFormat = since 3 3 allMarkups - , _deprecatedSupport = Just True - , _preselectSupport = since 3 9 True - , _tagSupport = since 3 15 (CompletionItemTagOptions{_valueSet = []}) - , _insertReplaceSupport = since 3 16 True - , _resolveSupport = since 3 16 (ClientCompletionItemResolveOptions{_properties = ["documentation", "details"]}) - , _insertTextModeSupport = since 3 16 (ClientCompletionItemInsertTextModeOptions{_valueSet = []}) - , _labelDetailsSupport = since 3 17 True + { snippetSupport = Just True + , commitCharactersSupport = Just True + , documentationFormat = since 3 3 allMarkups + , deprecatedSupport = Just True + , preselectSupport = since 3 9 True + , tagSupport = since 3 15 (CompletionItemTagOptions{valueSet = []}) + , insertReplaceSupport = since 3 16 True + , resolveSupport = since 3 16 (ClientCompletionItemResolveOptions{properties = ["documentation", "details"]}) + , insertTextModeSupport = since 3 16 (ClientCompletionItemInsertTextModeOptions{valueSet = []}) + , labelDetailsSupport = since 3 17 True } ciKs @@ -251,60 +250,60 @@ capsForVersion (LSPVersion maj min) = caps hoverCapability = HoverClientCapabilities - { _dynamicRegistration = dynamicReg - , _contentFormat = since 3 3 allMarkups + { dynamicRegistration = dynamicReg + , contentFormat = since 3 3 allMarkups } codeActionCapability = CodeActionClientCapabilities - { _dynamicRegistration = dynamicReg - , _codeActionLiteralSupport = since 3 8 (ClientCodeActionLiteralOptions{_codeActionKind = ClientCodeActionKindOptions{_valueSet = Set.toList knownValues}}) - , _isPreferredSupport = since 3 15 True - , _disabledSupport = since 3 16 True - , _dataSupport = since 3 16 True - , _resolveSupport = since 3 16 (ClientCodeActionResolveOptions{_properties = []}) - , _honorsChangeAnnotations = since 3 16 True + { dynamicRegistration = dynamicReg + , codeActionLiteralSupport = since 3 8 (ClientCodeActionLiteralOptions{codeActionKind = ClientCodeActionKindOptions{valueSet = Set.toList knownValues}}) + , isPreferredSupport = since 3 15 True + , disabledSupport = since 3 16 True + , dataSupport = since 3 16 True + , resolveSupport = since 3 16 (ClientCodeActionResolveOptions{properties = []}) + , honorsChangeAnnotations = since 3 16 True } signatureHelpCapability = SignatureHelpClientCapabilities - { _dynamicRegistration = dynamicReg - , _signatureInformation = + { dynamicRegistration = dynamicReg + , signatureInformation = Just $ ClientSignatureInformationOptions - { _documentationFormat = Just allMarkups - , _parameterInformation = Just (ClientSignatureParameterInformationOptions{_labelOffsetSupport = Just True}) - , _activeParameterSupport = Just True + { documentationFormat = Just allMarkups + , parameterInformation = Just (ClientSignatureParameterInformationOptions{labelOffsetSupport = Just True}) + , activeParameterSupport = Just True } - , _contextSupport = since 3 16 True + , contextSupport = since 3 16 True } documentSymbolCapability = DocumentSymbolClientCapabilities - { _dynamicRegistration = dynamicReg + { dynamicRegistration = dynamicReg , -- same as workspace symbol kinds - _symbolKind = Just (ClientSymbolKindOptions{_valueSet = Just sKs}) - , _hierarchicalDocumentSymbolSupport = since 3 10 True - , _tagSupport = since 3 16 (ClientSymbolTagOptions{_valueSet = [SymbolTag_Deprecated]}) - , _labelSupport = since 3 16 True + symbolKind = Just (ClientSymbolKindOptions{valueSet = Just sKs}) + , hierarchicalDocumentSymbolSupport = since 3 10 True + , tagSupport = since 3 16 (ClientSymbolTagOptions{valueSet = [SymbolTag_Deprecated]}) + , labelSupport = since 3 16 True } foldingRangeCapability = FoldingRangeClientCapabilities - { _dynamicRegistration = dynamicReg - , _rangeLimit = Nothing - , _lineFoldingOnly = Nothing - , _foldingRangeKind = since 3 17 (ClientFoldingRangeKindOptions{_valueSet = Just []}) - , _foldingRange = since 3 16 (ClientFoldingRangeOptions{_collapsedText = Just True}) + { dynamicRegistration = dynamicReg + , rangeLimit = Nothing + , lineFoldingOnly = Nothing + , foldingRangeKind = since 3 17 (ClientFoldingRangeKindOptions{valueSet = Just []}) + , foldingRange = since 3 16 (ClientFoldingRangeOptions{collapsedText = Just True}) } publishDiagnosticsCapabilities = PublishDiagnosticsClientCapabilities - { _relatedInformation = since 3 7 True - , _tagSupport = since 3 15 (ClientDiagnosticsTagOptions{_valueSet = [DiagnosticTag_Unnecessary, DiagnosticTag_Deprecated]}) - , _versionSupport = since 3 15 True - , _codeDescriptionSupport = since 3 16 True - , _dataSupport = since 3 16 True + { relatedInformation = since 3 7 True + , tagSupport = since 3 15 (ClientDiagnosticsTagOptions{valueSet = [DiagnosticTag_Unnecessary, DiagnosticTag_Deprecated]}) + , versionSupport = since 3 15 True + , codeDescriptionSupport = since 3 16 True + , dataSupport = since 3 16 True } dynamicReg @@ -317,73 +316,64 @@ capsForVersion (LSPVersion maj min) = caps window = WindowClientCapabilities - { _workDoneProgress = since 3 15 True - , _showMessage = since 3 16 $ ShowMessageRequestClientCapabilities Nothing - , _showDocument = since 3 16 $ ShowDocumentClientCapabilities True + { workDoneProgress = since 3 15 True + , showMessage = since 3 16 $ ShowMessageRequestClientCapabilities Nothing + , showDocument = since 3 16 $ ShowDocumentClientCapabilities True } general = GeneralClientCapabilities - { _staleRequestSupport = since 3 16 (StaleRequestSupportOptions{_cancel = True, _retryOnContentModified = []}) - , _regularExpressions = since 3 16 $ RegularExpressionsClientCapabilities (RegularExpressionEngineKind "") Nothing - , _markdown = since 3 16 $ MarkdownClientCapabilities "" Nothing (Just []) - , _positionEncodings = since 3 17 [PositionEncodingKind_UTF16] + { staleRequestSupport = since 3 16 (StaleRequestSupportOptions{cancel = True, retryOnContentModified = []}) + , regularExpressions = since 3 16 $ RegularExpressionsClientCapabilities (RegularExpressionEngineKind "") Nothing + , markdown = since 3 16 $ MarkdownClientCapabilities "" Nothing (Just []) + , positionEncodings = since 3 17 [PositionEncodingKind_UTF16] } allMarkups = [MarkupKind_PlainText, MarkupKind_Markdown] -- | Whether the client supports dynamic registration for the given method. -dynamicRegistrationSupported :: SMethod m -> ClientCapabilities -> Bool +dynamicRegistrationSupported :: forall t (m :: Method ClientToServer t). SMethod m -> ClientCapabilities -> Bool dynamicRegistrationSupported method caps = fromMaybe False $ case method of - SMethod_WorkspaceDidChangeConfiguration -> caps ^? ws . L.didChangeConfiguration . _Just . dyn - SMethod_WorkspaceDidChangeWatchedFiles -> caps ^? ws . L.didChangeWatchedFiles . _Just . dyn - SMethod_WorkspaceSymbol -> caps ^? ws . L.symbol . _Just . dyn - SMethod_WorkspaceExecuteCommand -> caps ^? ws . L.executeCommand . _Just . dyn - SMethod_WorkspaceWillCreateFiles -> caps ^? ws . L.fileOperations . _Just . dyn - SMethod_WorkspaceDidCreateFiles -> caps ^? ws . L.fileOperations . _Just . dyn - SMethod_WorkspaceWillDeleteFiles -> caps ^? ws . L.fileOperations . _Just . dyn - SMethod_WorkspaceDidDeleteFiles -> caps ^? ws . L.fileOperations . _Just . dyn - SMethod_TextDocumentDidOpen -> caps ^? td . L.synchronization . _Just . dyn - SMethod_TextDocumentDidChange -> caps ^? td . L.synchronization . _Just . dyn - SMethod_TextDocumentDidClose -> caps ^? td . L.synchronization . _Just . dyn - SMethod_TextDocumentCompletion -> caps ^? td . L.completion . _Just . dyn - SMethod_TextDocumentHover -> caps ^? td . L.hover . _Just . dyn - SMethod_TextDocumentSignatureHelp -> caps ^? td . L.signatureHelp . _Just . dyn - SMethod_TextDocumentDeclaration -> caps ^? td . L.declaration . _Just . dyn - SMethod_TextDocumentDefinition -> caps ^? td . L.definition . _Just . dyn - SMethod_TextDocumentTypeDefinition -> caps ^? td . L.typeDefinition . _Just . dyn - SMethod_TextDocumentImplementation -> caps ^? td . L.implementation . _Just . dyn - SMethod_TextDocumentReferences -> caps ^? td . L.references . _Just . dyn - SMethod_TextDocumentDocumentHighlight -> caps ^? td . L.documentHighlight . _Just . dyn - SMethod_TextDocumentDocumentSymbol -> caps ^? td . L.documentSymbol . _Just . dyn - SMethod_TextDocumentCodeAction -> caps ^? td . L.codeAction . _Just . dyn - SMethod_TextDocumentCodeLens -> caps ^? td . L.codeLens . _Just . dyn - SMethod_TextDocumentDocumentLink -> caps ^? td . L.documentLink . _Just . dyn - SMethod_TextDocumentDocumentColor -> caps ^? td . L.colorProvider . _Just . dyn - SMethod_TextDocumentColorPresentation -> caps ^? td . L.colorProvider . _Just . dyn - SMethod_TextDocumentFormatting -> caps ^? td . L.formatting . _Just . dyn - SMethod_TextDocumentRangeFormatting -> caps ^? td . L.rangeFormatting . _Just . dyn - SMethod_TextDocumentOnTypeFormatting -> caps ^? td . L.onTypeFormatting . _Just . dyn - SMethod_TextDocumentRename -> caps ^? td . L.rename . _Just . dyn - SMethod_TextDocumentFoldingRange -> caps ^? td . L.foldingRange . _Just . dyn - SMethod_TextDocumentSelectionRange -> caps ^? td . L.selectionRange . _Just . dyn - SMethod_TextDocumentLinkedEditingRange -> caps ^? td . L.linkedEditingRange . _Just . dyn - SMethod_TextDocumentPrepareCallHierarchy -> caps ^? td . L.callHierarchy . _Just . dyn - SMethod_TextDocumentInlayHint -> caps ^? td . L.inlayHint . _Just . dyn - SMethod_TextDocumentInlineValue -> caps ^? td . L.inlineValue . _Just . dyn - SMethod_TextDocumentMoniker -> caps ^? td . L.moniker . _Just . dyn - SMethod_TextDocumentPrepareTypeHierarchy -> caps ^? td . L.typeHierarchy . _Just . dyn - SMethod_TextDocumentDiagnostic -> caps ^? td . L.diagnostic . _Just . dyn + SMethod_WorkspaceDidChangeConfiguration -> caps.workspace >>= didChangeConfiguration >>= \c -> c.dynamicRegistration + SMethod_WorkspaceDidChangeWatchedFiles -> caps.workspace >>= didChangeWatchedFiles >>= \c -> c.dynamicRegistration + SMethod_WorkspaceSymbol -> caps.workspace >>= symbol >>= \s -> s.dynamicRegistration + SMethod_WorkspaceExecuteCommand -> caps.workspace >>= executeCommand >>= \c -> c.dynamicRegistration + SMethod_WorkspaceWillCreateFiles -> caps.workspace >>= \w -> w.fileOperations >>= \c -> c.dynamicRegistration + SMethod_WorkspaceDidCreateFiles -> caps.workspace >>= \w -> w.fileOperations >>= \c -> c.dynamicRegistration + SMethod_WorkspaceWillDeleteFiles -> caps.workspace >>= \w -> w.fileOperations >>= \c -> c.dynamicRegistration + SMethod_WorkspaceDidDeleteFiles -> caps.workspace >>= \w -> w.fileOperations >>= \c -> c.dynamicRegistration + SMethod_TextDocumentDidOpen -> caps.textDocument >>= \td -> td.synchronization >>= \c -> c.dynamicRegistration + SMethod_TextDocumentDidChange -> caps.textDocument >>= \td -> td.synchronization >>= \c -> c.dynamicRegistration + SMethod_TextDocumentDidClose -> caps.textDocument >>= \td -> td.synchronization >>= \c -> c.dynamicRegistration + SMethod_TextDocumentCompletion -> caps.textDocument >>= completion >>= \c -> c.dynamicRegistration + SMethod_TextDocumentHover -> caps.textDocument >>= hover >>= \c -> c.dynamicRegistration + SMethod_TextDocumentSignatureHelp -> caps.textDocument >>= signatureHelp >>= \c -> c.dynamicRegistration + SMethod_TextDocumentDeclaration -> caps.textDocument >>= declaration >>= \c -> c.dynamicRegistration + SMethod_TextDocumentDefinition -> caps.textDocument >>= definition >>= \c -> c.dynamicRegistration + SMethod_TextDocumentTypeDefinition -> caps.textDocument >>= typeDefinition >>= \c -> c.dynamicRegistration + SMethod_TextDocumentImplementation -> caps.textDocument >>= implementation >>= \c -> c.dynamicRegistration + SMethod_TextDocumentReferences -> caps.textDocument >>= references >>= \c -> c.dynamicRegistration + SMethod_TextDocumentDocumentHighlight -> caps.textDocument >>= documentHighlight >>= \c -> c.dynamicRegistration + SMethod_TextDocumentDocumentSymbol -> caps.textDocument >>= documentSymbol >>= \c -> c.dynamicRegistration + SMethod_TextDocumentCodeAction -> caps.textDocument >>= codeAction >>= \c -> c.dynamicRegistration + SMethod_TextDocumentCodeLens -> caps.textDocument >>= \td -> td.codeLens >>= \c -> c.dynamicRegistration + SMethod_TextDocumentDocumentLink -> caps.textDocument >>= documentLink >>= \c -> c.dynamicRegistration + SMethod_TextDocumentDocumentColor -> caps.textDocument >>= \td -> td.colorProvider >>= \c -> c.dynamicRegistration + SMethod_TextDocumentColorPresentation -> caps.textDocument >>= \td -> td.colorProvider >>= \c -> c.dynamicRegistration + SMethod_TextDocumentFormatting -> caps.textDocument >>= formatting >>= \c -> c.dynamicRegistration + SMethod_TextDocumentRangeFormatting -> caps.textDocument >>= rangeFormatting >>= \c -> c.dynamicRegistration + SMethod_TextDocumentOnTypeFormatting -> caps.textDocument >>= onTypeFormatting >>= \c -> c.dynamicRegistration + SMethod_TextDocumentRename -> caps.textDocument >>= rename >>= \c -> c.dynamicRegistration + SMethod_TextDocumentFoldingRange -> caps.textDocument >>= \td -> td.foldingRange >>= \c -> c.dynamicRegistration + SMethod_TextDocumentSelectionRange -> caps.textDocument >>= \td -> td.selectionRange >>= \c -> c.dynamicRegistration + SMethod_TextDocumentLinkedEditingRange -> caps.textDocument >>= linkedEditingRange >>= \c -> c.dynamicRegistration + SMethod_TextDocumentPrepareCallHierarchy -> caps.textDocument >>= callHierarchy >>= \c -> c.dynamicRegistration + SMethod_TextDocumentInlayHint -> caps.textDocument >>= \td -> td.inlayHint >>= \c -> c.dynamicRegistration + SMethod_TextDocumentInlineValue -> caps.textDocument >>= \td -> td.inlineValue >>= \c -> c.dynamicRegistration + SMethod_TextDocumentMoniker -> caps.textDocument >>= moniker >>= \c -> c.dynamicRegistration + SMethod_TextDocumentPrepareTypeHierarchy -> caps.textDocument >>= typeHierarchy >>= \c -> c.dynamicRegistration + SMethod_TextDocumentDiagnostic -> caps.textDocument >>= diagnostic >>= \c -> c.dynamicRegistration -- semantic tokens is messed up due to it having you register with an otherwise non-existent method -- SMethod_TextDocumentSemanticTokens -> capDyn $ clientCaps ^? L.textDocument . _Just . L.semanticTokens . _Just -- Notebook document methods alway support dynamic registration, it seems? _ -> Just False - where - td :: Traversal' ClientCapabilities TextDocumentClientCapabilities - td = L.textDocument . _Just - - ws :: Traversal' ClientCapabilities WorkspaceClientCapabilities - ws = L.workspace . _Just - - dyn :: L.HasDynamicRegistration a (Maybe Bool) => Traversal' a Bool - dyn = L.dynamicRegistration . _Just diff --git a/lsp-types/src/Language/LSP/Protocol/Lens.hs b/lsp-types/src/Language/LSP/Protocol/Lens.hs deleted file mode 100644 index 5cd88879..00000000 --- a/lsp-types/src/Language/LSP/Protocol/Lens.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Language.LSP.Protocol.Lens ( - -- * Generated lens classes - module TypesLens, - module MessageLens, -) where - -import Language.LSP.Protocol.Message.Lens as MessageLens -import Language.LSP.Protocol.Types.Lens as TypesLens diff --git a/lsp-types/src/Language/LSP/Protocol/Message/Lens.hs b/lsp-types/src/Language/LSP/Protocol/Message/Lens.hs deleted file mode 100644 index 8ee97a83..00000000 --- a/lsp-types/src/Language/LSP/Protocol/Message/Lens.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -Wno-orphans #-} - -module Language.LSP.Protocol.Message.Lens where - -import Control.Lens.TH -import Language.LSP.Protocol.Message.Registration -import Language.LSP.Protocol.Message.Types -import Language.LSP.Protocol.Types.Lens - -makeFieldsNoPrefix ''TRegistration -makeFieldsNoPrefix ''TUnregistration -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/Message/Parsing.hs b/lsp-types/src/Language/LSP/Protocol/Message/Parsing.hs index 32de1287..76bbf482 100644 --- a/lsp-types/src/Language/LSP/Protocol/Message/Parsing.hs +++ b/lsp-types/src/Language/LSP/Protocol/Message/Parsing.hs @@ -42,14 +42,14 @@ fromServerNot :: TMessage m ~ TNotificationMessage m => TNotificationMessage m -> FromServerMessage -fromServerNot m@TNotificationMessage{_method = meth} = FromServerMess meth m +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 +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 @@ -66,14 +66,14 @@ fromClientNot :: TMessage m ~ TNotificationMessage m => TNotificationMessage m -> FromClientMessage -fromClientNot m@TNotificationMessage{_method = meth} = FromClientMess meth m +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 +fromClientReq m@TRequestMessage{method = meth} = FromClientMess meth m -- --------------------------------------------------------------------- -- Parsing diff --git a/lsp-types/src/Language/LSP/Protocol/Message/Registration.hs b/lsp-types/src/Language/LSP/Protocol/Message/Registration.hs index 89cf1d19..85a75721 100644 --- a/lsp-types/src/Language/LSP/Protocol/Message/Registration.hs +++ b/lsp-types/src/Language/LSP/Protocol/Message/Registration.hs @@ -19,12 +19,12 @@ import Prettyprinter -- | Typed registration type, with correct options. data TRegistration (m :: Method ClientToServer t) = TRegistration - { _id :: Text + { id :: Text -- ^ The id used to register the request. The id can be used to deregister -- the request again. - , _method :: SClientMethod m + , method :: SClientMethod m -- ^ The method / capability to register for. - , _registerOptions :: !(Maybe (RegistrationOptions m)) + , registerOptions :: !(Maybe (RegistrationOptions m)) -- ^ Options necessary for the registration. -- Make this strict to aid the pattern matching exhaustiveness checker } @@ -78,10 +78,10 @@ toSomeRegistration r = -- | Typed unregistration type. data TUnregistration (m :: Method ClientToServer t) = TUnregistration - { _id :: Text + { id :: Text -- ^ The id used to unregister the request or notification. Usually an id -- provided during the register request. - , _method :: SMethod m + , method :: SMethod m -- ^ The method / capability to unregister for. } deriving stock (Generic) diff --git a/lsp-types/src/Language/LSP/Protocol/Message/Types.hs b/lsp-types/src/Language/LSP/Protocol/Message/Types.hs index 320a3b5f..9672e0f6 100644 --- a/lsp-types/src/Language/LSP/Protocol/Message/Types.hs +++ b/lsp-types/src/Language/LSP/Protocol/Message/Types.hs @@ -26,9 +26,9 @@ import Prettyprinter -- | Notification message type as defined in the spec. data NotificationMessage = NotificationMessage - { _jsonrpc :: Text - , _method :: Text - , _params :: Maybe Value + { jsonrpc :: Text + , method :: Text + , params :: Maybe Value } deriving stock (Show, Eq, Generic) @@ -39,10 +39,10 @@ deriving via ViaJSON NotificationMessage instance Pretty NotificationMessage -- | Request message type as defined in the spec. data RequestMessage = RequestMessage - { _jsonrpc :: Text - , _id :: Int32 |? Text - , _method :: Text - , _params :: Maybe Value + { jsonrpc :: Text + , id :: Int32 |? Text + , method :: Text + , params :: Maybe Value } deriving stock (Show, Eq, Generic) @@ -51,9 +51,9 @@ deriving via ViaJSON RequestMessage instance Pretty RequestMessage -- | Response error type as defined in the spec. data ResponseError = ResponseError - { _code :: LSPErrorCodes |? ErrorCodes - , _message :: Text - , _xdata :: Maybe Value + { code :: LSPErrorCodes |? ErrorCodes + , message :: Text + , xdata :: Maybe Value } deriving stock (Show, Eq, Generic) @@ -84,17 +84,17 @@ instance FromJSON ResponseError where where go :: ResponseError -> ResponseError go x@(ResponseError (InL (LSPErrorCodes_Custom n)) _ _) = - x{_code = InR (fromOpenEnumBaseType n)} + x{code = InR (fromOpenEnumBaseType n)} go x = x deriving via ViaJSON ResponseError instance Pretty ResponseError -- | Response message type as defined in the spec. data ResponseMessage = ResponseMessage - { _jsonrpc :: Text - , _id :: Int32 |? Text |? Null - , _result :: Maybe Value - , _error :: Maybe ResponseError + { jsonrpc :: Text + , id :: Int32 |? Text |? Null + , result :: Maybe Value + , error :: Maybe ResponseError } deriving stock (Show, Eq, Generic) @@ -106,9 +106,9 @@ deriving via ViaJSON ResponseMessage instance Pretty ResponseMessage -- | Typed notification message, containing the correct parameter payload. data TNotificationMessage (m :: Method f Notification) = TNotificationMessage - { _jsonrpc :: Text - , _method :: SMethod m - , _params :: MessageParams m + { jsonrpc :: Text + , method :: SMethod m + , params :: MessageParams m } deriving stock (Generic) @@ -136,10 +136,10 @@ deriving via ViaJSON (TNotificationMessage m) instance (ToJSON (MessageParams m) -- | 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 + { jsonrpc :: Text + , id :: LspId m + , method :: SMethod m + , params :: MessageParams m } deriving stock (Generic) @@ -156,9 +156,9 @@ instance (ToJSON (MessageParams m)) => ToJSON (TRequestMessage m) where deriving via ViaJSON (TRequestMessage m) instance (ToJSON (MessageParams m)) => Pretty (TRequestMessage m) data TResponseError (m :: Method f Request) = TResponseError - { _code :: LSPErrorCodes |? ErrorCodes - , _message :: Text - , _xdata :: Maybe (ErrorData m) + { code :: LSPErrorCodes |? ErrorCodes + , message :: Text + , xdata :: Maybe (ErrorData m) } deriving stock (Generic) @@ -176,7 +176,7 @@ instance (FromJSON (ErrorData m)) => FromJSON (TResponseError m) where where go :: TResponseError m -> TResponseError m go x@(TResponseError (InL (LSPErrorCodes_Custom n)) _ _) = - x{_code = InR (fromOpenEnumBaseType n)} + x{code = InR (fromOpenEnumBaseType n)} go x = x instance (ToJSON (ErrorData m)) => ToJSON (TResponseError m) where toJSON = genericToJSON lspOptions @@ -190,10 +190,10 @@ 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) + { jsonrpc :: Text + , id :: Maybe (LspId m) , -- TODO: use `TResponseError m` for the error type, this will require quite a lot of adaptation downstream - _result :: Either ResponseError (MessageResult m) + result :: Either ResponseError (MessageResult m) } deriving stock (Generic) @@ -201,7 +201,7 @@ deriving stock instance (Eq (MessageResult m), Eq (ErrorData m)) => Eq (TRespons 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} = + toJSON TResponseMessage{jsonrpc = jsonrpc, id = lspid, result = result} = object [ "jsonrpc" .= jsonrpc , "id" .= lspid diff --git a/lsp-types/src/Language/LSP/Protocol/Types.hs b/lsp-types/src/Language/LSP/Protocol/Types.hs index a66cc46c..888c049e 100644 --- a/lsp-types/src/Language/LSP/Protocol/Types.hs +++ b/lsp-types/src/Language/LSP/Protocol/Types.hs @@ -28,9 +28,6 @@ module Language.LSP.Protocol.Types ( -- ** Code actions module CodeAction, - -- ** Progress - module Progress, - -- ** Semantic tokens module SemanticTokens, @@ -49,7 +46,6 @@ 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.Orphans () -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 diff --git a/lsp-types/src/Language/LSP/Protocol/Types/Common.hs b/lsp-types/src/Language/LSP/Protocol/Types/Common.hs index 10ac8aeb..64f94610 100644 --- a/lsp-types/src/Language/LSP/Protocol/Types/Common.hs +++ b/lsp-types/src/Language/LSP/Protocol/Types/Common.hs @@ -8,8 +8,6 @@ module Language.LSP.Protocol.Types.Common ( type (|?) (..), toEither, - _L, - _R, Int32, UInt, Null (..), @@ -22,11 +20,11 @@ module Language.LSP.Protocol.Types.Common ( import Control.Applicative import Control.DeepSeq -import Control.Lens import Data.Aeson hiding (Null) import Data.Aeson qualified as J import Data.Aeson.KeyMap qualified as KM import Data.Aeson.Types qualified as J +import Data.Bifunctor (bimap) import Data.Hashable import Data.Int (Int32) import Data.Mod.Word @@ -85,18 +83,6 @@ data a |? b infixr 9 |? --- | 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 diff --git a/lsp-types/src/Language/LSP/Protocol/Types/Edit.hs b/lsp-types/src/Language/LSP/Protocol/Types/Edit.hs index 786d5e91..203e1e79 100644 --- a/lsp-types/src/Language/LSP/Protocol/Types/Edit.hs +++ b/lsp-types/src/Language/LSP/Protocol/Types/Edit.hs @@ -6,7 +6,6 @@ module Language.LSP.Protocol.Types.Edit where import Data.Text (Text) import Data.Text qualified as T -import Control.Lens hiding (index) import Language.LSP.Protocol.Internal.Types import Language.LSP.Protocol.Types.Common @@ -49,11 +48,3 @@ 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/Lens.hs b/lsp-types/src/Language/LSP/Protocol/Types/Lens.hs deleted file mode 100644 index 10a99b73..00000000 --- a/lsp-types/src/Language/LSP/Protocol/Types/Lens.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -Wno-orphans #-} - -module Language.LSP.Protocol.Types.Lens where - -import Language.LSP.Protocol.Internal.Meta -import Language.LSP.Protocol.Types.SemanticTokens -import Language.LSP.Protocol.Utils.Misc - -$(genLenses (structNames ++ [''SemanticTokenAbsolute, ''SemanticTokenRelative])) diff --git a/lsp-types/src/Language/LSP/Protocol/Types/Location.hs b/lsp-types/src/Language/LSP/Protocol/Types/Location.hs index 6d2c5c12..2c3d96b0 100644 --- a/lsp-types/src/Language/LSP/Protocol/Types/Location.hs +++ b/lsp-types/src/Language/LSP/Protocol/Types/Location.hs @@ -13,7 +13,7 @@ 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 +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 diff --git a/lsp-types/src/Language/LSP/Protocol/Types/Progress.hs b/lsp-types/src/Language/LSP/Protocol/Types/Progress.hs deleted file mode 100644 index 9e38fbb0..00000000 --- a/lsp-types/src/Language/LSP/Protocol/Types/Progress.hs +++ /dev/null @@ -1,31 +0,0 @@ -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 index a66372b5..ce267918 100644 --- a/lsp-types/src/Language/LSP/Protocol/Types/SemanticTokens.hs +++ b/lsp-types/src/Language/LSP/Protocol/Types/SemanticTokens.hs @@ -44,11 +44,11 @@ defaultSemanticTokensLegend = 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] + { line :: UInt + , startChar :: UInt + , length :: UInt + , tokenType :: SemanticTokenTypes + , tokenModifiers :: [SemanticTokenModifiers] } deriving stock (Show, Eq, Ord) @@ -57,11 +57,11 @@ data SemanticTokenAbsolute = SemanticTokenAbsolute -- | 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] + { deltaLine :: UInt + , deltaStartChar :: UInt + , length :: UInt + , tokenType :: SemanticTokenTypes + , tokenModifiers :: [SemanticTokenModifiers] } deriving stock (Show, Eq, Ord) @@ -104,7 +104,7 @@ absolutizeTokens xs = DList.toList $ go 0 0 xs mempty -- | 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 = +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) @@ -183,7 +183,7 @@ makeSemanticTokens legend sts = do 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} = +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/Utils/Misc.hs b/lsp-types/src/Language/LSP/Protocol/Utils/Misc.hs index f5465957..1e5c551c 100644 --- a/lsp-types/src/Language/LSP/Protocol/Utils/Misc.hs +++ b/lsp-types/src/Language/LSP/Protocol/Utils/Misc.hs @@ -9,13 +9,9 @@ module Language.LSP.Protocol.Utils.Misc ( lspOptionsUntagged, prettyJSON, ViaJSON (..), - genLenses, ) where -import Control.Lens.Internal.FieldTH -import Control.Lens.TH import Control.Monad -import Control.Monad.State import Data.Aeson import Data.Aeson.Text as Aeson import Data.Foldable qualified as F @@ -113,7 +109,7 @@ lspOptions = defaultOptions{omitNothingFields = True, fieldLabelModifier = modif -- fixes up the json derivation modifier "_xdata" = "data" modifier "_xtype" = "type" - modifier xs = drop 1 xs + modifier xs = dropWhile (\x -> x == '_') xs -- | Standard options for use when generating JSON instances for an untagged union lspOptionsUntagged :: Options @@ -136,18 +132,3 @@ newtype ViaJSON a = ViaJSON a instance ToJSON a => Pretty (ViaJSON a) where pretty (ViaJSON a) = prettyJSON $ toJSON a - -{- | Given a list of type names, make a splice that generates the lens typeclass declarations -for all of them. Defined here to avoid stage restrictions. --} -genLenses :: [TH.Name] -> TH.Q [TH.Dec] -genLenses names = do - let - -- We need to use the internals of the lens TH machinery so that we can do this - -- in one go without generating duplicate classes. - opticMaker :: TH.Name -> HasFieldClasses [TH.Dec] - opticMaker n = do - (TH.TyConI d) <- lift $ TH.reify n - makeFieldOpticsForDec' classUnderscoreNoPrefixFields d - decss <- flip evalStateT mempty $ traverse opticMaker names - pure $ concat decss diff --git a/lsp-types/test/CapabilitiesSpec.hs b/lsp-types/test/CapabilitiesSpec.hs index e09aa6b6..e746d963 100644 --- a/lsp-types/test/CapabilitiesSpec.hs +++ b/lsp-types/test/CapabilitiesSpec.hs @@ -10,10 +10,10 @@ import Test.Hspec spec :: Spec spec = describe "capabilities" $ do it "gives 3.10 capabilities" $ - let ClientCapabilities{_textDocument = Just tdcs} = capsForVersion (LSPVersion 3 10) - Just (DocumentSymbolClientCapabilities{_hierarchicalDocumentSymbolSupport = 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{_textDocument = Just tdcs} = capsForVersion (LSPVersion 3 9) - Just (DocumentSymbolClientCapabilities{_hierarchicalDocumentSymbolSupport = 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 9ca69fac..7870910c 100644 --- a/lsp-types/test/JsonSpec.hs +++ b/lsp-types/test/JsonSpec.hs @@ -50,7 +50,7 @@ spec = do `shouldBe` Right ( CompletionList True - (Just (CompletionItemDefaults{_commitCharacters = Nothing, _editRange = Nothing, _insertTextFormat = Nothing, _insertTextMode = Nothing, _data_ = Just J.Null})) + (Just (CompletionItemDefaults{commitCharacters = Nothing, editRange = Nothing, insertTextFormat = Nothing, insertTextMode = Nothing, data_ = Just J.Null})) mempty ) diff --git a/lsp-types/test/SemanticTokensSpec.hs b/lsp-types/test/SemanticTokensSpec.hs index 37262ca0..3d2904d4 100644 --- a/lsp-types/test/SemanticTokensSpec.hs +++ b/lsp-types/test/SemanticTokensSpec.hs @@ -5,7 +5,7 @@ module SemanticTokensSpec where import Data.Either (isRight) import Data.List (unfoldr) import Language.LSP.Protocol.Types -import Test.Hspec +import Test.Hspec as Hspec spec :: Spec spec = do @@ -52,7 +52,7 @@ spec = do it "handles big tokens" $ relativizeTokens bigTokens `shouldBe` bigTokensRel describe "encodeTokens" $ do - context "when running the LSP examples" $ do + Hspec.context "when running the LSP examples" $ do it "encodes example 1 correctly" $ let encoded = encodeTokens exampleLegend (relativizeTokens exampleTokens1) in encoded `shouldBe` Right [{- token 1 -} 2, 5, 3, 0, 3 {- token 2 -}, 0, 5, 4, 1, 0 {- token 3 -}, 3, 2, 7, 2, 0] diff --git a/lsp-types/test/ServerCapabilitiesSpec.hs b/lsp-types/test/ServerCapabilitiesSpec.hs index c57f77f8..544f7cb2 100644 --- a/lsp-types/test/ServerCapabilitiesSpec.hs +++ b/lsp-types/test/ServerCapabilitiesSpec.hs @@ -1,12 +1,11 @@ {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module ServerCapabilitiesSpec where -import Control.Lens.Operators import Data.Aeson hiding (Null) import Data.Maybe (fromJust) -import Language.LSP.Protocol.Lens import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import Test.Hspec @@ -30,12 +29,12 @@ spec = describe "server capabilities" $ do it "decodes" $ let input = "{\"hoverProvider\": true, \"colorProvider\": {\"id\": \"abc123\", \"documentSelector\": " <> documentFiltersJson <> "}}" caps :: ServerCapabilities = fromJust $ decode input - in caps ^. colorProvider `shouldBe` Just (InR $ InR $ DocumentColorRegistrationOptions (InL documentFilters) Nothing (Just "abc123")) + 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\"}]}" registrationParams :: RegistrationParams = fromJust $ decode input - in registrationParams ^. registrations + in registrationParams.registrations `shouldBe` [ toUntypedRegistration $ TRegistration "4a56f5ca-7188-4f4c-a366-652d6f9d63aa" @@ -43,5 +42,5 @@ spec = describe "server capabilities" $ do (Just $ DidChangeConfigurationRegistrationOptions Nothing) ] where - documentFilters = DocumentSelector [DocumentFilter $ InL $ TextDocumentFilter $ InL $ TextDocumentFilterLanguage{_language = "haskell", _scheme = Nothing, _pattern = Nothing}] + documentFilters = DocumentSelector [DocumentFilter $ InL $ TextDocumentFilter $ InL $ TextDocumentFilterLanguage{language = "haskell", scheme = Nothing, pattern = Nothing}] documentFiltersJson = "[{\"language\": \"haskell\"}]" diff --git a/lsp/example/Reactor.hs b/lsp/example/Reactor.hs index cc11d756..514d4f1b 100644 --- a/lsp/example/Reactor.hs +++ b/lsp/example/Reactor.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeInType #-} -- So we can keep using the old prettyprinter modules (which have a better @@ -40,7 +41,7 @@ import Data.Text.Prettyprint.Doc import GHC.Generics (Generic) import Language.LSP.Diagnostics import Language.LSP.Logging (defaultClientLogger) -import Language.LSP.Protocol.Lens qualified as LSP +import Language.LSP.Protocol.Lens import Language.LSP.Protocol.Message qualified as LSP import Language.LSP.Protocol.Types qualified as LSP import Language.LSP.Server @@ -121,11 +122,11 @@ run = flip E.catches handlers $ do 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 + { 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 @@ -229,7 +230,8 @@ handle logger = rsp = [LSP.CodeLens (LSP.mkRange 0 0 0 100) (Just cmd) Nothing] responder (Right $ LSP.InL rsp) , notificationHandler LSP.SMethod_TextDocumentDidOpen $ \msg -> do - let doc = msg ^. LSP.params . LSP.textDocument . LSP.uri + let params = msg.params + doc = params.textDocument.uri fileName = LSP.uriToFilePath doc logger <& ("Processing DidOpenTextDocument for: " <> T.pack (show fileName)) `WithSeverity` Info sendDiagnostics (LSP.toNormalizedUri doc) (Just 0) @@ -240,12 +242,9 @@ handle logger = 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 + let + params = msg.params + doc = LSP.toNormalizedUri (params.textDocument.uri) logger <& ("Processing DidChangeTextDocument for: " <> T.pack (show doc)) `WithSeverity` Info mdoc <- getVirtualFile doc case mdoc of @@ -254,25 +253,27 @@ handle logger = Nothing -> do logger <& ("Didn't find anything in the VFS for: " <> T.pack (show doc)) `WithSeverity` Info , notificationHandler LSP.SMethod_TextDocumentDidSave $ \msg -> do - let doc = msg ^. LSP.params . LSP.textDocument . LSP.uri - fileName = LSP.uriToFilePath doc + let + params = msg.params + doc = params.textDocument.uri + fileName = LSP.uriToFilePath doc logger <& ("Processing DidSaveTextDocument for: " <> T.pack (show fileName)) `WithSeverity` Info sendDiagnostics (LSP.toNormalizedUri doc) Nothing , requestHandler LSP.SMethod_TextDocumentRename $ \req responder -> do logger <& "Processing a textDocument/rename request" `WithSeverity` Info - let params = req ^. LSP.params - LSP.Position l c = params ^. LSP.position - newName = params ^. LSP.newName - vdoc <- getVersionedTextDoc (params ^. LSP.textDocument) + let params = req.params + LSP.Position l c = params.position + newName = params.newName + vdoc <- getVersionedTextDoc (params.textDocument) -- Replace some text at the position with what the user entered let edit = LSP.InL $ LSP.TextEdit (LSP.mkRange l c l (c + fromIntegral (T.length newName))) newName - tde = LSP.TextDocumentEdit (LSP._versionedTextDocumentIdentifier # vdoc) [edit] + tde = LSP.TextDocumentEdit (versionedTextDocumentIdentifier # vdoc) [edit] -- "documentChanges" field is preferred over "changes" rsp = LSP.WorkspaceEdit Nothing (Just [LSP.InL tde]) Nothing responder (Right $ LSP.InL rsp) , requestHandler LSP.SMethod_TextDocumentHover $ \req responder -> do logger <& "Processing a textDocument/hover request" `WithSeverity` Info - let LSP.HoverParams _doc pos _workDone = req ^. LSP.params + let LSP.HoverParams _doc pos _workDone = req.params LSP.Position _l _c' = pos rsp = LSP.Hover ms (Just range) ms = LSP.InL $ LSP.mkMarkdown "Your type info here!" @@ -280,21 +281,21 @@ handle logger = responder (Right $ LSP.InL rsp) , requestHandler LSP.SMethod_TextDocumentDocumentSymbol $ \req responder -> do logger <& "Processing a textDocument/documentSymbol request" `WithSeverity` Info - let LSP.DocumentSymbolParams _ _ doc = req ^. LSP.params - loc = LSP.Location (doc ^. LSP.uri) (LSP.Range (LSP.Position 0 0) (LSP.Position 0 0)) + let LSP.DocumentSymbolParams _ _ doc = req.params + loc = LSP.Location (doc.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 LSP.SMethod_TextDocumentCodeAction $ \req responder -> do logger <& "Processing a textDocument/codeAction request" `WithSeverity` Info - let params = req ^. LSP.params - doc = params ^. LSP.textDocument - diags = params ^. LSP.context . LSP.diagnostics + let params = req.params + doc = params.textDocument + diags = params.context.diagnostics -- makeCommand only generates commands for diagnostics whose source is us makeCommand d - | (LSP.Range s _) <- d ^. LSP.range - , (Just "lsp-hello") <- d ^. LSP.source = + | (LSP.Range s _) <- d.range + , (Just "lsp-hello") <- d.source = let - title = "Apply LSP hello command:" <> head (T.lines $ d ^. LSP.message) + title = "Apply LSP hello command:" <> head (T.lines $ d.message) -- NOTE: the cmd needs to be registered via the InitializeResponse message. See lspOptions above cmd = "lsp-hello-command" -- need 'file' and 'start_pos' @@ -310,12 +311,14 @@ handle logger = responder (Right $ LSP.InL rsp) , requestHandler LSP.SMethod_WorkspaceExecuteCommand $ \req responder -> do logger <& "Processing a workspace/executeCommand request" `WithSeverity` Info - let params = req ^. LSP.params - margs = params ^. LSP.arguments + let + params :: LSP.ExecuteCommandParams + params = req.params + margs = params.arguments logger <& ("The arguments are: " <> T.pack (show margs)) `WithSeverity` Debug responder (Right $ LSP.InL (J.Object mempty)) -- respond to the request - void $ withProgress "Executing some long running command" (req ^. LSP.params . LSP.workDoneToken) Cancellable $ \update -> + void $ withProgress "Executing some long running command" (params.workDoneToken) Cancellable $ \update -> forM [(0 :: LSP.UInt) .. 10] $ \i -> do update (ProgressAmount (Just (i * 10)) (Just "Doing stuff")) liftIO $ threadDelay (1 * 1000000) diff --git a/lsp/lsp.cabal b/lsp/lsp.cabal index 52fb8354..81c8310f 100644 --- a/lsp/lsp.cabal +++ b/lsp/lsp.cabal @@ -1,4 +1,4 @@ -cabal-version: 2.2 +cabal-version: 3.0 name: lsp version: 2.4.0.0 synopsis: Haskell library for the Microsoft Language Server Protocol @@ -32,7 +32,6 @@ library ghc-options: -Wall -fprint-explicit-kinds reexported-modules: , Language.LSP.Protocol.Types - , Language.LSP.Protocol.Lens , Language.LSP.Protocol.Capabilities , Language.LSP.Protocol.Message @@ -60,6 +59,7 @@ library , directory ^>=1.3 , exceptions ^>=0.10 , filepath >=1.4 && < 1.6 + , generic-lens ^>=2.2 , hashable ^>=1.4 , lens >=5.1 && <5.3 , lens-aeson ^>=1.2 @@ -86,8 +86,10 @@ executable lsp-demo-reactor-server , aeson , base , co-log-core + , generic-lens , lens , lsp + , lsp-types:lsp-types-lens , prettyprinter , stm , text diff --git a/lsp/src/Language/LSP/Diagnostics.hs b/lsp/src/Language/LSP/Diagnostics.hs index acf51f14..f9a4b5b7 100644 --- a/lsp/src/Language/LSP/Diagnostics.hs +++ b/lsp/src/Language/LSP/Diagnostics.hs @@ -50,7 +50,7 @@ type DiagnosticsBySource = Map.Map (Maybe Text) (SL.SortedList J.Diagnostic) -- --------------------------------------------------------------------- partitionBySource :: [J.Diagnostic] -> DiagnosticsBySource -partitionBySource diags = Map.fromListWith mappend $ map (\d -> (J._source d, (SL.singleton d))) diags +partitionBySource diags = Map.fromListWith mappend $ map (\d -> (J.source d, (SL.singleton d))) diags -- --------------------------------------------------------------------- diff --git a/lsp/src/Language/LSP/Server/Core.hs b/lsp/src/Language/LSP/Server/Core.hs index 0a7b0aed..415c4251 100644 --- a/lsp/src/Language/LSP/Server/Core.hs +++ b/lsp/src/Language/LSP/Server/Core.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE TypeFamilyDependencies #-} @@ -24,7 +26,6 @@ import Control.Concurrent.Async import Control.Concurrent.MVar import Control.Concurrent.STM import Control.Exception qualified as E -import Control.Lens (at, (^.), (^?), _Just) import Control.Monad import Control.Monad.Catch ( MonadCatch, @@ -54,8 +55,7 @@ import Data.Text qualified as T import Data.UUID qualified as UUID import Language.LSP.Diagnostics import Language.LSP.Protocol.Capabilities -import Language.LSP.Protocol.Lens qualified as L -import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Message hiding (error) import Language.LSP.Protocol.Message qualified as L import Language.LSP.Protocol.Types import Language.LSP.Protocol.Types qualified as L @@ -441,7 +441,7 @@ sendRequest m params resHandler = do getVirtualFile :: MonadLsp config m => NormalizedUri -> m (Maybe VirtualFile) getVirtualFile uri = do dat <- vfsData <$> getsState resVFS - pure $ dat ^. vfsMap . at uri + pure $ Map.lookup uri dat.vfsMap {-# INLINE getVirtualFile #-} getVirtualFiles :: MonadLsp config m => m VFS @@ -476,7 +476,7 @@ persistVirtualFile logger dir uri = do -- | Given a text document identifier, annotate it with the latest version. getVersionedTextDoc :: MonadLsp config m => TextDocumentIdentifier -> m VersionedTextDocumentIdentifier getVersionedTextDoc doc = do - let uri = doc ^. L.uri + let uri = doc.uri mvf <- getVirtualFile (toNormalizedUri uri) let ver = case mvf of Just (VirtualFile lspver _ _) -> lspver @@ -538,7 +538,7 @@ getRootPath = resRootPath <$> getLspEnv getWorkspaceFolders :: MonadLsp config m => m (Maybe [WorkspaceFolder]) getWorkspaceFolders = do clientCaps <- getClientCapabilities - let clientSupportsWfs = fromMaybe False $ clientCaps ^? L.workspace . _Just . L.workspaceFolders . _Just + let clientSupportsWfs = fromMaybe False $ clientCaps.workspace >>= \w -> w.workspaceFolders if clientSupportsWfs then Just <$> getsState resWorkspaceFolders else pure Nothing @@ -761,7 +761,7 @@ withProgressBase indefinite title clientToken cancellable f = do wait aid clientSupportsServerInitiatedProgress :: L.ClientCapabilities -> Bool -clientSupportsServerInitiatedProgress caps = fromMaybe False $ caps ^? L.window . _Just . L.workDoneProgress . _Just +clientSupportsServerInitiatedProgress caps = fromMaybe False $ caps.window >>= \w -> w.workDoneProgress {-# INLINE clientSupportsServerInitiatedProgress #-} {- | @@ -854,7 +854,7 @@ reverseSortEdit (L.WorkspaceEdit cs dcs anns) = L.WorkspaceEdit cs' dcs' anns dcs' = (fmap . fmap) sortOnlyTextDocumentEdits dcs sortTextEdits :: [L.TextEdit] -> [L.TextEdit] - sortTextEdits edits = L.sortOn (Down . (^. L.range)) edits + sortTextEdits edits = L.sortOn (Down . (\r -> r.range)) edits sortOnlyTextDocumentEdits :: L.DocumentChange -> L.DocumentChange sortOnlyTextDocumentEdits (L.InL (L.TextDocumentEdit td edits)) = L.InL $ L.TextDocumentEdit td edits' @@ -863,8 +863,8 @@ reverseSortEdit (L.WorkspaceEdit cs dcs anns) = L.WorkspaceEdit cs' dcs' anns sortOnlyTextDocumentEdits (L.InR others) = L.InR others editRange :: L.TextEdit L.|? L.AnnotatedTextEdit -> L.Range - editRange (L.InR e) = e ^. L.range - editRange (L.InL e) = e ^. L.range + editRange (L.InR e) = e.range + editRange (L.InL e) = e.range -------------------------------------------------------------------------------- -- CONFIG @@ -893,7 +893,7 @@ tryChangeConfig logger newConfigObject = do requestConfigUpdate :: (m ~ LspM config) => LogAction m (WithSeverity LspCoreLog) -> m () requestConfigUpdate logger = do caps <- LspT $ asks resClientCapabilities - let supportsConfiguration = fromMaybe False $ caps ^? L.workspace . _Just . L.configuration . _Just + let supportsConfiguration = fromMaybe False $ caps.workspace >>= configuration if supportsConfiguration then do section <- LspT $ asks resConfigSection diff --git a/lsp/src/Language/LSP/Server/Processing.hs b/lsp/src/Language/LSP/Server/Processing.hs index 7a165772..40f80e15 100644 --- a/lsp/src/Language/LSP/Server/Processing.hs +++ b/lsp/src/Language/LSP/Server/Processing.hs @@ -1,5 +1,5 @@ {-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecursiveDo #-} @@ -54,8 +54,7 @@ import Data.String (fromString) import Data.Text qualified as T import Data.Text.Lazy.Encoding qualified as TL import Data.Text.Prettyprint.Doc -import Language.LSP.Protocol.Lens qualified as L -import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Message hiding (error) import Language.LSP.Protocol.Types import Language.LSP.Protocol.Utils.SMethodMap (SMethodMap) import Language.LSP.Protocol.Utils.SMethodMap qualified as SMethodMap @@ -99,14 +98,14 @@ 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 ^. L.result) + pure $ liftIO $ f (res.result) where parser :: ResponseMap -> Value -> Parser (FromClientMessage' (P.Product ServerResponseCallback (Const ResponseMap))) parser rm = parseClientMessage $ \i -> let (mhandler, newMap) = pickFromIxMap i rm in (\(P.Pair m handler) -> (m, P.Pair handler (Const newMap))) <$> mhandler - handleErrors = either (\e -> logger <& MessageProcessingError jsonStr e `WithSeverity` Error) id + handleErrors = either (\e -> logger <& MessageProcessingError jsonStr e `WithSeverity` Error) Prelude.id -- | Call this to initialize the session initializeRequestHandler :: @@ -119,26 +118,26 @@ initializeRequestHandler :: initializeRequestHandler logger ServerDefinition{..} vfs sendFunc req = do let sendResp = sendFunc . FromServerRsp SMethod_Initialize handleErr (Left err) = do - sendResp $ makeResponseError (req ^. L.id) err + sendResp $ makeResponseError req.id err pure Nothing handleErr (Right a) = pure $ Just a - flip E.catch (initializeErrorHandler $ sendResp . makeResponseError (req ^. L.id)) $ handleErr <=< runExceptT $ mdo - let p = req ^. L.params + flip E.catch (initializeErrorHandler $ sendResp . makeResponseError req.id) $ handleErr <=< runExceptT $ mdo + let p = req.params rootDir = getFirst $ foldMap First - [ p ^? L.rootUri . _L >>= uriToFilePath - , p ^? L.rootPath . _Just . _L <&> T.unpack + [ case p.rootUri of InL p -> uriToFilePath p; _ -> Nothing + , case p.rootPath of Just (InL p) -> Just (T.unpack p); _ -> Nothing ] - clientCaps = (p ^. L.capabilities) + clientCaps = p.capabilities - let initialWfs = case p ^. L.workspaceFolders of + let initialWfs = case p.workspaceFolders of Just (InL xs) -> xs _ -> [] -- See Note [LSP configuration] - configObject = lookForConfigSection configSection <$> (p ^. L.initializationOptions) + configObject = lookForConfigSection configSection <$> p.initializationOptions initialConfig <- case configObject of Just o -> case parseConfig defaultConfig o of @@ -167,14 +166,14 @@ initializeRequestHandler logger ServerDefinition{..} vfs sendFunc req = do pure LanguageContextState{..} -- Call the 'duringInitialization' callback to let the server kick stuff up - let env = LanguageContextEnv handlers configSection parseConfig configChanger sendFunc stateVars (p ^. L.capabilities) rootDir + let env = LanguageContextEnv handlers configSection parseConfig configChanger sendFunc stateVars (p.capabilities) rootDir configChanger config = forward interpreter (onConfigChange config) handlers = transmuteHandlers interpreter (staticHandlers clientCaps) interpreter = interpretHandler initializationResult initializationResult <- ExceptT $ doInitialize env req let serverCaps = inferServerCapabilities clientCaps options handlers - liftIO $ sendResp $ makeResponseMessage (req ^. L.id) (InitializeResult serverCaps (optServerInfo options)) + liftIO $ sendResp $ makeResponseMessage (req.id) (InitializeResult serverCaps (optServerInfo options)) pure env where makeResponseMessage rid result = TResponseMessage "2.0" (Just rid) (Right result) @@ -194,118 +193,118 @@ initializeRequestHandler logger ServerDefinition{..} vfs sendFunc req = do inferServerCapabilities :: ClientCapabilities -> Options -> Handlers m -> ServerCapabilities inferServerCapabilities _clientCaps o h = ServerCapabilities - { _textDocumentSync = sync - , _hoverProvider = + { textDocumentSync = sync + , hoverProvider = supported' SMethod_TextDocumentHover $ InR $ HoverOptions clientInitiatedProgress - , _completionProvider = completionProvider - , _inlayHintProvider = inlayProvider - , _declarationProvider = + , completionProvider = completionProvider + , inlayHintProvider = inlayProvider + , declarationProvider = supported' SMethod_TextDocumentDeclaration $ InR $ InL $ DeclarationOptions clientInitiatedProgress - , _signatureHelpProvider = signatureHelpProvider - , _definitionProvider = + , signatureHelpProvider = signatureHelpProvider + , definitionProvider = supported' SMethod_TextDocumentDefinition $ InR $ DefinitionOptions clientInitiatedProgress - , _typeDefinitionProvider = + , typeDefinitionProvider = supported' SMethod_TextDocumentTypeDefinition $ InR $ InL $ TypeDefinitionOptions clientInitiatedProgress - , _implementationProvider = + , implementationProvider = supported' SMethod_TextDocumentImplementation $ InR $ InL $ ImplementationOptions clientInitiatedProgress - , _referencesProvider = + , referencesProvider = supported' SMethod_TextDocumentReferences $ InR $ ReferenceOptions clientInitiatedProgress - , _documentHighlightProvider = + , documentHighlightProvider = supported' SMethod_TextDocumentDocumentHighlight $ InR $ DocumentHighlightOptions clientInitiatedProgress - , _documentSymbolProvider = + , documentSymbolProvider = supported' SMethod_TextDocumentDocumentSymbol $ InR $ DocumentSymbolOptions clientInitiatedProgress Nothing - , _codeActionProvider = codeActionProvider - , _codeLensProvider = + , codeActionProvider = codeActionProvider + , codeLensProvider = supported' SMethod_TextDocumentCodeLens $ CodeLensOptions clientInitiatedProgress (supported SMethod_CodeLensResolve) - , _documentFormattingProvider = + , documentFormattingProvider = supported' SMethod_TextDocumentFormatting $ InR $ DocumentFormattingOptions clientInitiatedProgress - , _documentRangeFormattingProvider = + , documentRangeFormattingProvider = supported' SMethod_TextDocumentRangeFormatting $ InR $ DocumentRangeFormattingOptions clientInitiatedProgress - , _documentOnTypeFormattingProvider = documentOnTypeFormattingProvider - , _renameProvider = + , documentOnTypeFormattingProvider = documentOnTypeFormattingProvider + , renameProvider = supported' SMethod_TextDocumentRename $ InR $ RenameOptions clientInitiatedProgress (supported SMethod_TextDocumentPrepareRename) - , _documentLinkProvider = + , documentLinkProvider = supported' SMethod_TextDocumentDocumentLink $ DocumentLinkOptions clientInitiatedProgress (supported SMethod_DocumentLinkResolve) - , _colorProvider = + , colorProvider = supported' SMethod_TextDocumentDocumentColor $ InR $ InL $ DocumentColorOptions clientInitiatedProgress - , _foldingRangeProvider = + , foldingRangeProvider = supported' SMethod_TextDocumentFoldingRange $ InR $ InL $ FoldingRangeOptions clientInitiatedProgress - , _executeCommandProvider = executeCommandProvider - , _selectionRangeProvider = + , executeCommandProvider = executeCommandProvider + , selectionRangeProvider = supported' SMethod_TextDocumentSelectionRange $ InR $ InL $ SelectionRangeOptions clientInitiatedProgress - , _callHierarchyProvider = + , callHierarchyProvider = supported' SMethod_TextDocumentPrepareCallHierarchy $ InR $ InL $ CallHierarchyOptions clientInitiatedProgress - , _semanticTokensProvider = semanticTokensProvider - , _workspaceSymbolProvider = + , semanticTokensProvider = semanticTokensProvider + , workspaceSymbolProvider = supported' SMethod_WorkspaceSymbol $ InR $ WorkspaceSymbolOptions clientInitiatedProgress (supported SMethod_WorkspaceSymbolResolve) - , _workspace = Just workspace - , _experimental = Nothing :: Maybe Value + , workspace = Just workspace + , experimental = Nothing :: Maybe Value , -- The only encoding the VFS supports is the legacy UTF16 option at the moment - _positionEncoding = Just PositionEncodingKind_UTF16 - , _linkedEditingRangeProvider = + positionEncoding = Just PositionEncodingKind_UTF16 + , linkedEditingRangeProvider = supported' SMethod_TextDocumentLinkedEditingRange $ InR $ InL $ LinkedEditingRangeOptions clientInitiatedProgress - , _monikerProvider = + , monikerProvider = supported' SMethod_TextDocumentMoniker $ InR $ InL $ MonikerOptions clientInitiatedProgress - , _typeHierarchyProvider = + , typeHierarchyProvider = supported' SMethod_TextDocumentPrepareTypeHierarchy $ InR $ InL $ TypeHierarchyOptions clientInitiatedProgress - , _inlineValueProvider = + , inlineValueProvider = supported' SMethod_TextDocumentInlineValue $ InR $ InL $ InlineValueOptions clientInitiatedProgress - , _diagnosticProvider = diagnosticProvider + , diagnosticProvider = diagnosticProvider , -- TODO: super unclear what to do about notebooks in general - _notebookDocumentSync = Nothing + notebookDocumentSync = Nothing } where clientInitiatedProgress = Just (optSupportClientInitiatedProgress o) @@ -329,11 +328,11 @@ inferServerCapabilities _clientCaps o h = completionProvider = supported' SMethod_TextDocumentCompletion $ CompletionOptions - { _triggerCharacters = map T.singleton <$> optCompletionTriggerCharacters o - , _allCommitCharacters = map T.singleton <$> optCompletionAllCommitCharacters o - , _resolveProvider = supported SMethod_CompletionItemResolve - , _completionItem = Nothing - , _workDoneProgress = clientInitiatedProgress + { triggerCharacters = map T.singleton <$> optCompletionTriggerCharacters o + , allCommitCharacters = map T.singleton <$> optCompletionAllCommitCharacters o + , resolveProvider = supported SMethod_CompletionItemResolve + , completionItem = Nothing + , workDoneProgress = clientInitiatedProgress } inlayProvider = @@ -341,17 +340,17 @@ inferServerCapabilities _clientCaps o h = InR $ InL InlayHintOptions - { _workDoneProgress = clientInitiatedProgress - , _resolveProvider = supported SMethod_InlayHintResolve + { workDoneProgress = clientInitiatedProgress + , resolveProvider = supported SMethod_InlayHintResolve } codeActionProvider = supported' SMethod_TextDocumentCodeAction $ InR $ CodeActionOptions - { _workDoneProgress = clientInitiatedProgress - , _codeActionKinds = optCodeActionKinds o - , _resolveProvider = supported SMethod_CodeActionResolve + { workDoneProgress = clientInitiatedProgress + , codeActionKinds = optCodeActionKinds o + , resolveProvider = supported SMethod_CodeActionResolve } signatureHelpProvider = @@ -387,14 +386,14 @@ inferServerCapabilities _clientCaps o h = | supported_b SMethod_TextDocumentSemanticTokensRange = Just $ InL True | otherwise = Nothing semanticTokenFullProvider - | supported_b SMethod_TextDocumentSemanticTokensFull = Just $ InR $ SemanticTokensFullDelta{_delta = supported SMethod_TextDocumentSemanticTokensFullDelta} + | supported_b SMethod_TextDocumentSemanticTokensFull = Just $ InR $ SemanticTokensFullDelta{delta = supported SMethod_TextDocumentSemanticTokensFullDelta} | otherwise = Nothing sync = case optTextDocumentSync o of Just x -> Just (InL x) Nothing -> Nothing - workspace = WorkspaceOptions{_workspaceFolders = workspaceFolder, _fileOperations = Nothing} + workspace = WorkspaceOptions{workspaceFolders = workspaceFolder, fileOperations = Nothing} workspaceFolder = supported' SMethod_WorkspaceDidChangeWorkspaceFolders $ -- sign up to receive notifications @@ -404,11 +403,11 @@ inferServerCapabilities _clientCaps o h = supported' SMethod_TextDocumentDiagnostic $ InL $ DiagnosticOptions - { _workDoneProgress = clientInitiatedProgress - , _identifier = Nothing + { workDoneProgress = clientInitiatedProgress + , identifier = Nothing , -- TODO: this is a conservative but maybe inaccurate, unclear how much it matters - _interFileDependencies = True - , _workspaceDiagnostics = supported_b SMethod_WorkspaceDiagnostic + interFileDependencies = True + , workspaceDiagnostics = supported_b SMethod_WorkspaceDiagnostic } {- | Invokes the registered dynamic or static handlers for the given message and @@ -450,13 +449,13 @@ handle' logger mAction m msg = do mkRspCb req (Left err) = runLspT env $ sendToClient $ - FromServerRsp (req ^. L.method) $ - TResponseMessage "2.0" (Just (req ^. L.id)) (Left err) + FromServerRsp (req.method) $ + TResponseMessage "2.0" (Just (req.id)) (Left err) mkRspCb req (Right rsp) = runLspT env $ sendToClient $ - FromServerRsp (req ^. L.method) $ - TResponseMessage "2.0" (Just (req ^. L.id)) (Right rsp) + FromServerRsp (req.method) $ + TResponseMessage "2.0" (Just (req.id)) (Right rsp) case splitClientMethod m of IsClientNot -> case pickHandler dynNotHandlers notHandlers of @@ -473,8 +472,8 @@ handle' logger mAction m msg = do let errorMsg = T.pack $ unwords ["lsp:no handler for: ", show m] err = ResponseError (InR ErrorCodes_MethodNotFound) errorMsg Nothing sendToClient $ - FromServerRsp (msg ^. L.method) $ - TResponseMessage "2.0" (Just (msg ^. L.id)) (Left err) + FromServerRsp (msg.method) $ + TResponseMessage "2.0" (Just (msg.id)) (Left err) IsClientEither -> case msg of NotMess noti -> case pickHandler dynNotHandlers notHandlers of Just h -> liftIO $ h noti @@ -485,8 +484,8 @@ handle' logger mAction m msg = do let errorMsg = T.pack $ unwords ["lsp:no handler for: ", show m] err = ResponseError (InR ErrorCodes_MethodNotFound) errorMsg Nothing sendToClient $ - FromServerRsp (req ^. L.method) $ - TResponseMessage "2.0" (Just (req ^. L.id)) (Left err) + FromServerRsp (req.method) $ + TResponseMessage "2.0" (Just (req.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. @@ -558,7 +557,8 @@ handleDidChangeConfiguration logger req = do -- Then we will succeed the first attempt and fail (or in fact do nothing in) the second one. -- 3. Client supports `workspace/configuration` and sends updated config in `workspace/didChangeConfiguration`. -- Then both will succeed, which is a bit redundant but not a big deal. - tryChangeConfig (cmap (fmap LspCore) logger) (lookForConfigSection section $ req ^. L.params . L.settings) + let p = req.params + tryChangeConfig (cmap (fmap LspCore) logger) (lookForConfigSection section $ p.settings) requestConfigUpdate (cmap (fmap LspCore) logger) vfsFunc :: @@ -586,8 +586,8 @@ vfsFunc logger modifyVfs req = do -- | Updates the list of workspace folders updateWorkspaceFolders :: TMessage Method_WorkspaceDidChangeWorkspaceFolders -> LspM config () updateWorkspaceFolders (TNotificationMessage _ _ params) = do - let toRemove = params ^. L.event . L.removed - toAdd = params ^. L.event . L.added + 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 e2e9cef8..2da22903 100644 --- a/lsp/src/Language/LSP/VFS.hs +++ b/lsp/src/Language/LSP/VFS.hs @@ -19,11 +19,7 @@ files in the client workspace by operating on the "VFS" in "LspFuncs". -} module Language.LSP.VFS ( VFS (..), - vfsMap, VirtualFile (..), - lsp_version, - file_version, - file_text, virtualFileText, virtualFileVersion, VfsLog (..), @@ -62,6 +58,7 @@ import Control.Lens hiding (parts, (<.>)) import Control.Monad import Control.Monad.State import Data.Foldable (traverse_) +import Data.Generics.Labels () import Data.Hashable import Data.Int (Int32) import Data.List @@ -74,7 +71,7 @@ import Data.Text.Prettyprint.Doc hiding (line) import Data.Text.Utf16.Lines as Utf16 (Position (..)) import Data.Text.Utf16.Rope.Mixed (Rope) import Data.Text.Utf16.Rope.Mixed qualified as Rope -import Language.LSP.Protocol.Lens qualified as J +import GHC.Generics import Language.LSP.Protocol.Message qualified as J import Language.LSP.Protocol.Types qualified as J import System.Directory @@ -88,20 +85,20 @@ import System.IO -- --------------------------------------------------------------------- data VirtualFile = VirtualFile - { _lsp_version :: !Int32 + { lsp_version :: !Int32 -- ^ The LSP version of the document - , _file_version :: !Int + , file_version :: !Int -- ^ This number is only incremented whilst the file -- remains in the map. - , _file_text :: !Rope + , file_text :: !Rope -- ^ The full contents of the document } - deriving (Show) + deriving (Show, Generic) data VFS = VFS - { _vfsMap :: !(Map.Map J.NormalizedUri VirtualFile) + { vfsMap :: !(Map.Map J.NormalizedUri VirtualFile) } - deriving (Show) + deriving (Show, Generic) data VfsLog = SplitInsideCodePoint Utf16.Position Rope @@ -124,16 +121,13 @@ instance Pretty VfsLog where "VFS: can't recursively delete" <+> pretty uri <+> "because we don't track directory status" pretty (DeleteNonExistent uri) = "VFS: asked to delete non-existent file" <+> pretty uri -makeFieldsNoPrefix ''VirtualFile -makeFieldsNoPrefix ''VFS - --- virtualFileText :: VirtualFile -> Text -virtualFileText vf = Rope.toText (_file_text vf) +virtualFileText vf = Rope.toText (file_text vf) virtualFileVersion :: VirtualFile -> Int32 -virtualFileVersion vf = _lsp_version vf +virtualFileVersion vf = lsp_version vf --- @@ -145,10 +139,12 @@ emptyVFS = VFS mempty -- | Applies the changes from a 'J.DidOpenTextDocument' to the 'VFS' 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) + let + p = msg ^. #params + J.TextDocumentItem (J.toNormalizedUri -> uri) _ version text = p ^. #textDocument + vfile = VirtualFile version 0 (Rope.fromText text) logger <& Opening uri `WithSeverity` Debug - vfsMap . at uri .= Just vfile + #vfsMap . at uri .= Just vfile -- --------------------------------------------------------------------- @@ -156,21 +152,21 @@ openVFS logger msg = do changeFromClientVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_TextDocumentDidChange -> m () changeFromClientVFS logger msg = do let - J.DidChangeTextDocumentParams vid changes = msg ^. J.params + J.DidChangeTextDocumentParams vid changes = msg ^. #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) version = vid vfs <- get - case vfs ^. vfsMap . at uri of + case vfs ^. #vfsMap . at uri of Just (VirtualFile _ file_ver contents) -> do contents' <- applyChanges logger contents changes - vfsMap . at uri .= Just (VirtualFile version (file_ver + 1) contents') + #vfsMap . at uri .= Just (VirtualFile version (file_ver + 1) contents') Nothing -> logger <& URINotFound uri `WithSeverity` Warning -- --------------------------------------------------------------------- applyCreateFile :: (MonadState VFS m) => J.CreateFile -> m () applyCreateFile (J.CreateFile _ann _kind (J.toNormalizedUri -> uri) options) = - vfsMap + #vfsMap %= Map.insertWith (\new old -> if shouldOverwrite then new else old) uri @@ -192,17 +188,17 @@ applyCreateFile (J.CreateFile _ann _kind (J.toNormalizedUri -> uri) options) = applyRenameFile :: (MonadState VFS m) => J.RenameFile -> m () applyRenameFile (J.RenameFile _ann _kind (J.toNormalizedUri -> oldUri) (J.toNormalizedUri -> newUri) options) = do vfs <- get - case vfs ^. vfsMap . at oldUri of + case vfs ^. #vfsMap . at oldUri of -- nothing to rename Nothing -> pure () - Just file -> case vfs ^. vfsMap . at newUri of + Just file -> case vfs ^. #vfsMap . at newUri of -- the target does not exist, just move over Nothing -> do - vfsMap . at oldUri .= Nothing - vfsMap . at newUri .= Just file + #vfsMap . at oldUri .= Nothing + #vfsMap . at newUri .= Just file Just _ -> when shouldOverwrite $ do - vfsMap . at oldUri .= Nothing - vfsMap . at newUri .= Just file + #vfsMap . at oldUri .= Nothing + #vfsMap . at newUri .= Just file where shouldOverwrite :: Bool shouldOverwrite = case options of @@ -220,15 +216,15 @@ applyRenameFile (J.RenameFile _ann _kind (J.toNormalizedUri -> oldUri) (J.toNorm applyDeleteFile :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.DeleteFile -> m () 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) $ + when (options ^? _Just . #recursive . _Just == Just True) $ logger <& CantRecursiveDelete uri `WithSeverity` Warning -- Remove and get the old value so we can check if it was missing - old <- vfsMap . at uri <.= Nothing + old <- #vfsMap . at uri <.= Nothing case old of -- It's not entirely clear what the semantics of 'ignoreIfNotExists' are, but if it -- doesn't exist and we're not ignoring it, let's at least log it. Nothing - | options ^? _Just . J.ignoreIfNotExists . _Just /= Just True -> + | options ^? _Just . #ignoreIfNotExists . _Just /= Just True -> logger <& CantRecursiveDelete uri `WithSeverity` Warning _ -> pure () @@ -239,18 +235,18 @@ applyTextDocumentEdit logger (J.TextDocumentEdit vid edits) = do let sortedEdits = sortOn (Down . editRange) edits changeEvents = map editToChangeEvent sortedEdits -- TODO: is this right? - vid' = J.VersionedTextDocumentIdentifier (vid ^. J.uri) (case vid ^. J.version of J.InL v -> v; J.InR _ -> 0) + vid' = J.VersionedTextDocumentIdentifier (vid ^. #uri) (case vid ^. #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 editRange :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.Range - editRange (J.InR e) = e ^. J.range - editRange (J.InL e) = e ^. J.range + editRange (J.InR e) = e ^. #range + editRange (J.InL e) = e ^. #range editToChangeEvent :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.TextDocumentContentChangeEvent - editToChangeEvent (J.InR e) = J.TextDocumentContentChangeEvent $ J.InL $ J.TextDocumentContentChangePartial{_range = e ^. J.range, _rangeLength = Nothing, _text = e ^. J.newText} - editToChangeEvent (J.InL e) = J.TextDocumentContentChangeEvent $ J.InL $ J.TextDocumentContentChangePartial{_range = e ^. J.range, _rangeLength = Nothing, _text = e ^. J.newText} + editToChangeEvent (J.InR e) = J.TextDocumentContentChangeEvent $ J.InL $ J.TextDocumentContentChangePartial{range = e ^. #range, rangeLength = Nothing, text = e ^. #newText} + editToChangeEvent (J.InL e) = J.TextDocumentContentChangeEvent $ J.InL $ J.TextDocumentContentChangePartial{range = e ^. #range, rangeLength = Nothing, text = e ^. #newText} applyDocumentChange :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.DocumentChange -> m () applyDocumentChange logger (J.InL change) = applyTextDocumentEdit logger change @@ -261,7 +257,7 @@ applyDocumentChange logger (J.InR (J.InR (J.InR change))) = applyDeleteFile logg -- | Applies the changes from a 'ApplyWorkspaceEditRequest' to the 'VFS' 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 + let J.ApplyWorkspaceEditParams _label edit = msg ^. #params J.WorkspaceEdit mChanges mDocChanges _anns = edit case mDocChanges of Just docChanges -> applyDocumentChanges docChanges @@ -277,7 +273,7 @@ changeFromServerVFS logger msg = do -- for sorting [DocumentChange] project :: J.DocumentChange -> Maybe J.Int32 - project (J.InL textDocumentEdit) = case textDocumentEdit ^. J.textDocument . J.version of + project (J.InL textDocumentEdit) = case textDocumentEdit ^. #textDocument . #version of J.InL v -> Just v _ -> Nothing project _ = Nothing @@ -299,14 +295,14 @@ virtualFileName prefix uri (VirtualFile _ file_ver _) = -- | Write a virtual file to a file in the given directory if it exists in the VFS. persistFileVFS :: (MonadIO m) => LogAction m (WithSeverity VfsLog) -> FilePath -> VFS -> J.NormalizedUri -> Maybe (FilePath, m ()) persistFileVFS logger dir vfs uri = - case vfs ^. vfsMap . at uri of + case vfs ^. #vfsMap . at uri of Nothing -> Nothing Just vf -> let tfn = virtualFileName dir uri vf action = do exists <- liftIO $ doesFileExist tfn unless exists $ do - let contents = Rope.toText (_file_text vf) + let contents = Rope.toText (file_text vf) writeRaw h = do -- We honour original file line endings hSetNewlineMode h noNewlineTranslation @@ -320,9 +316,9 @@ persistFileVFS logger dir vfs uri = 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 + let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier (J.toNormalizedUri -> uri)) = msg ^. #params logger <& Closing uri `WithSeverity` Debug - vfsMap . at uri .= Nothing + #vfsMap . at uri .= Nothing -- --------------------------------------------------------------------- @@ -337,11 +333,11 @@ applyChanges logger = foldM (applyChange logger) applyChange :: (Monad m) => LogAction m (WithSeverity VfsLog) -> Rope -> J.TextDocumentContentChangeEvent -> m Rope applyChange logger str (J.TextDocumentContentChangeEvent (J.InL e)) - | J.Range (J.Position sl sc) (J.Position fl fc) <- e ^. J.range - , txt <- e ^. J.text = + | J.Range (J.Position sl sc) (J.Position fl fc) <- e ^. #range + , txt <- e ^. #text = changeChars logger str (Utf16.Position (fromIntegral sl) (fromIntegral sc)) (Utf16.Position (fromIntegral fl) (fromIntegral fc)) txt applyChange _ _ (J.TextDocumentContentChangeEvent (J.InR e)) = - pure $ Rope.fromText $ e ^. J.text + pure $ Rope.fromText $ e ^. #text -- --------------------------------------------------------------------- @@ -423,7 +419,7 @@ extractLine rope l = do codePointPositionToPosition :: VirtualFile -> CodePointPosition -> Maybe J.Position codePointPositionToPosition vFile (CodePointPosition l c) = do -- See Note [Converting between code points and code units] - let text = _file_text vFile + let text = file_text vFile lineRope <- extractLine text $ fromIntegral l guard $ c <= fromIntegral (Rope.charLength lineRope) return $ J.Position l (fromIntegral $ Rope.utf16Length $ fst $ Rope.charSplitAt (fromIntegral c) lineRope) @@ -449,7 +445,7 @@ codePointRangeToRange vFile (CodePointRange b e) = positionToCodePointPosition :: VirtualFile -> J.Position -> Maybe CodePointPosition positionToCodePointPosition vFile (J.Position l c) = do -- See Note [Converting between code points and code units] - let text = _file_text vFile + let text = file_text vFile lineRope <- extractLine text $ fromIntegral l guard $ c <= fromIntegral (Rope.utf16Length lineRope) CodePointPosition l . fromIntegral . Rope.charLength . fst <$> Rope.utf16SplitAt (fromIntegral c) lineRope diff --git a/lsp/test/VspSpec.hs b/lsp/test/VspSpec.hs index 0d94430a..fb220ace 100644 --- a/lsp/test/VspSpec.hs +++ b/lsp/test/VspSpec.hs @@ -36,7 +36,7 @@ vfsFromText text = VirtualFile 0 0 (Rope.fromText text) -- --------------------------------------------------------------------- mkChangeEvent :: J.Range -> T.Text -> J.TextDocumentContentChangeEvent -mkChangeEvent r t = J.TextDocumentContentChangeEvent $ J.InL $ J.TextDocumentContentChangePartial{J._range = r, J._rangeLength = Nothing, J._text = t} +mkChangeEvent r t = J.TextDocumentContentChangeEvent $ J.InL $ J.TextDocumentContentChangePartial{J.range = r, J.rangeLength = Nothing, J.text = t} vspSpec :: Spec vspSpec = do diff --git a/nix/sources.json b/nix/sources.json index 04b5932c..222a8f3c 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -5,10 +5,10 @@ "homepage": "", "owner": "hercules-ci", "repo": "gitignore.nix", - "rev": "9e21c80adf67ebcb077d75bd5e7d724d21eeafd6", - "sha256": "1lbkgn94y8850g7idqnbji12pscxjwrspnzmx8fmm7xmy9ablk5y", + "rev": "637db329424fd7e46cf4185293b9cc8c88c95394", + "sha256": "02wxkdpbhlm3yk5mhkhsp3kwakc16xpmsf2baw57nz1dg459qv8w", "type": "tarball", - "url": "https://github.com/hercules-ci/gitignore.nix/archive/9e21c80adf67ebcb077d75bd5e7d724d21eeafd6.tar.gz", + "url": "https://github.com/hercules-ci/gitignore.nix/archive/637db329424fd7e46cf4185293b9cc8c88c95394.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "niv": { @@ -17,10 +17,10 @@ "homepage": "https://github.com/nmattia/niv", "owner": "nmattia", "repo": "niv", - "rev": "723f0eeb969a730db3c30f977c2b66b9dce9fe4a", - "sha256": "0016l7230gd2kdh0g2w573r9a2krqb7x4ifcjhhsn4h1bwap7qr0", + "rev": "6f6529db3a69cf3c4dd81eebcb5b46f1d34170e5", + "sha256": "1qbyprn08917cszfm5syppi4r5p467qii4fzb2v1s0lrqqn0das4", "type": "tarball", - "url": "https://github.com/nmattia/niv/archive/723f0eeb969a730db3c30f977c2b66b9dce9fe4a.tar.gz", + "url": "https://github.com/nmattia/niv/archive/6f6529db3a69cf3c4dd81eebcb5b46f1d34170e5.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "nixpkgs": { @@ -29,10 +29,10 @@ "homepage": "", "owner": "NixOS", "repo": "nixpkgs", - "rev": "9ea24fc7e02b65c150c88e1412400b70087bd382", - "sha256": "002abgrz7gdj99gzyhmkpxx8j3x5grapmal9i0r580phvin9g2r5", + "rev": "72c6ed328aa4e5d9151b1a512f6ad83aca7529fa", + "sha256": "1fzrqm29n6iq1c998ym5ijsj5x3z1l07qkc4xb48y9c22bl8cn11", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/9ea24fc7e02b65c150c88e1412400b70087bd382.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/72c6ed328aa4e5d9151b1a512f6ad83aca7529fa.tar.gz", "url_template": "https://github.com///archive/.tar.gz" } }