From 201d376a0d3173b3a3b832b07c0d5b7b851cf97a Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Sun, 7 Nov 2021 22:12:34 +0000 Subject: [PATCH] Use approrpriate number types This ensures that we use either: - `Int32` - `Word32` - `Float` In particular, this gets us: - Appropriate `Bounded` instances (see the original issue haskell/haskell-language-server#2169). - More picky `aeson` instances for the bounded types. Rather than use newtypes, we just use the existing appropriate Haskell numeric types for bounded integers. Fixes #354. --- lsp-test/src/Language/LSP/Test.hs | 4 +- lsp-test/src/Language/LSP/Test/Session.hs | 2 +- lsp-types/src/Language/LSP/Types/Common.hs | 10 +++- .../src/Language/LSP/Types/Diagnostic.hs | 4 +- .../src/Language/LSP/Types/DocumentColor.hs | 8 ++-- .../src/Language/LSP/Types/FoldingRange.hs | 11 +++-- .../src/Language/LSP/Types/Formatting.hs | 3 +- .../src/Language/LSP/Types/Initialize.hs | 2 +- lsp-types/src/Language/LSP/Types/Location.hs | 9 ++-- lsp-types/src/Language/LSP/Types/LspId.hs | 6 ++- lsp-types/src/Language/LSP/Types/Progress.hs | 7 +-- .../src/Language/LSP/Types/SemanticTokens.hs | 46 +++++++++---------- .../src/Language/LSP/Types/SignatureHelp.hs | 8 ++-- .../src/Language/LSP/Types/TextDocument.hs | 6 +-- lsp-types/src/Language/LSP/Types/Uri.hs | 2 +- .../src/Language/LSP/Types/WorkspaceEdit.hs | 7 +-- lsp-types/src/Language/LSP/VFS.hs | 21 +++++---- lsp/example/Reactor.hs | 7 +-- lsp/src/Language/LSP/Diagnostics.hs | 2 +- lsp/src/Language/LSP/Server/Core.hs | 8 ++-- lsp/test/SemanticTokensSpec.hs | 10 ++-- lsp/test/VspSpec.hs | 2 +- 22 files changed, 102 insertions(+), 83 deletions(-) diff --git a/lsp-test/src/Language/LSP/Test.hs b/lsp-test/src/Language/LSP/Test.hs index 96e6a5014..079928662 100644 --- a/lsp-test/src/Language/LSP/Test.hs +++ b/lsp-test/src/Language/LSP/Test.hs @@ -198,7 +198,9 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio config <- envOverrideConfig config' let initializeParams = InitializeParams Nothing - (Just pid) + -- Narowing to Int32 here, but it's unlikely that a pid will + -- be outside the range + (Just $ fromIntegral pid) (Just lspTestClientInfo) (Just $ T.pack absRootDir) (Just $ filePathToUri absRootDir) diff --git a/lsp-test/src/Language/LSP/Test/Session.hs b/lsp-test/src/Language/LSP/Test/Session.hs index f5e4aaab8..3344c81f8 100644 --- a/lsp-test/src/Language/LSP/Test/Session.hs +++ b/lsp-test/src/Language/LSP/Test/Session.hs @@ -169,7 +169,7 @@ bumpTimeoutId prev = do data SessionState = SessionState { - curReqId :: !Int + curReqId :: !Int32 , vfs :: !VFS , curDiagnostics :: !(Map.Map NormalizedUri [Diagnostic]) , overridingTimeout :: !Bool diff --git a/lsp-types/src/Language/LSP/Types/Common.hs b/lsp-types/src/Language/LSP/Types/Common.hs index 62c3a2d6c..e36ad62e0 100644 --- a/lsp-types/src/Language/LSP/Types/Common.hs +++ b/lsp-types/src/Language/LSP/Types/Common.hs @@ -4,11 +4,19 @@ {-# 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 + , Word32 ) where import Control.Applicative import Control.DeepSeq import Data.Aeson +import Data.Int (Int32) +import Data.Word (Word32) import GHC.Generics -- | A terser, isomorphic data type for 'Either', that does not get tagged when diff --git a/lsp-types/src/Language/LSP/Types/Diagnostic.hs b/lsp-types/src/Language/LSP/Types/Diagnostic.hs index b77ed7750..35a94fe62 100644 --- a/lsp-types/src/Language/LSP/Types/Diagnostic.hs +++ b/lsp-types/src/Language/LSP/Types/Diagnostic.hs @@ -82,7 +82,7 @@ data Diagnostic = 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 @@ data PublishDiagnosticsParams = -- published for. -- -- Since LSP 3.15.0 - , _version :: Maybe Int + , _version :: Maybe Word32 -- | An array of diagnostic information items. , _diagnostics :: List Diagnostic } deriving (Read,Show,Eq) diff --git a/lsp-types/src/Language/LSP/Types/DocumentColor.hs b/lsp-types/src/Language/LSP/Types/DocumentColor.hs index 93a6c76ee..50b0fa7f3 100644 --- a/lsp-types/src/Language/LSP/Types/DocumentColor.hs +++ b/lsp-types/src/Language/LSP/Types/DocumentColor.hs @@ -45,10 +45,10 @@ deriveJSON lspOptions ''DocumentColorParams -- | 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 diff --git a/lsp-types/src/Language/LSP/Types/FoldingRange.hs b/lsp-types/src/Language/LSP/Types/FoldingRange.hs index 19ae4f20f..07cfdc998 100644 --- a/lsp-types/src/Language/LSP/Types/FoldingRange.hs +++ b/lsp-types/src/Language/LSP/Types/FoldingRange.hs @@ -6,6 +6,7 @@ module Language.LSP.Types.FoldingRange where import qualified Data.Aeson as A import Data.Aeson.TH import Data.Text (Text) +import Language.LSP.Types.Common import Language.LSP.Types.Progress import Language.LSP.Types.StaticRegistrationOptions import Language.LSP.Types.TextDocument @@ -23,7 +24,7 @@ data FoldingRangeClientCapabilities = _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 Word32 -- | 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 @@ instance A.FromJSON FoldingRangeKind where data FoldingRange = FoldingRange { -- | The zero-based line number from where the folded range starts. - _startLine :: Int + _startLine :: Word32 -- | 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 Word32 -- | The zero-based line number where the folded range ends. - , _endLine :: Int + , _endLine :: Word32 -- | 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 Word32 -- | 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 diff --git a/lsp-types/src/Language/LSP/Types/Formatting.hs b/lsp-types/src/Language/LSP/Types/Formatting.hs index 2dc1fa142..6ca95069c 100644 --- a/lsp-types/src/Language/LSP/Types/Formatting.hs +++ b/lsp-types/src/Language/LSP/Types/Formatting.hs @@ -4,6 +4,7 @@ module Language.LSP.Types.Formatting where import Data.Aeson.TH import Data.Text (Text) +import Language.LSP.Types.Common import Language.LSP.Types.Location import Language.LSP.Types.Progress import Language.LSP.Types.TextDocument @@ -29,7 +30,7 @@ deriveJSON lspOptions ''DocumentFormattingRegistrationOptions -- | Value-object describing what options formatting should use. data FormattingOptions = FormattingOptions { -- | Size of a tab in spaces. - _tabSize :: Int, + _tabSize :: Word32, -- | Prefer spaces over tabs _insertSpaces :: Bool, -- | Trim trailing whitespace on a line. diff --git a/lsp-types/src/Language/LSP/Types/Initialize.hs b/lsp-types/src/Language/LSP/Types/Initialize.hs index 111367c76..77247d10d 100644 --- a/lsp-types/src/Language/LSP/Types/Initialize.hs +++ b/lsp-types/src/Language/LSP/Types/Initialize.hs @@ -41,7 +41,7 @@ data ClientInfo = 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 |]) diff --git a/lsp-types/src/Language/LSP/Types/Location.hs b/lsp-types/src/Language/LSP/Types/Location.hs index 90e89fcdd..a05cb698e 100644 --- a/lsp-types/src/Language/LSP/Types/Location.hs +++ b/lsp-types/src/Language/LSP/Types/Location.hs @@ -4,7 +4,8 @@ module Language.LSP.Types.Location where 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 @@ import Language.LSP.Types.Utils data Position = Position { -- | Line position in a document (zero-based). - _line :: Int + _line :: Word32 -- | 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 :: Word32 } deriving (Show, Read, Eq, Ord, Generic) instance NFData Position @@ -72,5 +73,5 @@ deriveJSON lspOptions ''LocationLink -- | 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 :: Word32 -> Word32 -> Word32 -> Word32 -> Range mkRange l c l' c' = Range (Position l c) (Position l' c') diff --git a/lsp-types/src/Language/LSP/Types/LspId.hs b/lsp-types/src/Language/LSP/Types/LspId.hs index 379e2f469..dc896fa9d 100644 --- a/lsp-types/src/Language/LSP/Types/LspId.hs +++ b/lsp-types/src/Language/LSP/Types/LspId.hs @@ -8,11 +8,13 @@ module Language.LSP.Types.LspId where 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 diff --git a/lsp-types/src/Language/LSP/Types/Progress.hs b/lsp-types/src/Language/LSP/Types/Progress.hs index cb2c5f679..cf9f8ffbd 100644 --- a/lsp-types/src/Language/LSP/Types/Progress.hs +++ b/lsp-types/src/Language/LSP/Types/Progress.hs @@ -11,13 +11,14 @@ import qualified Data.Aeson as A import Data.Aeson.TH import Data.Maybe (catMaybes) import Data.Text (Text) +import Language.LSP.Types.Common import Language.LSP.Types.Utils -- | A token used to report progress back or return partial results for a -- specific request. -- @since 0.17.0.0 data ProgressToken - = ProgressNumericToken Int + = ProgressNumericToken Int32 | ProgressTextToken Text deriving (Show, Read, Eq, Ord) @@ -58,7 +59,7 @@ data WorkDoneProgressBeginParams = -- -- The value should be steadily rising. Clients are free to ignore values -- that are not following this rule. - , _percentage :: Maybe Double + , _percentage :: Maybe Word32 } deriving (Show, Read, Eq) instance A.ToJSON WorkDoneProgressBeginParams where @@ -103,7 +104,7 @@ data WorkDoneProgressReportParams = -- 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 Word32 } deriving (Show, Read, Eq) instance A.ToJSON WorkDoneProgressReportParams where diff --git a/lsp-types/src/Language/LSP/Types/SemanticTokens.hs b/lsp-types/src/Language/LSP/Types/SemanticTokens.hs index aac80a48e..283063686 100644 --- a/lsp-types/src/Language/LSP/Types/SemanticTokens.hs +++ b/lsp-types/src/Language/LSP/Types/SemanticTokens.hs @@ -292,12 +292,12 @@ data SemanticTokens = SemanticTokens { _resultId :: Maybe Text, -- | The actual tokens. - _xdata :: List Int + _xdata :: List Word32 } deriving (Show, Read, Eq) deriveJSON lspOptions ''SemanticTokens data SemanticTokensPartialResult = SemanticTokensPartialResult { - _xdata :: List Int + _xdata :: List Word32 } deriveJSON lspOptions ''SemanticTokensPartialResult @@ -311,11 +311,11 @@ deriveJSON lspOptions ''SemanticTokensDeltaParams data SemanticTokensEdit = SemanticTokensEdit { -- | The start offset of the edit. - _start :: Int, + _start :: Word32, -- | The count of elements to remove. - _deleteCount :: Int, + _deleteCount :: Word32, -- | The elements to insert. - _xdata :: Maybe (List Int) + _xdata :: Maybe (List Word32) } deriving (Show, Read, Eq) deriveJSON lspOptions ''SemanticTokensEdit @@ -359,9 +359,9 @@ deriveJSON lspOptions ''SemanticTokensWorkspaceClientCapabilities -- | 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 :: Word32, + startChar :: Word32, + length :: Word32, tokenType :: SemanticTokenTypes, tokenModifiers :: [SemanticTokenModifiers] } deriving (Show, Read, Eq, Ord) @@ -370,9 +370,9 @@ data SemanticTokenAbsolute = SemanticTokenAbsolute { -- | A single 'semantic token' as described in the LSP specification, using relative positions. data SemanticTokenRelative = SemanticTokenRelative { - deltaLine :: Int, - deltaStartChar :: Int, - length :: Int, + deltaLine :: Word32, + deltaStartChar :: Word32, + length :: Word32, tokenType :: SemanticTokenTypes, tokenModifiers :: [SemanticTokenModifiers] } deriving (Show, Read, Eq, Ord) @@ -385,7 +385,7 @@ relativizeTokens :: [SemanticTokenAbsolute] -> [SemanticTokenRelative] 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 :: Word32 -> Word32 -> [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 :: [SemanticTokenRelative] -> [SemanticTokenAbsolute] 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 :: Word32 -> Word32 -> [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 @@ absolutizeTokens xs = DList.toList $ go 0 0 xs mempty 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 [Word32] 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 Word32 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 Word32 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 @@ encodeTokens SemanticTokensLegend{_tokenTypes=List tts,_tokenModifiers=List tms} 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 Word32) 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 :: Word32 = foldl' Bits.setBit Bits.zeroBits modcodes pure [dl, dc, len, tycode, 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 :: Word32, editDeleteCount :: Word32, 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 @@ computeEdits l r = DList.toList $ go 0 Nothing (Diff.getGroupedDiff l r) mempty 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 :: Word32 -> 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 @@ computeEdits l r = DList.toList $ go 0 Nothing (Diff.getGroupedDiff l r) mempty -- 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 @@ computeEdits l r = DList.toList $ go 0 Nothing (Diff.getGroupedDiff l r) mempty -- 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 diff --git a/lsp-types/src/Language/LSP/Types/SignatureHelp.hs b/lsp-types/src/Language/LSP/Types/SignatureHelp.hs index 12471511c..e2ca51f2a 100644 --- a/lsp-types/src/Language/LSP/Types/SignatureHelp.hs +++ b/lsp-types/src/Language/LSP/Types/SignatureHelp.hs @@ -85,7 +85,7 @@ deriveJSON lspOptionsUntagged ''SignatureHelpDoc -- ------------------------------------- -data ParameterLabel = ParameterLabelString Text | ParameterLabelOffset Int Int +data ParameterLabel = ParameterLabelString Text | ParameterLabelOffset Word32 Word32 deriving (Read,Show,Eq) instance ToJSON ParameterLabel where @@ -127,7 +127,7 @@ data SignatureInformation = { _label :: Text -- ^ The label of the signature. , _documentation :: Maybe SignatureHelpDoc -- ^ The human-readable doc-comment of this signature. , _parameters :: Maybe (List ParameterInformation) -- ^ The parameters of this signature. - , _activeParameter :: Maybe Int -- ^ The index of the active parameter. + , _activeParameter :: Maybe Word32 -- ^ The index of the active parameter. } deriving (Read,Show,Eq) deriveJSON lspOptions ''SignatureInformation @@ -141,8 +141,8 @@ active and only one active parameter. 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 Word32 -- ^ The active signature. + , _activeParameter :: Maybe Word32 -- ^ The active parameter of the active signature. } deriving (Read,Show,Eq) deriveJSON lspOptions ''SignatureHelp diff --git a/lsp-types/src/Language/LSP/Types/TextDocument.hs b/lsp-types/src/Language/LSP/Types/TextDocument.hs index b3d7d051b..8f6cf03e8 100644 --- a/lsp-types/src/Language/LSP/Types/TextDocument.hs +++ b/lsp-types/src/Language/LSP/Types/TextDocument.hs @@ -22,7 +22,7 @@ data TextDocumentIdentifier = } 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 @@ data TextDocumentItem = TextDocumentItem { _uri :: Uri , _languageId :: Text - , _version :: Int + , _version :: Int32 , _text :: Text } deriving (Show, Read, Eq) @@ -169,7 +169,7 @@ data TextDocumentContentChangeEvent = _range :: Maybe Range -- | The optional length of the range that got replaced. -- Deprecated, use _range instead - , _rangeLength :: Maybe Int + , _rangeLength :: Maybe Word32 -- | The new text for the provided range, if provided. -- Otherwise the new text of the whole document. , _text :: Text diff --git a/lsp-types/src/Language/LSP/Types/Uri.hs b/lsp-types/src/Language/LSP/Types/Uri.hs index 5fa823674..8d2d43f4e 100644 --- a/lsp-types/src/Language/LSP/Types/Uri.hs +++ b/lsp-types/src/Language/LSP/Types/Uri.hs @@ -207,4 +207,4 @@ normalizedFilePathToUri (NormalizedFilePath uri _) = uri uriToNormalizedFilePath :: NormalizedUri -> Maybe NormalizedFilePath uriToNormalizedFilePath nuri = fmap (normalizedFilePath nuri) mbFilePath - where mbFilePath = platformAwareUriToFilePath System.Info.os (fromNormalizedUri nuri) \ No newline at end of file + where mbFilePath = platformAwareUriToFilePath System.Info.os (fromNormalizedUri nuri) diff --git a/lsp-types/src/Language/LSP/Types/WorkspaceEdit.hs b/lsp-types/src/Language/LSP/Types/WorkspaceEdit.hs index eb0201090..7fbf4d785 100644 --- a/lsp-types/src/Language/LSP/Types/WorkspaceEdit.hs +++ b/lsp-types/src/Language/LSP/Types/WorkspaceEdit.hs @@ -380,16 +380,17 @@ applyTextEdit (TextEdit (Range sp ep) newText) oldText = -- 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 :: Word32 -> Text -> Word32 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 diff --git a/lsp-types/src/Language/LSP/VFS.hs b/lsp-types/src/Language/LSP/VFS.hs index ecde62121..5d6efec01 100644 --- a/lsp-types/src/Language/LSP/VFS.hs +++ b/lsp-types/src/Language/LSP/VFS.hs @@ -46,6 +46,7 @@ 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 @@ import System.Log.Logger 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 @@ data VFS = VFS { vfsMap :: !(Map.Map J.NormalizedUri VirtualFile) virtualFileText :: VirtualFile -> Text virtualFileText vf = Rope.toText (_text vf) -virtualFileVersion :: VirtualFile -> Int +virtualFileVersion :: VirtualFile -> Int32 virtualFileVersion vf = _lsp_version vf --- @@ -300,14 +301,14 @@ applyChange :: Rope -> J.TextDocumentContentChangeEvent -> Rope 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 +351,8 @@ getCompletionPrefix pos@(J.Position l c) (VirtualFile _ _ ropetext) = 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 +373,7 @@ getCompletionPrefix pos@(J.Position l c) (VirtualFile _ _ ropetext) = 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 -- --------------------------------------------------------------------- diff --git a/lsp/example/Reactor.hs b/lsp/example/Reactor.hs index a4c3a8174..81a69d2a1 100644 --- a/lsp/example/Reactor.hs +++ b/lsp/example/Reactor.hs @@ -30,6 +30,7 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.STM import qualified Data.Aeson as J +import Data.Int (Int32) import qualified Data.Text as T import GHC.Generics (Generic) import Language.LSP.Server @@ -118,7 +119,7 @@ newtype ReactorInput -- | Analyze the file and send any diagnostics to the client in a -- "textDocument/publishDiagnostics" notification -sendDiagnostics :: J.NormalizedUri -> Maybe Int -> LspM Config () +sendDiagnostics :: J.NormalizedUri -> Maybe Int32 -> LspM Config () sendDiagnostics fileUri version = do let diags = [J.Diagnostic @@ -226,7 +227,7 @@ handle = mconcat newName = params ^. J.newName vdoc <- getVersionedTextDoc (params ^. J.textDocument) -- Replace some text at the position with what the user entered - let edit = J.InL $ J.TextEdit (J.mkRange l c l (c + T.length newName)) newName + let edit = J.InL $ J.TextEdit (J.mkRange l c l (c + fromIntegral (T.length newName))) newName tde = J.TextDocumentEdit vdoc (J.List [edit]) -- "documentChanges" field is preferred over "changes" rsp = J.WorkspaceEdit Nothing (Just (J.List [J.InL tde])) Nothing @@ -279,7 +280,7 @@ handle = mconcat responder (Right (J.Object mempty)) -- respond to the request void $ withProgress "Executing some long running command" Cancellable $ \update -> - forM [(0 :: Double)..10] $ \i -> do + forM [(0 :: J.Word32)..10] $ \i -> do update (ProgressAmount (Just (i * 10)) (Just "Doing stuff")) liftIO $ threadDelay (1 * 1000000) ] diff --git a/lsp/src/Language/LSP/Diagnostics.hs b/lsp/src/Language/LSP/Diagnostics.hs index fe8856393..5fc24ef02 100644 --- a/lsp/src/Language/LSP/Diagnostics.hs +++ b/lsp/src/Language/LSP/Diagnostics.hs @@ -92,6 +92,6 @@ getDiagnosticParamsFor maxDiagnostics ds uri = case HM.lookup uri ds of Nothing -> Nothing Just (StoreItem mv diags) -> - Just $ J.PublishDiagnosticsParams (J.fromNormalizedUri uri) mv (J.List (take maxDiagnostics $ SL.fromSortedList $ mconcat $ Map.elems diags)) + Just $ J.PublishDiagnosticsParams (J.fromNormalizedUri uri) (fmap fromIntegral mv) (J.List (take maxDiagnostics $ SL.fromSortedList $ mconcat $ Map.elems diags)) -- --------------------------------------------------------------------- diff --git a/lsp/src/Language/LSP/Server/Core.hs b/lsp/src/Language/LSP/Server/Core.hs index d76e7d54a..c70100fca 100644 --- a/lsp/src/Language/LSP/Server/Core.hs +++ b/lsp/src/Language/LSP/Server/Core.hs @@ -184,7 +184,7 @@ data LanguageContextState config = , resPendingResponses :: !(TVar ResponseMap) , resRegistrationsNot :: !(TVar (RegistrationMap Notification)) , resRegistrationsReq :: !(TVar (RegistrationMap Request)) - , resLspId :: !(TVar Int) + , resLspId :: !(TVar Int32) } type ResponseMap = IxMap LspId (Product SMethod ServerResponseCallback) @@ -195,7 +195,7 @@ data RegistrationToken (m :: Method FromClient t) = RegistrationToken (SMethod m newtype RegistrationId (m :: Method FromClient t) = RegistrationId Text deriving Eq -data ProgressData = ProgressData { progressNextId :: !(TVar Int) +data ProgressData = ProgressData { progressNextId :: !(TVar Int32) , progressCancel :: !(TVar (Map.Map ProgressToken (IO ()))) } data VFSData = @@ -267,7 +267,7 @@ defaultOptions = def -- an optional message to go with it during a 'withProgress' -- -- @since 0.10.0.0 -data ProgressAmount = ProgressAmount (Maybe Double) (Maybe Text) +data ProgressAmount = ProgressAmount (Maybe Word32) (Maybe Text) -- | Thrown if the user cancels a 'Cancellable' 'withProgress'/'withIndefiniteProgress'/ session -- @@ -442,7 +442,7 @@ sendErrorLog msg = -- --------------------------------------------------------------------- -freshLspId :: MonadLsp config m => m Int +freshLspId :: MonadLsp config m => m Int32 freshLspId = do stateState resLspId $ \cur -> let !next = cur+1 in (cur, next) diff --git a/lsp/test/SemanticTokensSpec.hs b/lsp/test/SemanticTokensSpec.hs index d826f30f0..dab8943a5 100644 --- a/lsp/test/SemanticTokensSpec.hs +++ b/lsp/test/SemanticTokensSpec.hs @@ -21,7 +21,7 @@ spec = do , SemanticTokenAbsolute 6 2 7 SttClass [] ] - bigNumber :: Int + bigNumber :: Word32 bigNumber = 100000 bigTokens = unfoldr (\i -> if i == bigNumber then Nothing else Just (SemanticTokenAbsolute i 1 1 SttType [StmUnknown "private", StmStatic], i+1)) 0 @@ -31,12 +31,12 @@ spec = do -- One more order of magnitude makes diffing more-or-less hang - possibly we need a better diffing algorithm, since this is only ~= 200 tokens at 5 ints per token -- (I checked and it is the diffing that's slow, not turning it into edits) - smallerBigNumber :: Int + smallerBigNumber :: Word32 smallerBigNumber = 1000 - bigInts :: [Int] + bigInts :: [Word32] bigInts = unfoldr (\i -> if i == smallerBigNumber then Nothing else Just (1, i+1)) 0 - bigInts2 :: [Int] + bigInts2 :: [Word32] bigInts2 = unfoldr (\i -> if i == smallerBigNumber then Nothing else Just (if even i then 2 else 1, i+1)) 0 @@ -71,4 +71,4 @@ spec = do computeEdits @Int [1,2,3,4,5] [1,6,3,7,7,5] `shouldBe` [Edit 1 1 [6], Edit 3 1 [7,7]] it "handles big tokens" $ -- It's a little hard to specify a useful predicate here, the main point is that it should not take too long - computeEdits @Int bigInts bigInts2 `shouldSatisfy` (not . null) + computeEdits @Word32 bigInts bigInts2 `shouldSatisfy` (not . null) diff --git a/lsp/test/VspSpec.hs b/lsp/test/VspSpec.hs index 5d24bde73..e970f7454 100644 --- a/lsp/test/VspSpec.hs +++ b/lsp/test/VspSpec.hs @@ -27,7 +27,7 @@ spec = describe "VSP functions" vspSpec -- --------------------------------------------------------------------- -mkRange :: Int -> Int -> Int -> Int -> Maybe J.Range +mkRange :: J.Word32 -> J.Word32 -> J.Word32 -> J.Word32 -> Maybe J.Range mkRange ls cs le ce = Just $ J.Range (J.Position ls cs) (J.Position le ce) vfsFromText :: T.Text -> VirtualFile