Merge pull request #382 from haskell/mpj/uint31

Replace Word32 with a newtype

Author: michaelpj

lsp-types/lsp-types.cabal

@@ -86,6 +86,7 @@ library
                      , lens >= 4.15.2
                      , mtl
                      , network-uri
+                     , mod
                      , rope-utf16-splay >= 0.3.1.0
                      , scientific
                      , some

lsp-types/src/Language/LSP/Types/Common.hs

@@ -1,6 +1,9 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DeriveAnyClass             #-}
 {-# LANGUAGE DeriveTraversable          #-}
 {-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE TypeOperators              #-}
 
 -- | Common types that aren't in the specification
@@ -10,14 +13,44 @@ module Language.LSP.Types.Common (
   , List (..)
   , Empty (..)
   , Int32
-  , Word32 ) where
+  , UInt ) where
 
 import Control.Applicative
 import Control.DeepSeq
 import Data.Aeson
 import Data.Int (Int32)
-import Data.Word (Word32)
-import GHC.Generics
+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.
@@ -46,7 +79,8 @@ instance (NFData a, NFData b) => NFData (a |? b)
 -- 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)
 

lsp-types/src/Language/LSP/Types/Diagnostic.hs

@@ -9,7 +9,7 @@ import           Control.DeepSeq
 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
@@ -131,7 +131,7 @@ data PublishDiagnosticsParams =
       -- published for.
       -- 
       -- Since LSP 3.15.0
-    , _version     :: Maybe Word32
+    , _version     :: Maybe UInt
       -- | An array of diagnostic information items.
     , _diagnostics :: List Diagnostic
     } deriving (Read,Show,Eq)

lsp-types/src/Language/LSP/Types/FoldingRange.hs

@@ -24,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 Word32
+    , _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.
@@ -80,15 +80,15 @@ instance A.FromJSON FoldingRangeKind where
 data FoldingRange =
   FoldingRange
   { -- | The zero-based line number from where the folded range starts.
-    _startLine      :: Word32
+    _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 Word32
+  , _startCharacter :: Maybe UInt
     -- | The zero-based line number where the folded range ends.
-  , _endLine        :: Word32
+  , _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 Word32
+  , _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

lsp-types/src/Language/LSP/Types/Formatting.hs

@@ -30,7 +30,7 @@ deriveJSON lspOptions ''DocumentFormattingRegistrationOptions
 -- | Value-object describing what options formatting should use.
 data FormattingOptions = FormattingOptions
   { -- | Size of a tab in spaces.
-    _tabSize :: Word32,
+    _tabSize :: UInt,
     -- | Prefer spaces over tabs
     _insertSpaces :: Bool,
     -- | Trim trailing whitespace on a line.

lsp-types/src/Language/LSP/Types/Location.hs

@@ -14,11 +14,11 @@ import           Language.LSP.Types.Utils
 data Position =
   Position
     { -- | Line position in a document (zero-based).
-      _line      :: Word32
+      _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 :: Word32
+    , _character :: UInt
     } deriving (Show, Read, Eq, Ord, Generic)
 
 instance NFData Position
@@ -73,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 :: Word32 -> Word32 -> Word32 -> Word32 -> Range
+mkRange :: UInt -> UInt -> UInt -> UInt -> Range
 mkRange l c l' c' = Range (Position l c) (Position l' c')

lsp-types/src/Language/LSP/Types/Progress.hs

@@ -59,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 Word32
+  , _percentage :: Maybe UInt
   } deriving (Show, Read, Eq)
 
 instance A.ToJSON WorkDoneProgressBeginParams where
@@ -104,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 Word32
+  , _percentage :: Maybe UInt
   } 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 Word32
+  _xdata    :: List UInt
 } deriving (Show, Read, Eq)
 deriveJSON lspOptions ''SemanticTokens
 
 data SemanticTokensPartialResult = SemanticTokensPartialResult {
-  _xdata :: List Word32
+  _xdata :: List UInt
 }
 deriveJSON lspOptions ''SemanticTokensPartialResult
 
@@ -311,11 +311,11 @@ deriveJSON lspOptions ''SemanticTokensDeltaParams
 
 data SemanticTokensEdit = SemanticTokensEdit {
   -- | The start offset of the edit.
-  _start       :: Word32,
+  _start       :: UInt,
   -- | The count of elements to remove.
-  _deleteCount :: Word32,
+  _deleteCount :: UInt,
   -- | The elements to insert.
-  _xdata       :: Maybe (List Word32)
+  _xdata       :: Maybe (List UInt)
 } 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           :: Word32,
-  startChar      :: Word32,
-  length         :: Word32,
+  line           :: UInt,
+  startChar      :: UInt,
+  length         :: UInt,
   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      :: Word32,
-  deltaStartChar :: Word32,
-  length         :: Word32,
+  deltaLine      :: UInt,
+  deltaStartChar :: UInt,
+  length         :: UInt,
   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 :: Word32 -> Word32 -> [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 :: [SemanticTokenRelative] -> [SemanticTokenAbsolute]
 absolutizeTokens xs = DList.toList $ go 0 0 xs mempty
   where
     -- Pass an accumulator to make this tail-recursive
-    go :: Word32 -> Word32 -> [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 @@ 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 [Word32]
+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 Word32
+    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 Word32
+    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 @@ 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 Word32)
+    encodeToken :: SemanticTokenRelative -> Either Text (DList.DList UInt)
     encodeToken (SemanticTokenRelative dl dc len ty mods) = do
       tycode <- lookupTy ty
       modcodes <- traverse lookupMod mods
-      let combinedModcode :: Word32 = 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 :: Word32, editDeleteCount :: Word32, 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 @@ 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 :: Word32 -> 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)
 

lsp-types/src/Language/LSP/Types/SignatureHelp.hs

@@ -85,7 +85,7 @@ deriveJSON lspOptionsUntagged ''SignatureHelpDoc
 
 -- -------------------------------------
 
-data ParameterLabel = ParameterLabelString Text | ParameterLabelOffset Word32 Word32
+data ParameterLabel = ParameterLabelString Text | ParameterLabelOffset UInt UInt
   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 Word32 -- ^ 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 @@ active and only one active parameter.
 data SignatureHelp =
   SignatureHelp
     { _signatures      :: List SignatureInformation -- ^ One or more signatures.
-    , _activeSignature :: Maybe Word32 -- ^ The active signature.
-    , _activeParameter :: Maybe Word32 -- ^ 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

lsp-types/src/Language/LSP/Types/TextDocument.hs

@@ -169,7 +169,7 @@ data TextDocumentContentChangeEvent =
       _range       :: Maybe Range
       -- | The optional length of the range that got replaced.
       -- Deprecated, use _range instead
-    , _rangeLength :: Maybe Word32
+    , _rangeLength :: Maybe UInt
       -- | The new text for the provided range, if provided.
       -- Otherwise the new text of the whole document.
     , _text        :: Text

lsp-types/src/Language/LSP/Types/WorkspaceEdit.hs

@@ -363,7 +363,7 @@ data ApplyWorkspaceEditResponseBody =
       -- 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 Word32
+    , _failedChange :: Maybe UInt
     } deriving (Show, Read, Eq)
 
 deriveJSON lspOptions ''ApplyWorkspaceEditResponseBody
@@ -388,7 +388,7 @@ applyTextEdit (TextEdit (Range sp ep) newText) oldText =
         in T.splitAt (fromIntegral index) t
 
     -- The index of the first character of line 'line'
-    startLineIndex :: Word32 -> Text -> Word32
+    startLineIndex :: UInt -> Text -> UInt
     startLineIndex 0 _ = 0
     startLineIndex line t' =
       case T.findIndex (== '\n') t' of

lsp/example/Reactor.hs

@@ -280,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 :: J.Word32)..10] $ \i -> do
+        forM [(0 :: J.UInt)..10] $ \i -> do
           update (ProgressAmount (Just (i * 10)) (Just "Doing stuff"))
           liftIO $ threadDelay (1 * 1000000)
   ]

lsp/src/Language/LSP/Server/Core.hs

@@ -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 Word32) (Maybe Text)
+data ProgressAmount = ProgressAmount (Maybe UInt) (Maybe Text)
 
 -- | Thrown if the user cancels a 'Cancellable' 'withProgress'/'withIndefiniteProgress'/ session
 --

lsp/test/JsonSpec.hs

@@ -99,6 +99,9 @@ instance Arbitrary HoverContents where
                     , HoverContents <$> arbitrary
                     ]
 
+instance Arbitrary UInt where
+  arbitrary = fromInteger <$> arbitrary
+
 instance Arbitrary Uri where
   arbitrary = Uri <$> arbitrary