lsp-types 1.3.0.1 → 1.4.0.0

raw patch · 27 files changed

+539/−171 lines, 27 filesdep +moddep −dependent-sumdep −dependent-sum-templatedep ~Diffdep ~aesondep ~basenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: mod

Dependencies removed: dependent-sum, dependent-sum-template

Dependency ranges changed: Diff, aeson, base, network-uri

API changes (from Hackage documentation)

Files

• ChangeLog.md +18/−0
• lsp-types.cabal +5/−6
• src/Language/LSP/Types/Capabilities.hs +12/−10
• src/Language/LSP/Types/ClientCapabilities.hs +102/−6
• src/Language/LSP/Types/CodeAction.hs +51/−29
• src/Language/LSP/Types/Common.hs +46/−5
• src/Language/LSP/Types/Diagnostic.hs +3/−3
• src/Language/LSP/Types/DocumentColor.hs +4/−4
• src/Language/LSP/Types/FoldingRange.hs +6/−5
• src/Language/LSP/Types/Formatting.hs +2/−1
• src/Language/LSP/Types/Initialize.hs +1/−1
• src/Language/LSP/Types/Lens.hs +14/−0
• src/Language/LSP/Types/Location.hs +5/−4
• src/Language/LSP/Types/LspId.hs +4/−2
• src/Language/LSP/Types/MarkupContent.hs +20/−2
• src/Language/LSP/Types/Message.hs +5/−3
• src/Language/LSP/Types/Method.hs +40/−5
• src/Language/LSP/Types/Parsing.hs +30/−27
• src/Language/LSP/Types/Progress.hs +4/−3
• src/Language/LSP/Types/SMethodMap.hs +71/−0
• src/Language/LSP/Types/SemanticTokens.hs +24/−24
• src/Language/LSP/Types/SignatureHelp.hs +4/−4
• src/Language/LSP/Types/TextDocument.hs +3/−3
• src/Language/LSP/Types/Uri.hs +0/−0
• src/Language/LSP/Types/Window.hs +43/−0
• src/Language/LSP/Types/WorkspaceEdit.hs +9/−3
• src/Language/LSP/VFS.hs +13/−21

@@ -1,5 +1,23 @@ # Revision history for lsp-types +## 1.4.0.0++* Aeson 2 compatibility (#360) (@michaelpj)+* Reduced dependency footprint (#383, #384) (@Bodigrim)+* Use appropriate number types (#366) (@michaelpj)+* Fix for #374 (#376) (@pepeiborra)+* Fix virtual file name adding .hs extension (#364) (@heitor-lassarote, @jneira)+* Fix the Semigroup instance for MarkupContent (#361) (@michaelpj)+* Various improvements to spec conformance (@michaelpj)++## 1.3.0.1++* Rollback NFP interning (#344) (@pepeiborra)++## 1.3.0.0++* Intern NormalizedFilePaths (#340) (@pepeiborra)+ ## 1.2.0.1  * Add compatibility with GHC 9.2 (#345) (@fendor)

@@ -1,5 +1,6 @@+cabal-version:       2.2 name:                lsp-types-version:             1.3.0.1+version:             1.4.0.0 synopsis:            Haskell library for the Microsoft Language Server Protocol, data types  description:         An implementation of the types to allow language implementors to@@ -14,12 +15,12 @@ category:            Development build-type:          Simple extra-source-files:  ChangeLog.md, README.md-cabal-version:       >=1.10  library   exposed-modules:     Language.LSP.Types                      , Language.LSP.Types.Capabilities                      , Language.LSP.Types.Lens+                     , Language.LSP.Types.SMethodMap                      , Language.LSP.VFS                      , Data.IxMap   other-modules:       Language.LSP.Types.CallHierarchy@@ -70,7 +71,7 @@                      , Language.LSP.Types.WorkspaceSymbol  -- other-extensions:   ghc-options:         -Wall-  build-depends:       base >= 4.11 && < 4.16+  build-depends:       base >= 4.11 && < 5                      , aeson >=1.2.2.0                      , binary                      , bytestring@@ -86,12 +87,10 @@                      , lens >= 4.15.2                      , mtl                      , network-uri+                     , mod                      , rope-utf16-splay >= 0.3.1.0                      , scientific                      , some-                     , dependent-sum-template >= 0.1.0.0-                     -- transitive dependency of the previous one, which does not have the correct lower bound-                     , dependent-sum >= 0.7.1.0                      , text                      , template-haskell                      , temporary

@@ -35,7 +35,7 @@ -- * 3.4 extended completion item and symbol item kinds -- * 3.0 dynamic registration capsForVersion :: LSPVersion -> ClientCapabilities-capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Just window) Nothing+capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Just window) (since 3 16 general) Nothing   where     w = WorkspaceClientCapabilities           (Just True)@@ -223,14 +223,7 @@           (since 3 16 (CodeActionResolveClientCapabilities (List [])))           (since 3 16 True)     caKs = CodeActionKindClientCapabilities-              (List [ CodeActionQuickFix-                    , CodeActionRefactor-                    , CodeActionRefactorExtract-                    , CodeActionRefactorInline-                    , CodeActionRefactorRewrite-                    , CodeActionSource-                    , CodeActionSourceOrganizeImports-                    ])+              (List specCodeActionKinds)      signatureHelpCapability =       SignatureHelpClientCapabilities@@ -285,4 +278,13 @@       | maj >= x && min >= y = Just a       | otherwise            = Nothing -    window = WindowClientCapabilities (since 3 15 True)+    window =+      WindowClientCapabilities+        (since 3 15 True)+        (since 3 16 $ ShowMessageRequestClientCapabilities Nothing)+        (since 3 16 $ ShowDocumentClientCapabilities True)++    general = GeneralClientCapabilities+      (since 3 16 $ StaleRequestClientCapabilities True (List []))+      (since 3 16 $ RegularExpressionsClientCapabilities "" Nothing)+      (since 3 16 $ MarkdownClientCapabilities "" Nothing)

@@ -6,6 +6,8 @@ import           Data.Aeson.TH import qualified Data.Aeson as A import Data.Default+import Data.Text (Text)+ import Language.LSP.Types.CallHierarchy import Language.LSP.Types.CodeAction import Language.LSP.Types.CodeLens@@ -34,6 +36,8 @@ import Language.LSP.Types.WatchedFiles import Language.LSP.Types.WorkspaceEdit import Language.LSP.Types.WorkspaceSymbol+import Language.LSP.Types.MarkupContent (MarkdownClientCapabilities)+import Language.LSP.Types.Common (List)   data WorkspaceClientCapabilities =@@ -170,30 +174,122 @@  -- --------------------------------------------------------------------- +-- | Capabilities specific to the `MessageActionItem` type.+data MessageActionItemClientCapabilities =+  MessageActionItemClientCapabilities+    {+      -- | Whether the client supports additional attributes which+      -- are preserved and sent back to the server in the+      -- request's response.+      _additionalPropertiesSupport :: Maybe Bool+    } deriving (Show, Read, Eq)++deriveJSON lspOptions ''MessageActionItemClientCapabilities++-- | Show message request client capabilities+data ShowMessageRequestClientCapabilities =+  ShowMessageRequestClientCapabilities+    { -- | Capabilities specific to the `MessageActionItem` type.+      _messageActionItem :: Maybe MessageActionItemClientCapabilities+    } deriving (Show, Read, Eq)++deriveJSON lspOptions ''ShowMessageRequestClientCapabilities++-- | Client capabilities for the show document request.+--+-- @since 3.16.0+data ShowDocumentClientCapabilities =+  ShowDocumentClientCapabilities+    { -- | The client has support for the show document request+      _support :: Bool+    } deriving (Show, Read, Eq)++deriveJSON lspOptions ''ShowDocumentClientCapabilities+ -- | Window specific client capabilities. data WindowClientCapabilities =   WindowClientCapabilities     { -- | Whether client supports handling progress notifications.+      --+      -- @since 3.15.0       _workDoneProgress :: Maybe Bool+      -- | Capabilities specific to the showMessage request+      --+      -- @since 3.16.0+    , _showMessage :: Maybe ShowMessageRequestClientCapabilities+      -- | Capabilities specific to the showDocument request+      --+      -- @since 3.16.0+    , _showDocument :: Maybe ShowDocumentClientCapabilities     } deriving (Show, Read, Eq)  deriveJSON lspOptions ''WindowClientCapabilities  instance Default WindowClientCapabilities where-  def = WindowClientCapabilities def+  def = WindowClientCapabilities def def def +-- ---------------------------------------------------------------------++-- | Client capability that signals how the client+-- handles stale requests (e.g. a request+-- for which the client will not process the response+-- anymore since the information is outdated).+-- @since 3.17.0+data StaleRequestClientCapabilities =+  StaleRequestClientCapabilities+    { _cancel :: Bool+    , _retryOnContentModified :: List Text+    } deriving (Show, Read, Eq)++deriveJSON lspOptions ''StaleRequestClientCapabilities++-- | Client capabilities specific to the used markdown parser.+-- @since 3.16.0+data RegularExpressionsClientCapabilities =+  RegularExpressionsClientCapabilities+    { _engine :: Text+    , _version :: Maybe Text+    } deriving (Show, Read, Eq)++deriveJSON lspOptions ''RegularExpressionsClientCapabilities++-- | General client capabilities.+-- @since 3.16.0+data GeneralClientCapabilities =+  GeneralClientCapabilities+    {+      _staleRequestSupport :: Maybe StaleRequestClientCapabilities+      -- | Client capabilities specific to regular expressions.+      -- @since 3.16.0+    , _regularExpressions :: Maybe RegularExpressionsClientCapabilities+      -- | Client capabilities specific to the client's markdown parser.+      -- @since 3.16.0+    , _markdown :: Maybe MarkdownClientCapabilities+    } deriving (Show, Read, Eq)++deriveJSON lspOptions ''GeneralClientCapabilities++instance Default GeneralClientCapabilities where+  def = GeneralClientCapabilities def def def++-- ---------------------------------------------------------------------+ data ClientCapabilities =   ClientCapabilities-    { _workspace    :: Maybe WorkspaceClientCapabilities+    { -- | Workspace specific client capabilities+      _workspace    :: Maybe WorkspaceClientCapabilities+      -- | Text document specific client capabilities     , _textDocument :: Maybe TextDocumentClientCapabilities-    -- | Capabilities specific to `window/progress` requests. Experimental.-    ---    -- @since 0.10.0.0+      -- | Window specific client capabilities.     , _window :: Maybe WindowClientCapabilities+      -- | General client capabilities.+      -- @since 3.16.0+    , _general :: Maybe GeneralClientCapabilities+      -- | Experimental client capabilities.     , _experimental :: Maybe A.Object     } deriving (Show, Read, Eq)  deriveJSON lspOptions ''ClientCapabilities  instance Default ClientCapabilities where-  def = ClientCapabilities def def def def+  def = ClientCapabilities def def def def def

@@ -6,7 +6,9 @@ import           Data.Aeson.TH import           Data.Aeson.Types import           Data.Default+import           Data.String import           Data.Text                      ( Text )+import qualified Data.Text as T import           Language.LSP.Types.Command import           Language.LSP.Types.Diagnostic import           Language.LSP.Types.Common@@ -62,29 +64,57 @@   | CodeActionUnknown Text   deriving (Read, Show, Eq) +fromHierarchicalString :: Text -> CodeActionKind+fromHierarchicalString t = case t of+  ""                       -> CodeActionEmpty+  "quickfix"               -> CodeActionQuickFix+  "refactor"               -> CodeActionRefactor+  "refactor.extract"       -> CodeActionRefactorExtract+  "refactor.inline"        -> CodeActionRefactorInline+  "refactor.rewrite"       -> CodeActionRefactorRewrite+  "source"                 -> CodeActionSource+  "source.organizeImports" -> CodeActionSourceOrganizeImports+  s                        -> CodeActionUnknown s++toHierarchicalString :: CodeActionKind -> Text+toHierarchicalString k = case k of+  CodeActionEmpty                 -> ""+  CodeActionQuickFix              -> "quickfix"+  CodeActionRefactor              -> "refactor"+  CodeActionRefactorExtract       -> "refactor.extract"+  CodeActionRefactorInline        -> "refactor.inline"+  CodeActionRefactorRewrite       -> "refactor.rewrite"+  CodeActionSource                -> "source"+  CodeActionSourceOrganizeImports -> "source.organizeImports"+  (CodeActionUnknown s)           -> s++instance IsString CodeActionKind where+  fromString = fromHierarchicalString . T.pack+ instance ToJSON CodeActionKind where-  toJSON CodeActionEmpty                      = String ""-  toJSON CodeActionQuickFix                   = String "quickfix"-  toJSON CodeActionRefactor                   = String "refactor"-  toJSON CodeActionRefactorExtract            = String "refactor.extract"-  toJSON CodeActionRefactorInline             = String "refactor.inline"-  toJSON CodeActionRefactorRewrite            = String "refactor.rewrite"-  toJSON CodeActionSource                     = String "source"-  toJSON CodeActionSourceOrganizeImports      = String "source.organizeImports"-  toJSON (CodeActionUnknown s)                = String s+  toJSON = String . toHierarchicalString  instance FromJSON CodeActionKind where-  parseJSON (String "")                       = pure CodeActionEmpty-  parseJSON (String "quickfix")               = pure CodeActionQuickFix-  parseJSON (String "refactor")               = pure CodeActionRefactor-  parseJSON (String "refactor.extract")       = pure CodeActionRefactorExtract-  parseJSON (String "refactor.inline")        = pure CodeActionRefactorInline-  parseJSON (String "refactor.rewrite")       = pure CodeActionRefactorRewrite-  parseJSON (String "source")                 = pure CodeActionSource-  parseJSON (String "source.organizeImports") = pure CodeActionSourceOrganizeImports-  parseJSON (String s)                        = pure (CodeActionUnknown s)-  parseJSON _                                 = fail "CodeActionKind"-  +  parseJSON (String s) = pure $ fromHierarchicalString s+  parseJSON _          = fail "CodeActionKind"++-- | Does the first 'CodeActionKind' subsume the other one, hierarchically. Reflexive.+codeActionKindSubsumes :: CodeActionKind -> CodeActionKind -> Bool+-- Simple but ugly implementation: prefix on the string representation+codeActionKindSubsumes parent child = toHierarchicalString parent `T.isPrefixOf` toHierarchicalString child++-- | The 'CodeActionKind's listed in the LSP spec specifically.+specCodeActionKinds :: [CodeActionKind]+specCodeActionKinds = [+  CodeActionQuickFix+  , CodeActionRefactor+  , CodeActionRefactorExtract+  , CodeActionRefactorInline+  , CodeActionRefactorRewrite+  , CodeActionSource+  , CodeActionSourceOrganizeImports+  ]+ -- -------------------------------------  data CodeActionKindClientCapabilities =@@ -99,15 +129,7 @@ deriveJSON lspOptions ''CodeActionKindClientCapabilities  instance Default CodeActionKindClientCapabilities where-  def = CodeActionKindClientCapabilities (List allKinds)-    where allKinds = [ CodeActionQuickFix-                     , CodeActionRefactor-                     , CodeActionRefactorExtract-                     , CodeActionRefactorInline-                     , CodeActionRefactorRewrite-                     , CodeActionSource-                     , CodeActionSourceOrganizeImports-                     ]+  def = CodeActionKindClientCapabilities (List specCodeActionKinds)  data CodeActionLiteralSupport =   CodeActionLiteralSupport

@@ -1,17 +1,57 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE DeriveAnyClass             #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DerivingStrategies         #-} {-# LANGUAGE TypeOperators              #-}  -- | Common types that aren't in the specification-module Language.LSP.Types.Common where+module Language.LSP.Types.Common (+    type (|?) (..)+  , toEither+  , List (..)+  , Empty (..)+  , Int32+  , UInt ) where  import Control.Applicative import Control.DeepSeq import Data.Aeson-import qualified Data.HashMap.Strict as HashMap-import GHC.Generics+import Data.Int (Int32)+import Data.Mod.Word+import Text.Read (Read(readPrec))+import GHC.Generics hiding (UInt)+import GHC.TypeNats hiding (Mod)+import Data.Bifunctor (bimap) +-- | The "uinteger" type in the LSP spec.+--+-- Unusually, this is a **31**-bit unsigned integer, not a 32-bit one.+newtype UInt = UInt (Mod (2^31))+  deriving newtype (Num, Bounded, Enum, Eq, Ord)+  deriving stock (Generic)+  deriving anyclass (NFData)++instance Show UInt where+  show (UInt u) = show $ unMod u++instance Read UInt where+  readPrec = fromInteger <$> readPrec++instance Real UInt where+  toRational (UInt u) = toRational $ unMod u++instance Integral UInt where+  quotRem (UInt x) (UInt y) = bimap fromIntegral fromIntegral $ quotRem (unMod x) (unMod y)+  toInteger (UInt u) = toInteger $ unMod u++instance ToJSON UInt where+  toJSON u = toJSON (toInteger u)++instance FromJSON UInt where+  parseJSON v = fromInteger <$> parseJSON v+ -- | A terser, isomorphic data type for 'Either', that does not get tagged when -- converting to and from JSON. data a |? b = InL a@@ -39,7 +79,8 @@ -- In particular this is necessary to change the 'FromJSON' instance to be compatible -- with Elisp (where empty lists show up as 'null') newtype List a = List [a]-                deriving (Show,Read,Eq,Ord,Semigroup,Monoid,Functor,Foldable,Traversable,Generic)+    deriving stock (Traversable,Generic)+    deriving newtype (Show,Read,Eq,Ord,Semigroup,Monoid,Functor,Foldable)  instance NFData a => NFData (List a) @@ -55,5 +96,5 @@   toJSON Empty = Null instance FromJSON Empty where   parseJSON Null = pure Empty-  parseJSON (Object o) | HashMap.null o = pure Empty+  parseJSON (Object o) | o == mempty = pure Empty   parseJSON _ = fail "expected 'null' or '{}'"

@@ -9,7 +9,7 @@ import qualified Data.Aeson                                 as A import           Data.Aeson.TH import           Data.Text-import           GHC.Generics+import           GHC.Generics hiding (UInt) import           Language.LSP.Types.Common import           Language.LSP.Types.Location import           Language.LSP.Types.Uri@@ -82,7 +82,7 @@   Diagnostic     { _range              :: Range     , _severity           :: Maybe DiagnosticSeverity-    , _code               :: Maybe (Int |? Text)+    , _code               :: Maybe (Int32 |? Text)     , _source             :: Maybe DiagnosticSource     , _message            :: Text     , _tags               :: Maybe (List DiagnosticTag)@@ -131,7 +131,7 @@       -- published for.       --        -- Since LSP 3.15.0-    , _version     :: Maybe Int+    , _version     :: Maybe UInt       -- | An array of diagnostic information items.     , _diagnostics :: List Diagnostic     } deriving (Read,Show,Eq)

@@ -45,10 +45,10 @@ -- | Represents a color in RGBA space. data Color =   Color-    { _red   :: Int -- ^ The red component of this color in the range [0-1].-    , _green :: Int -- ^ The green component of this color in the range [0-1].-    , _blue  :: Int -- ^ The blue component of this color in the range [0-1].-    , _alpha :: Int -- ^ The alpha component of this color in the range [0-1].+    { _red   :: Float -- ^ The red component of this color in the range [0-1].+    , _green :: Float -- ^ The green component of this color in the range [0-1].+    , _blue  :: Float -- ^ The blue component of this color in the range [0-1].+    , _alpha :: Float -- ^ The alpha component of this color in the range [0-1].     } deriving (Read, Show, Eq) deriveJSON lspOptions ''Color 

@@ -6,6 +6,7 @@ import qualified Data.Aeson                    as A import           Data.Aeson.TH import           Data.Text                    (Text)+import           Language.LSP.Types.Common import           Language.LSP.Types.Progress import           Language.LSP.Types.StaticRegistrationOptions import           Language.LSP.Types.TextDocument@@ -23,7 +24,7 @@       _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 Int+    , _rangeLimit          :: Maybe UInt       -- | If set, the client signals that it only supports folding complete lines. If set,       -- client will ignore specified `startCharacter` and `endCharacter` properties in a       -- FoldingRange.@@ -79,15 +80,15 @@ data FoldingRange =   FoldingRange   { -- | The zero-based line number from where the folded range starts.-    _startLine      :: Int+    _startLine      :: UInt     -- | The zero-based character offset from where the folded range     -- starts. If not defined, defaults to the length of the start line.-  , _startCharacter :: Maybe Int+  , _startCharacter :: Maybe UInt     -- | The zero-based line number where the folded range ends.-  , _endLine        :: Int+  , _endLine        :: UInt     -- | The zero-based character offset before the folded range ends.     -- If not defined, defaults to the length of the end line.-  , _endCharacter   :: Maybe Int+  , _endCharacter   :: Maybe UInt     -- | Describes the kind of the folding range such as 'comment' or     -- 'region'. The kind is used to categorize folding ranges and used     -- by commands like 'Fold all comments'. See 'FoldingRangeKind' for

@@ -4,6 +4,7 @@  import Data.Aeson.TH import Data.Text (Text)+import Language.LSP.Types.Common import Language.LSP.Types.Location import Language.LSP.Types.Progress import Language.LSP.Types.TextDocument@@ -29,7 +30,7 @@ -- | Value-object describing what options formatting should use. data FormattingOptions = FormattingOptions   { -- | Size of a tab in spaces.-    _tabSize :: Int,+    _tabSize :: UInt,     -- | Prefer spaces over tabs     _insertSpaces :: Bool,     -- | Trim trailing whitespace on a line.

@@ -41,7 +41,7 @@ deriveJSON lspOptions ''ClientInfo  makeExtendingDatatype "InitializeParams" [''WorkDoneProgressParams]-  [ ("_processId",             [t| Maybe Int|])+  [ ("_processId",             [t| Maybe Int32|])   , ("_clientInfo",            [t| Maybe ClientInfo |])   , ("_rootPath",              [t| Maybe Text |])   , ("_rootUri",               [t| Maybe Uri  |])

@@ -9,6 +9,7 @@ {-# LANGUAGE FlexibleContexts       #-} {-# LANGUAGE DataKinds              #-} {-# LANGUAGE TypeInType             #-}+{-# LANGUAGE ExplicitNamespaces #-}  module Language.LSP.Types.Lens where @@ -19,6 +20,7 @@ import           Language.LSP.Types.CodeLens import           Language.LSP.Types.DocumentColor import           Language.LSP.Types.Command+import           Language.LSP.Types.Common (type (|?)) import           Language.LSP.Types.Completion import           Language.LSP.Types.Configuration import           Language.LSP.Types.Declaration@@ -57,6 +59,12 @@ -- TODO: This is out of date and very unmantainable, use TH to call all these!!  -- client capabilities+makeFieldsNoPrefix ''MessageActionItemClientCapabilities+makeFieldsNoPrefix ''ShowMessageRequestClientCapabilities+makeFieldsNoPrefix ''ShowDocumentClientCapabilities+makeFieldsNoPrefix ''StaleRequestClientCapabilities+makeFieldsNoPrefix ''RegularExpressionsClientCapabilities+makeFieldsNoPrefix ''GeneralClientCapabilities makeFieldsNoPrefix ''WorkspaceClientCapabilities makeFieldsNoPrefix ''WindowClientCapabilities makeFieldsNoPrefix ''ClientCapabilities@@ -115,6 +123,7 @@  -- Markup makeFieldsNoPrefix ''MarkupContent+makeFieldsNoPrefix ''MarkdownClientCapabilities  -- Completion makeFieldsNoPrefix ''CompletionDoc@@ -335,6 +344,8 @@ makeFieldsNoPrefix ''ShowMessageParams makeFieldsNoPrefix ''MessageActionItem makeFieldsNoPrefix ''ShowMessageRequestParams+makeFieldsNoPrefix ''ShowDocumentParams+makeFieldsNoPrefix ''ShowDocumentResult makeFieldsNoPrefix ''LogMessageParams makeFieldsNoPrefix ''ProgressParams makeFieldsNoPrefix ''WorkDoneProgressBeginParams@@ -382,3 +393,6 @@ makeFieldsNoPrefix ''SemanticTokensDelta makeFieldsNoPrefix ''SemanticTokensDeltaPartialResult makeFieldsNoPrefix ''SemanticTokensWorkspaceClientCapabilities++-- Unions+makePrisms ''(|?)

@@ -4,7 +4,8 @@  import           Control.DeepSeq import           Data.Aeson.TH-import           GHC.Generics+import           GHC.Generics hiding (UInt)+import           Language.LSP.Types.Common import           Language.LSP.Types.Uri import           Language.LSP.Types.Utils @@ -13,11 +14,11 @@ data Position =   Position     { -- | Line position in a document (zero-based).-      _line      :: Int+      _line      :: UInt       -- | Character offset on a line in a document (zero-based). Assuming that       -- the line is represented as a string, the @character@ value represents the       -- gap between the @character@ and @character + 1@.-    , _character :: Int+    , _character :: UInt     } deriving (Show, Read, Eq, Ord, Generic)  instance NFData Position@@ -72,5 +73,5 @@  -- | A helper function for creating ranges. -- prop> mkRange l c l' c' = Range (Position l c) (Position l' c')-mkRange :: Int -> Int -> Int -> Int -> Range+mkRange :: UInt -> UInt -> UInt -> UInt -> Range mkRange l c l' c' = Range (Position l c) (Position l' c')

@@ -8,11 +8,13 @@  import qualified Data.Aeson                                 as A import           Data.Text                                  (Text)+import           Data.Int (Int32) import           Data.IxMap-import Language.LSP.Types.Method +import           Language.LSP.Types.Method+ -- | Id used for a request, Can be either a String or an Int-data LspId (m :: Method f Request) = IdInt !Int | IdString !Text+data LspId (m :: Method f Request) = IdInt !Int32 | IdString !Text   deriving (Show,Read,Eq,Ord)  instance A.ToJSON (LspId m) where

@@ -12,6 +12,7 @@ import           Data.Aeson import           Data.Aeson.TH import           Data.Text                                      (Text)+import qualified Data.Text as T import           Language.LSP.Types.Utils  -- |  Describes the content type that a client supports in various@@ -81,13 +82,30 @@  -- --------------------------------------------------------------------- +-- | Given some plaintext, convert it into some equivalent markdown text.+-- This is not *quite* the identity function.+plainTextToMarkdown :: Text -> Text+-- Line breaks in markdown paragraphs are ignored unless the line ends with two spaces.+-- In order to respect the line breaks in the original plaintext, we stick two spaces on the end of every line.+plainTextToMarkdown = T.unlines . fmap (<> "  ") . T.lines+ instance Semigroup MarkupContent where   MarkupContent MkPlainText s1 <> MarkupContent MkPlainText s2 = MarkupContent MkPlainText (s1 `mappend` s2)-  MarkupContent MkMarkdown  s1 <> MarkupContent _           s2 = MarkupContent MkMarkdown  (s1 `mappend` s2)-  MarkupContent _           s1 <> MarkupContent MkMarkdown  s2 = MarkupContent MkMarkdown  (s1 `mappend` s2)+  MarkupContent MkMarkdown s1 <> MarkupContent MkMarkdown s2 = MarkupContent MkMarkdown  (s1 `mappend` s2)+  MarkupContent MkPlainText s1 <> MarkupContent MkMarkdown s2 = MarkupContent MkMarkdown  (plainTextToMarkdown s1 `mappend` s2)+  MarkupContent MkMarkdown s1 <> MarkupContent MkPlainText s2 = MarkupContent MkMarkdown  (s1 `mappend` plainTextToMarkdown s2)  instance Monoid MarkupContent where   mempty = MarkupContent MkPlainText ""  -- --------------------------------------------------------------------- +-- | Client capabilities specific to the used markdown parser.+-- @since 3.16.0+data MarkdownClientCapabilities =+  MarkdownClientCapabilities+    { _parser :: Text+    , _version :: Maybe Text+    } deriving (Show, Read, Eq)++deriveJSON lspOptions ''MarkdownClientCapabilities

@@ -55,12 +55,12 @@ import           Language.LSP.Types.WorkspaceEdit import           Language.LSP.Types.WorkspaceFolders import           Language.LSP.Types.WorkspaceSymbol-import qualified Data.HashMap.Strict as HM  import Data.Kind import Data.Aeson import Data.Aeson.TH import Data.Text (Text)+import Data.String import GHC.Generics  -- ---------------------------------------------------------------------@@ -136,6 +136,7 @@   -- Window   MessageParams WindowShowMessage                  = ShowMessageParams   MessageParams WindowShowMessageRequest           = ShowMessageRequestParams+  MessageParams WindowShowDocument                 = ShowDocumentParams   MessageParams WindowLogMessage                   = LogMessageParams   -- Progress   MessageParams WindowWorkDoneProgressCreate       = WorkDoneProgressCreateParams@@ -219,6 +220,7 @@ -- Server   -- Window   ResponseResult WindowShowMessageRequest      = Maybe MessageActionItem+  ResponseResult WindowShowDocument            = ShowDocumentResult   ResponseResult WindowWorkDoneProgressCreate  = Empty   -- Capability   ResponseResult ClientRegisterCapability      = Empty@@ -274,8 +276,8 @@ -- | Replace a missing field in an object with a null field, to simplify parsing -- This is a hack to allow other types than Maybe to work like Maybe in allowing the field to be missing. -- See also this issue: https://github.com/haskell/aeson/issues/646-addNullField :: Text -> Value -> Value-addNullField s (Object o) = Object $ HM.insertWith (\_new old -> old) s Null o+addNullField :: String -> Value -> Value+addNullField s (Object o) = Object $ o <> fromString s .= Null addNullField _ v = v  instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (RequestMessage m) where

@@ -2,6 +2,7 @@ {-# LANGUAGE TemplateHaskell            #-} {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE GADTs                      #-}+{-# LANGUAGE MagicHash                  #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE TypeInType                 #-} {-# LANGUAGE FlexibleInstances          #-}@@ -16,7 +17,10 @@ import           Language.LSP.Types.Utils import           Data.Function (on) import Control.Applicative-import Data.GADT.Compare.TH+import Data.GADT.Compare+import Data.Type.Equality+import GHC.Exts (Int(..), dataToTag#)+import Unsafe.Coerce  -- --------------------------------------------------------------------- @@ -90,6 +94,7 @@   -- Window   WindowShowMessage                  :: Method FromServer Notification   WindowShowMessageRequest           :: Method FromServer Request+  WindowShowDocument                 :: Method FromServer Request   WindowLogMessage                   :: Method FromServer Notification   WindowWorkDoneProgressCancel       :: Method FromClient Notification   WindowWorkDoneProgressCreate       :: Method FromServer Request@@ -167,6 +172,7 @@    SWindowShowMessage                  :: SMethod WindowShowMessage   SWindowShowMessageRequest           :: SMethod WindowShowMessageRequest+  SWindowShowDocument                 :: SMethod WindowShowDocument   SWindowLogMessage                   :: SMethod WindowLogMessage   SWindowWorkDoneProgressCreate       :: SMethod WindowWorkDoneProgressCreate   SWindowWorkDoneProgressCancel       :: SMethod WindowWorkDoneProgressCancel@@ -182,11 +188,38 @@   SCancelRequest                      :: SMethod CancelRequest   SCustomMethod                       :: Text -> SMethod CustomMethod -deriveGEq ''SMethod-deriveGCompare ''SMethod+-- This instance is written manually rather than derived to avoid a dependency+-- on 'dependent-sum-template'.+instance GEq SMethod where+  geq x y = case gcompare x y of+    GLT -> Nothing+    GEQ -> Just Refl+    GGT -> Nothing -deriving instance Eq   (SMethod m)-deriving instance Ord  (SMethod m)+-- This instance is written manually rather than derived to avoid a dependency+-- on 'dependent-sum-template'.+instance GCompare SMethod where+  gcompare (SCustomMethod x) (SCustomMethod y) = case x `compare` y of+    LT -> GLT+    EQ -> GEQ+    GT -> GGT+  -- This is much more compact than matching on every pair of constructors, which+  -- is what we would need to do for GHC to 'see' that this is correct. Nonetheless+  -- it is safe: since there is only one constructor of 'SMethod' for each 'Method',+  -- the argument types can only be equal if the constructor tag is equal.+  gcompare x y = case I# (dataToTag# x) `compare` I# (dataToTag# y) of+    LT -> GLT+    EQ -> unsafeCoerce GEQ+    GT -> GGT++instance Eq (SMethod m) where+  -- This defers to 'GEq', ensuring that this version is compatible.+  (==) = defaultEq++instance Ord (SMethod m) where+  -- This defers to 'GCompare', ensuring that this version is compatible.+  compare = defaultCompare+ deriving instance Show (SMethod m)  -- Some useful type synonyms@@ -307,6 +340,7 @@   -- Window   parseJSON (A.String "window/showMessage")                  = pure $ SomeServerMethod SWindowShowMessage   parseJSON (A.String "window/showMessageRequest")           = pure $ SomeServerMethod SWindowShowMessageRequest+  parseJSON (A.String "window/showDocument")                 = pure $ SomeServerMethod SWindowShowDocument   parseJSON (A.String "window/logMessage")                   = pure $ SomeServerMethod SWindowLogMessage   parseJSON (A.String "window/workDoneProgress/create")      = pure $ SomeServerMethod SWindowWorkDoneProgressCreate   parseJSON (A.String "$/progress")                          = pure $ SomeServerMethod SProgress@@ -400,6 +434,7 @@   -- Window   toJSON SWindowShowMessage                  = A.String "window/showMessage"   toJSON SWindowShowMessageRequest           = A.String "window/showMessageRequest"+  toJSON SWindowShowDocument                 = A.String "window/showDocument"   toJSON SWindowLogMessage                   = A.String "window/logMessage"   toJSON SWindowWorkDoneProgressCreate       = A.String "window/workDoneProgress/create"   toJSON SProgress                           = A.String "$/progress"

@@ -14,13 +14,13 @@ {-# LANGUAGE TupleSections              #-} {-# LANGUAGE TypeApplications           #-} {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Language.LSP.Types.Parsing where  import           Language.LSP.Types.LspId import           Language.LSP.Types.Method import           Language.LSP.Types.Message-import qualified Data.HashMap.Strict as HM  import Data.Aeson import Data.Aeson.Types@@ -90,25 +90,26 @@ {-# INLINE parseServerMessage #-} parseServerMessage :: LookupFunc FromClient a -> Value -> Parser (FromServerMessage' a) parseServerMessage lookupId v@(Object o) = do-  case HM.lookup "method" o of-    Just cmd -> do-      -- Request or Notification-      SomeServerMethod m <- parseJSON cmd+  methMaybe <- o .:! "method"+  idMaybe <- o .:! "id"+  case methMaybe of+    -- Request or Notification+    Just (SomeServerMethod m) ->       case splitServerMethod m of         IsServerNot -> FromServerMess m <$> parseJSON v         IsServerReq -> FromServerMess m <$> parseJSON v-        IsServerEither-          | HM.member "id" o -- Request-          , SCustomMethod cm <- m ->+        IsServerEither | SCustomMethod cm <- m -> do+          case idMaybe of+            -- Request+            Just _ ->               let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromServer Request))-                  in FromServerMess m' <$> parseJSON v-          | SCustomMethod cm <- m ->+              in FromServerMess m' <$> parseJSON v+            Nothing ->               let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromServer Notification))-                  in FromServerMess m' <$> parseJSON v+              in FromServerMess m' <$> parseJSON v     Nothing -> do-      case HM.lookup "id" o of-        Just i' -> do-          i <- parseJSON i'+      case idMaybe of+        Just i -> do           case lookupId i of             Just (m,res) -> clientResponseJSON m $ FromServerRsp res <$> parseJSON v             Nothing -> fail $ unwords ["Failed in looking up response type of", show v]@@ -118,25 +119,26 @@ {-# INLINE parseClientMessage #-} parseClientMessage :: LookupFunc FromServer a -> Value -> Parser (FromClientMessage' a) parseClientMessage lookupId v@(Object o) = do-  case HM.lookup "method" o of-    Just cmd -> do-      -- Request or Notification-      SomeClientMethod m <- parseJSON cmd+  methMaybe <- o .:! "method"+  idMaybe <- o .:! "id"+  case methMaybe of+    -- Request or Notification+    Just (SomeClientMethod m) ->       case splitClientMethod m of         IsClientNot -> FromClientMess m <$> parseJSON v         IsClientReq -> FromClientMess m <$> parseJSON v-        IsClientEither-          | HM.member "id" o -- Request-          , SCustomMethod cm <- m ->+        IsClientEither | SCustomMethod cm <- m -> do+          case idMaybe of+            -- Request+            Just _ ->               let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromClient Request))-                  in FromClientMess m' <$> parseJSON v-          | SCustomMethod cm <- m ->+              in FromClientMess m' <$> parseJSON v+            Nothing ->               let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromClient Notification))-                  in FromClientMess m' <$> parseJSON v+              in FromClientMess m' <$> parseJSON v     Nothing -> do-      case HM.lookup "id" o of-        Just i' -> do-          i <- parseJSON i'+      case idMaybe of+        Just i -> do           case lookupId i of             Just (m,res) -> serverResponseJSON m $ FromClientRsp res <$> parseJSON v             Nothing -> fail $ unwords ["Failed in looking up response type of", show v]@@ -265,6 +267,7 @@ splitServerMethod :: SServerMethod m -> ServerNotOrReq m splitServerMethod SWindowShowMessage = IsServerNot splitServerMethod SWindowShowMessageRequest = IsServerReq+splitServerMethod SWindowShowDocument = IsServerReq splitServerMethod SWindowLogMessage = IsServerNot splitServerMethod SWindowWorkDoneProgressCreate = IsServerReq splitServerMethod SProgress = IsServerNot

@@ -11,13 +11,14 @@ import           Data.Aeson.TH import           Data.Maybe (catMaybes) import           Data.Text (Text)+import           Language.LSP.Types.Common import           Language.LSP.Types.Utils  -- | A token used to report progress back or return partial results for a -- specific request. -- @since 0.17.0.0 data ProgressToken-    = ProgressNumericToken Int+    = ProgressNumericToken Int32     | ProgressTextToken Text     deriving (Show, Read, Eq, Ord) @@ -58,7 +59,7 @@   --   -- The value should be steadily rising. Clients are free to ignore values   -- that are not following this rule.-  , _percentage :: Maybe Double+  , _percentage :: Maybe UInt   } deriving (Show, Read, Eq)  instance A.ToJSON WorkDoneProgressBeginParams where@@ -103,7 +104,7 @@   -- If infinite progress was indicated in the start notification client   -- are allowed to ignore the value. In addition the value should be steadily   -- rising. Clients are free to ignore values that are not following this rule.-  , _percentage :: Maybe Double+  , _percentage :: Maybe UInt   } deriving (Show, Read, Eq)  instance A.ToJSON WorkDoneProgressReportParams where

@@ -0,0 +1,71 @@+{-# LANGUAGE DataKinds  #-}+{-# LANGUAGE GADTs      #-}+{-# LANGUAGE MagicHash  #-}+{-# LANGUAGE PolyKinds  #-}+{-# LANGUAGE RankNTypes #-}++module Language.LSP.Types.SMethodMap+  ( SMethodMap+  , singleton+  , insert+  , delete+  , member+  , lookup+  , map+  ) where++import Prelude hiding (lookup, map)+import Data.IntMap (IntMap)+import qualified Data.IntMap.Strict as IntMap+import Data.Kind (Type)+import Data.Map (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import GHC.Exts (Int(..), dataToTag#, Any)+import Unsafe.Coerce (unsafeCoerce)++import Language.LSP.Types.Method (Method(..), SMethod(..))++-- This type exists to avoid a dependency on 'dependent-map'. It is less+-- safe (since we use 'unsafeCoerce') but much simpler and hence easier to include.+-- | A specialized altenative to a full dependent map for use with 'SMethod'.+data SMethodMap (v :: Method f t -> Type) =+  -- This works by using an 'IntMap' indexed by constructor tag for the majority+  -- of 'SMethod's, which have no parameters, and hence can only appear once as keys+  -- in the map. We do not attempt to be truly dependent here, and instead exploit+  -- 'usafeCoerce' to go to and from 'v Any'.+  -- The sole exception is 'SCustomMethod', for which we keep a separate map from+  -- its 'Text' parameter (and where we can get the type indices right).+  SMethodMap !(IntMap (v Any)) !(Map Text (v 'CustomMethod))++toIx :: SMethod a -> Int+toIx k = I# (dataToTag# k)++singleton :: SMethod a -> v a -> SMethodMap v+singleton (SCustomMethod t) v = SMethodMap mempty (Map.singleton t v)+singleton k v = SMethodMap (IntMap.singleton (toIx k) (unsafeCoerce v)) mempty++insert :: SMethod a -> v a -> SMethodMap v -> SMethodMap v+insert (SCustomMethod t) v (SMethodMap xs ys) = SMethodMap xs (Map.insert t v ys)+insert k v (SMethodMap xs ys) = SMethodMap (IntMap.insert (toIx k) (unsafeCoerce v) xs) ys++delete :: SMethod a -> SMethodMap v -> SMethodMap v+delete (SCustomMethod t) (SMethodMap xs ys) = SMethodMap xs (Map.delete t ys)+delete k (SMethodMap xs ys) = SMethodMap (IntMap.delete (toIx k) xs) ys++member :: SMethod a -> SMethodMap v -> Bool+member (SCustomMethod t) (SMethodMap _ ys) = Map.member t ys+member k (SMethodMap xs _) = IntMap.member (toIx k) xs++lookup :: SMethod a -> SMethodMap v -> Maybe (v a)+lookup (SCustomMethod t) (SMethodMap _ ys) = Map.lookup t ys+lookup k (SMethodMap xs _) = unsafeCoerce (IntMap.lookup (toIx k) xs)++map :: (forall a. u a -> v a) -> SMethodMap u -> SMethodMap v+map f (SMethodMap xs ys) = SMethodMap (IntMap.map f xs) (Map.map f ys)++instance Semigroup (SMethodMap v) where+  SMethodMap xs ys <> SMethodMap xs' ys' = SMethodMap (xs <> xs') (ys <> ys')++instance Monoid (SMethodMap v) where+  mempty = SMethodMap mempty mempty

@@ -292,12 +292,12 @@   _resultId :: Maybe Text,    -- | The actual tokens.-  _xdata    :: List Int+  _xdata    :: List UInt } deriving (Show, Read, Eq) deriveJSON lspOptions ''SemanticTokens  data SemanticTokensPartialResult = SemanticTokensPartialResult {-  _xdata :: List Int+  _xdata :: List UInt } deriveJSON lspOptions ''SemanticTokensPartialResult @@ -311,11 +311,11 @@  data SemanticTokensEdit = SemanticTokensEdit {   -- | The start offset of the edit.-  _start       :: Int,+  _start       :: UInt,   -- | The count of elements to remove.-  _deleteCount :: Int,+  _deleteCount :: UInt,   -- | The elements to insert.-  _xdata       :: Maybe (List Int)+  _xdata       :: Maybe (List UInt) } deriving (Show, Read, Eq) deriveJSON lspOptions ''SemanticTokensEdit @@ -359,9 +359,9 @@ -- | A single 'semantic token' as described in the LSP specification, using absolute positions. -- This is the kind of token that is usually easiest for editors to produce. data SemanticTokenAbsolute = SemanticTokenAbsolute {-  line           :: Int,-  startChar      :: Int,-  length         :: Int,+  line           :: UInt,+  startChar      :: UInt,+  length         :: UInt,   tokenType      :: SemanticTokenTypes,   tokenModifiers :: [SemanticTokenModifiers] } deriving (Show, Read, Eq, Ord)@@ -370,9 +370,9 @@  -- | A single 'semantic token' as described in the LSP specification, using relative positions. data SemanticTokenRelative = SemanticTokenRelative {-  deltaLine      :: Int,-  deltaStartChar :: Int,-  length         :: Int,+  deltaLine      :: UInt,+  deltaStartChar :: UInt,+  length         :: UInt,   tokenType      :: SemanticTokenTypes,   tokenModifiers :: [SemanticTokenModifiers] } deriving (Show, Read, Eq, Ord)@@ -385,7 +385,7 @@ relativizeTokens xs = DList.toList $ go 0 0 xs mempty   where     -- Pass an accumulator to make this tail-recursive-    go :: Int -> Int -> [SemanticTokenAbsolute] -> DList.DList SemanticTokenRelative -> DList.DList SemanticTokenRelative+    go :: UInt -> UInt -> [SemanticTokenAbsolute] -> DList.DList SemanticTokenRelative -> DList.DList SemanticTokenRelative     go _ _ [] acc = acc     go lastLine lastChar (SemanticTokenAbsolute l c len ty mods:ts) acc =       let@@ -400,7 +400,7 @@ absolutizeTokens xs = DList.toList $ go 0 0 xs mempty   where     -- Pass an accumulator to make this tail-recursive-    go :: Int -> Int -> [SemanticTokenRelative] -> DList.DList SemanticTokenAbsolute -> DList.DList SemanticTokenAbsolute+    go :: UInt -> UInt -> [SemanticTokenRelative] -> DList.DList SemanticTokenAbsolute -> DList.DList SemanticTokenAbsolute     go _ _ [] acc = acc     go lastLine lastChar (SemanticTokenRelative dl dc len ty mods:ts) acc =       let@@ -410,18 +410,18 @@       in go l c ts (DList.snoc acc (SemanticTokenAbsolute l c len ty mods))  -- | Encode a series of relatively-positioned semantic tokens into an integer array following the given legend.-encodeTokens :: SemanticTokensLegend -> [SemanticTokenRelative] -> Either Text [Int]+encodeTokens :: SemanticTokensLegend -> [SemanticTokenRelative] -> Either Text [UInt] encodeTokens SemanticTokensLegend{_tokenTypes=List tts,_tokenModifiers=List tms} sts =   DList.toList . DList.concat <$> traverse encodeToken sts   where     -- Note that there's no "fast" version of these (e.g. backed by an IntMap or similar)     -- in general, due to the possibility  of unknown token types which are only identified by strings.-    tyMap :: Map.Map SemanticTokenTypes Int+    tyMap :: Map.Map SemanticTokenTypes UInt     tyMap = Map.fromList $ zip tts [0..]     modMap :: Map.Map SemanticTokenModifiers Int     modMap = Map.fromList $ zip tms [0..] -    lookupTy :: SemanticTokenTypes -> Either Text Int+    lookupTy :: SemanticTokenTypes -> Either Text UInt     lookupTy ty = case Map.lookup ty tyMap of         Just tycode -> pure tycode         Nothing -> throwError $ "Semantic token type " <> fromString (show ty) <> " did not appear in the legend"@@ -431,17 +431,17 @@         Nothing -> throwError $ "Semantic token modifier " <> fromString (show modifier) <> " did not appear in the legend"      -- Use a DList here for better efficiency when concatenating all these together-    encodeToken :: SemanticTokenRelative -> Either Text (DList.DList Int)+    encodeToken :: SemanticTokenRelative -> Either Text (DList.DList UInt)     encodeToken (SemanticTokenRelative dl dc len ty mods) = do       tycode <- lookupTy ty       modcodes <- traverse lookupMod mods-      let combinedModcode = foldl' Bits.setBit Bits.zeroBits modcodes+      let combinedModcode :: Int = foldl' Bits.setBit Bits.zeroBits modcodes -      pure [dl, dc, len, tycode, combinedModcode ]+      pure [dl, dc, len, tycode, fromIntegral combinedModcode ]  -- This is basically 'SemanticTokensEdit', but slightly easier to work with. -- | An edit to a buffer of items. -data Edit a = Edit { editStart :: Int, editDeleteCount :: Int, editInsertions :: [a] }+data Edit a = Edit { editStart :: UInt, editDeleteCount :: UInt, editInsertions :: [a] }   deriving (Read, Show, Eq, Ord)  -- | Compute a list of edits that will turn the first list into the second list.@@ -455,7 +455,7 @@     dump the 'Edit' into the accumulator.     We need the index, because 'Edit's need to say where they start.     -}-    go :: Int -> Maybe (Edit a) -> [Diff.Diff [a]] -> DList.DList (Edit a) -> DList.DList (Edit a)+    go :: UInt -> Maybe (Edit a) -> [Diff.Diff [a]] -> DList.DList (Edit a) -> DList.DList (Edit a)     -- No more diffs: append the current edit if there is one and return     go _ e [] acc = acc <> DList.fromList (maybeToList e) @@ -463,7 +463,7 @@     -- starting a new edit if necessary.     go ix e (Diff.First ds : rest) acc =       let-        deleteCount = Prelude.length ds+        deleteCount = fromIntegral $ Prelude.length ds         edit = fromMaybe (Edit ix 0 []) e       in go (ix + deleteCount) (Just (edit{editDeleteCount=editDeleteCount edit + deleteCount})) rest acc     -- Items only on the right (i.e. insertions): don't increment the current index, and record the insertions,@@ -475,11 +475,11 @@     -- Items on both sides: increment the current index appropriately (since the items appear on the left),     -- and append the current edit (if there is one) to our list of edits (since we can't continue it with a break).     go ix e (Diff.Both bs _bs : rest) acc =-      let bothCount = Prelude.length bs+      let bothCount = fromIntegral $ Prelude.length bs       in go (ix + bothCount) Nothing rest (acc <> DList.fromList (maybeToList e))  -- | Convenience method for making a 'SemanticTokens' from a list of 'SemanticTokenAbsolute's. An error may be returned if--- the tokens refer to types or modifiers which are not in the legend.+ -- The resulting 'SemanticTokens' lacks a result ID, which must be set separately if you are using that. makeSemanticTokens :: SemanticTokensLegend -> [SemanticTokenAbsolute] -> Either Text SemanticTokens makeSemanticTokens legend sts = do

@@ -85,7 +85,7 @@  -- ------------------------------------- -data ParameterLabel = ParameterLabelString Text | ParameterLabelOffset Int Int+data ParameterLabel = ParameterLabelString Text | ParameterLabelOffset UInt UInt   deriving (Read,Show,Eq)  instance ToJSON ParameterLabel where@@ -127,7 +127,7 @@     { _label           :: Text -- ^ The label of the signature.     , _documentation   :: Maybe SignatureHelpDoc -- ^ The human-readable doc-comment of this signature.     , _parameters      :: Maybe (List ParameterInformation) -- ^ The parameters of this signature.-    , _activeParameter :: Maybe Int -- ^ The index of the active parameter.+    , _activeParameter :: Maybe UInt -- ^ The index of the active parameter.     } deriving (Read,Show,Eq)  deriveJSON lspOptions ''SignatureInformation@@ -141,8 +141,8 @@ data SignatureHelp =   SignatureHelp     { _signatures      :: List SignatureInformation -- ^ One or more signatures.-    , _activeSignature :: Maybe Int -- ^ The active signature.-    , _activeParameter :: Maybe Int -- ^ The active parameter of the active signature.+    , _activeSignature :: Maybe UInt -- ^ The active signature.+    , _activeParameter :: Maybe UInt -- ^ The active parameter of the active signature.     } deriving (Read,Show,Eq)  deriveJSON lspOptions ''SignatureHelp

@@ -22,7 +22,7 @@     } deriving (Show, Read, Eq) deriveJSON lspOptions ''TextDocumentIdentifier -type TextDocumentVersion = Maybe Int+type TextDocumentVersion = Maybe Int32  makeExtendingDatatype "VersionedTextDocumentIdentifier" [''TextDocumentIdentifier]   [ ("_version", [t| TextDocumentVersion |])]@@ -32,7 +32,7 @@   TextDocumentItem {     _uri        :: Uri   , _languageId :: Text-  , _version    :: Int+  , _version    :: Int32   , _text       :: Text   } deriving (Show, Read, Eq) @@ -169,7 +169,7 @@       _range       :: Maybe Range       -- | The optional length of the range that got replaced.       -- Deprecated, use _range instead-    , _rangeLength :: Maybe Int+    , _rangeLength :: Maybe UInt       -- | The new text for the provided range, if provided.       -- Otherwise the new text of the whole document.     , _text        :: Text

@@ -8,6 +8,8 @@ import           Data.Aeson.TH import           Data.Text                                  (Text) import           Language.LSP.Types.Utils+import Language.LSP.Types.Uri+import Language.LSP.Types.Location  -- --------------------------------------------------------------------- @@ -59,6 +61,47 @@     } deriving (Show,Read,Eq)  deriveJSON lspOptions ''ShowMessageRequestParams++-- ---------------------------------------------------------------------++-- | Params to show a document.+--+-- @since 3.16.0+data ShowDocumentParams =+  ShowDocumentParams {+    -- | The document uri to show.+    _uri :: Uri++    -- | Indicates to show the resource in an external program.+    -- To show for example `https://code.visualstudio.com/`+    -- in the default WEB browser set `external` to `true`.+  , _external :: Maybe Bool++    -- | An optional property to indicate whether the editor+    -- showing the document should take focus or not.+    -- Clients might ignore this property if an external+    -- program is started.+  , _takeFocus :: Maybe Bool++    -- | An optional selection range if the document is a text+    -- document. Clients might ignore the property if an+    -- external program is started or the file is not a text+    -- file.+  , _selection :: Maybe Range+  } deriving (Show, Read, Eq)++deriveJSON lspOptions ''ShowDocumentParams++-- | The result of an show document request.+--+--  @since 3.16.0+data ShowDocumentResult =+  ShowDocumentResult {+    -- | A boolean indicating if the show was successful.+    _success :: Bool+  } deriving (Show, Read, Eq)++deriveJSON lspOptions ''ShowDocumentResult  -- --------------------------------------------------------------------- 

@@ -359,6 +359,11 @@       -- logging or to provide a suitable error for a request that       -- triggered the edit.     , _failureReason :: Maybe Text+      -- | Depending on the client's failure handling strategy `failedChange`+      -- might contain the index of the change that failed. This property is+      -- only available if the client signals a `failureHandling` strategy+      -- in its client capabilities.+    , _failedChange :: Maybe UInt     } deriving (Show, Read, Eq)  deriveJSON lspOptions ''ApplyWorkspaceEditResponseBody@@ -380,16 +385,17 @@       -- past the end. Fortunately, T.splitAt is fine with this, and just gives us the whole       -- string and an empty string, which is what we want.       let index = sc + startLineIndex sl t-        in T.splitAt index t+        in T.splitAt (fromIntegral index) t      -- The index of the first character of line 'line'+    startLineIndex :: UInt -> Text -> UInt     startLineIndex 0 _ = 0     startLineIndex line t' =       case T.findIndex (== '\n') t' of-        Just i -> i + 1 + startLineIndex (line - 1) (T.drop (i + 1) t')+        Just i -> fromIntegral i + 1 + startLineIndex (line - 1) (T.drop (i + 1) t')         -- i != 0, and there are no newlines, so this is a line beyond the end of the text.         -- In this case give the "start index" as the end, so we will at least append the text.-        Nothing -> T.length t'+        Nothing -> fromIntegral $ T.length t'  -- | 'editTextEdit' @outer@ @inner@ applies @inner@ to the text inside @outer@. editTextEdit :: TextEdit -> TextEdit -> TextEdit

@@ -41,11 +41,12 @@   , changeChars   ) where -import           Control.Lens hiding ( parts )+import           Control.Lens hiding ( (<.>), parts ) import           Control.Monad import           Data.Char (isUpper, isAlphaNum) import           Data.Text ( Text ) import qualified Data.Text as T+import           Data.Int (Int32) import           Data.List import           Data.Ord import qualified Data.HashMap.Strict as HashMap@@ -69,7 +70,7 @@  data VirtualFile =   VirtualFile {-      _lsp_version :: !Int  -- ^ The LSP version of the document+      _lsp_version :: !Int32  -- ^ The LSP version of the document     , _file_version :: !Int -- ^ This number is only incremented whilst the file                            -- remains in the map.     , _text    :: !Rope  -- ^ The full contents of the document@@ -87,7 +88,7 @@ virtualFileText :: VirtualFile -> Text virtualFileText vf = Rope.toText (_text  vf) -virtualFileVersion :: VirtualFile -> Int+virtualFileVersion :: VirtualFile -> Int32 virtualFileVersion vf = _lsp_version vf  ---@@ -247,7 +248,7 @@       padLeft n num =         let numString = show num         in replicate (n - length numString) '0' ++ numString-  in prefix </> basename ++ "-" ++ padLeft 5 file_ver ++ "-" ++ show (hash uri_raw) ++ ".hs"+  in prefix </> basename ++ "-" ++ padLeft 5 file_ver ++ "-" ++ show (hash uri_raw) <.> takeExtensions basename  -- | Write a virtual file to a temporary file if it exists in the VFS. persistFileVFS :: VFS -> J.NormalizedUri -> Maybe (FilePath, IO ())@@ -278,16 +279,7 @@   in (updateVFS (Map.delete (J.toNormalizedUri uri)) vfs,["Closed: " ++ show uri])  -- ----------------------------------------------------------------------{- -data TextDocumentContentChangeEvent =-  TextDocumentContentChangeEvent-    { _range       :: Maybe Range-    , _rangeLength :: Maybe Int-    , _text        :: String-    } deriving (Read,Show,Eq)--}- -- | Apply the list of changes. -- Changes should be applied in the order that they are -- received from the client.@@ -300,14 +292,14 @@ applyChange _ (J.TextDocumentContentChangeEvent Nothing Nothing str)   = Rope.fromText str applyChange str (J.TextDocumentContentChangeEvent (Just (J.Range (J.Position sl sc) _to)) (Just len) txt)-  = changeChars str start len txt+  = changeChars str start (fromIntegral len) txt   where-    start = Rope.rowColumnCodeUnits (Rope.RowColumn sl sc) str+    start = Rope.rowColumnCodeUnits (Rope.RowColumn (fromIntegral sl) (fromIntegral sc)) str applyChange str (J.TextDocumentContentChangeEvent (Just (J.Range (J.Position sl sc) (J.Position el ec))) Nothing txt)   = changeChars str start len txt   where-    start = Rope.rowColumnCodeUnits (Rope.RowColumn sl sc) str-    end = Rope.rowColumnCodeUnits (Rope.RowColumn el ec) str+    start = Rope.rowColumnCodeUnits (Rope.RowColumn (fromIntegral sl) (fromIntegral sc)) str+    end = Rope.rowColumnCodeUnits (Rope.RowColumn (fromIntegral el) (fromIntegral ec)) str     len = end - start applyChange str (J.TextDocumentContentChangeEvent Nothing (Just _) _txt)   = str@@ -350,8 +342,8 @@             lastMaybe xs = Just $ last xs          curLine <- headMaybe $ T.lines $ Rope.toText-                             $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine l ropetext-        let beforePos = T.take c curLine+                             $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) ropetext+        let beforePos = T.take (fromIntegral c) curLine         curWord <-             if | T.null beforePos -> Just ""                | T.last beforePos == ' ' -> Just "" -- don't count abc as the curword in 'abc '@@ -372,7 +364,7 @@ rangeLinesFromVfs :: VirtualFile -> J.Range -> T.Text rangeLinesFromVfs (VirtualFile _ _ ropetext) (J.Range (J.Position lf _cf) (J.Position lt _ct)) = r   where-    (_ ,s1) = Rope.splitAtLine lf ropetext-    (s2, _) = Rope.splitAtLine (lt - lf) s1+    (_ ,s1) = Rope.splitAtLine (fromIntegral lf) ropetext+    (s2, _) = Rope.splitAtLine (fromIntegral (lt - lf)) s1     r = Rope.toText s2 -- ---------------------------------------------------------------------