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 haskell#354.

Author: michaelpj

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)

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
@@ -308,7 +308,7 @@ updateStateC = awaitForever $ \msg -> do
     respond (FromServerMess SWindowWorkDoneProgressCreate req) =
       sendMessage $ ResponseMessage "2.0" (Just $ req ^. LSP.id) (Right Empty)
     respond (FromServerMess SWorkspaceApplyEdit r) = do
-      sendMessage $ ResponseMessage "2.0" (Just $ r ^. LSP.id) (Right $ ApplyWorkspaceEditResponseBody True Nothing)
+      sendMessage $ ResponseMessage "2.0" (Just $ r ^. LSP.id) (Right $ ApplyWorkspaceEditResponseBody True Nothing Nothing)
     respond _ = pure ()
 
 

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

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)

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
 

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

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.

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  |])

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')

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

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

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,15 +455,15 @@ 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)
 
     -- Items only on the left (i.e. deletions): increment the current index, and record the count of deletions,
     -- starting a new edit if necessary.
     go ix e (Diff.First ds : rest) acc =
       let
-        deleteCount = 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