haskell-lsp-types 0.20.0.0 → 0.21.0.0

raw patch · 9 files changed

+318/−19 lines, 9 filesdep +binaryPVP ok

version bump matches the API change (PVP)

Dependencies added: binary

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• haskell-lsp-types.cabal +2/−1
• src/Language/Haskell/LSP/Types/Capabilities.hs +14/−1
• src/Language/Haskell/LSP/Types/ClientCapabilities.hs +28/−0
• src/Language/Haskell/LSP/Types/Completion.hs +16/−0
• src/Language/Haskell/LSP/Types/DataTypesJSON.hs +93/−0
• src/Language/Haskell/LSP/Types/Diagnostic.hs +51/−0
• src/Language/Haskell/LSP/Types/Lens.hs +5/−0
• src/Language/Haskell/LSP/Types/Uri.hs +98/−17

@@ -1,7 +1,18 @@ # Revision history for haskell-lsp-types +## 0.21.0.0++* Stop getCompletionPrefix from crashing if beforePos is empty+* Add DidChangeWatchedFilesRegistrationOptions+* Add NormalizedFilePath from ghcide+* Add diagnostic and completion tags+* Fix language server example+* Correctly fix the problem with '$/' notifications+* Add azure ci+ ## 0.20.0.0 +* Force utf8 encoding when writing vfs temp files * Don't log errors for '$/' notifications (@jinwoo) * Force utf8 encoding when writing vfs temp files (@jneira) * Store a hash in a NormalizedUri (@mpickering)

@@ -1,5 +1,5 @@ name:                haskell-lsp-types-version:             0.20.0.0+version:             0.21.0.0 synopsis:            Haskell library for the Microsoft Language Server Protocol, data types  description:         An implementation of the types to allow language implementors to@@ -48,6 +48,7 @@   -- ghc-options:         -Werror   build-depends:       base >= 4.9 && < 4.14                      , aeson >=1.2.2.0+                     , binary                      , bytestring                      , data-default                      , deepseq

@@ -103,7 +103,7 @@           (Just (DocumentLinkClientCapabilities dynamicReg))           (since 3 6 (ColorProviderClientCapabilities dynamicReg))           (Just (RenameClientCapabilities dynamicReg (since 3 12 True)))-          (Just (PublishDiagnosticsClientCapabilities (since 3 7 True)))+          (Just publishDiagnosticsCapabilities)           (since 3 10 foldingRangeCapability)     sync =       SynchronizationTextDocumentClientCapabilities@@ -125,10 +125,14 @@       (since 3 3 (List [MkPlainText, MkMarkdown]))       (Just True)       (since 3 9 True)+      (since 3 15 completionItemTagsCapabilities)      completionItemKindCapabilities =       CompletionItemKindClientCapabilities (Just ciKs) +    completionItemTagsCapabilities =+      CompletionItemTagsClientCapabilities (List [ CtDeprecated ])+     ciKs       | maj >= 3 && min >= 4 = List (oldCiKs ++ newCiKs)       | otherwise            = List oldCiKs@@ -205,6 +209,15 @@         dynamicReg         Nothing         (Just False)++    publishDiagnosticsCapabilities =+      PublishDiagnosticsClientCapabilities+        (since 3 7 True)+        (since 3 15 publishDiagnosticsTagsCapabilities)++    publishDiagnosticsTagsCapabilities =+      PublishDiagnosticsTagsClientCapabilities+        (List [ DtUnnecessary, DtDeprecated ])      dynamicReg       | maj >= 3  = Just True

@@ -9,6 +9,7 @@ import Language.Haskell.LSP.Types.Constants import Language.Haskell.LSP.Types.CodeAction import Language.Haskell.LSP.Types.Completion+import Language.Haskell.LSP.Types.Diagnostic import Language.Haskell.LSP.Types.List import Language.Haskell.LSP.Types.MarkupContent import Language.Haskell.LSP.Types.Symbol@@ -637,6 +638,14 @@  -- ------------------------------------- +data CompletionItemTagsClientCapabilities =+  CompletionItemTagsClientCapabilities+    { -- | The tag supported by the client.+      _valueSet :: List CompletionItemTag+    } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''CompletionItemTagsClientCapabilities)+ data CompletionItemClientCapabilities =   CompletionItemClientCapabilities     { -- | Client supports snippets as insert text.@@ -659,6 +668,12 @@        -- | Client supports the preselect property on a completion item.     , _preselectSupport :: Maybe Bool++      -- | Client supports the tag property on a completion item. Clients+      -- supporting tags have to handle unknown tags gracefully. Clients+      -- especially need to preserve unknown tags when sending a+      -- completion item back to the server in a resolve call.+    , _tagSupport :: Maybe CompletionItemTagsClientCapabilities     } deriving (Show, Read, Eq)  $(deriveJSON lspOptions ''CompletionItemClientCapabilities)@@ -910,10 +925,23 @@  -- ------------------------------------- +data PublishDiagnosticsTagsClientCapabilities =+  PublishDiagnosticsTagsClientCapabilities+    { -- | The tags supported by the client.+      _valueSet :: List DiagnosticTag+    } deriving (Show, Read, Eq)++$(deriveJSON lspOptions ''PublishDiagnosticsTagsClientCapabilities)+ data PublishDiagnosticsClientCapabilities =   PublishDiagnosticsClientCapabilities     { -- | Whether the clients accepts diagnostics with related information.       _relatedInformation :: Maybe Bool+      -- | Client supports the tag property to provide metadata about a+      -- diagnostic.+      --+      -- Clients supporting tags have to handle unknown tags gracefully.+    , _tagSupport :: Maybe PublishDiagnosticsTagsClientCapabilities     } deriving (Show, Read, Eq)  $(deriveJSON lspOptions ''PublishDiagnosticsClientCapabilities)

@@ -102,7 +102,18 @@   parseJSON (A.Number 25) = pure CiTypeParameter   parseJSON _             = mempty +data CompletionItemTag+  -- | Render a completion as obsolete, usually using a strike-out.+  = CtDeprecated+  deriving (Eq, Ord, Show, Read) +instance A.ToJSON CompletionItemTag where+  toJSON CtDeprecated  = A.Number 1++instance A.FromJSON CompletionItemTag where+  parseJSON (A.Number 1) = pure CtDeprecated+  parseJSON _            = mempty+ -- --------------------------------------------------------------------- {- Completion Request@@ -194,6 +205,10 @@      */     kind?: number;     /**+     * Tags for this completion item.+     */+    tags?: CompletionItemTag[];+    /**      * A human-readable string with additional information      * about this item, like type or symbol information.      */@@ -326,6 +341,7 @@                        -- the text that is inserted when selecting this                        -- completion.     , _kind                :: Maybe CompletionItemKind+    , _tags                :: List CompletionItemTag -- ^ Tags for this completion item.     , _detail              :: Maybe Text -- ^ A human-readable string with additional                               -- information about this item, like type or                               -- symbol information.

@@ -8,6 +8,7 @@ {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE TemplateHaskell            #-} {-# LANGUAGE TypeSynonymInstances       #-}+{-# LANGUAGE ScopedTypeVariables        #-}  module Language.Haskell.LSP.Types.DataTypesJSON where @@ -15,6 +16,8 @@ import qualified Data.Aeson                                 as A import           Data.Aeson.TH import           Data.Aeson.Types+import           Data.Bits                                  (testBit)+import           Data.Scientific                            (floatingOrInteger) import           Data.Text                                  (Text) import qualified Data.Text                                  as T import           Language.Haskell.LSP.Types.ClientCapabilities@@ -1092,6 +1095,96 @@ type UnregisterCapabilityRequest = RequestMessage ServerMethod UnregistrationParams ()  type UnregisterCapabilityResponse = ResponseMessage ()++-- ---------------------------------------------------------------------++-- /**+--  * Describe options to be used when registering for file system change events.+--  */+-- export interface DidChangeWatchedFilesRegistrationOptions {+-- 	/**+-- 	 * The watchers to register.+-- 	 */+-- 	watchers: FileSystemWatcher[];+-- }+--+-- export interface FileSystemWatcher {+-- 	/**+-- 	 * The  glob pattern to watch.+-- 	 *+-- 	 * Glob patterns can have the following syntax:+-- 	 * - `*` to match one or more characters in a path segment+-- 	 * - `?` to match on one character in a path segment+-- 	 * - `**` to match any number of path segments, including none+-- 	 * - `{}` to group conditions (e.g. `**​/*.{ts,js}` matches all TypeScript and JavaScript files)+-- 	 * - `[]` to declare a range of characters to match in a path segment (e.g., `example.[0-9]` to match on `example.0`, `example.1`, …)+-- 	 * - `[!...]` to negate a range of characters to match in a path segment (e.g., `example.[!0-9]` to match on `example.a`, `example.b`, but not `example.0`)+-- 	 */+-- 	globPattern: string;+--+-- 	/**+-- 	 * The kind of events of interest. If omitted it defaults+-- 	 * to WatchKind.Create | WatchKind.Change | WatchKind.Delete+-- 	 * which is 7.+-- 	 */+-- 	kind?: number;+-- }+--+-- export namespace WatchKind {+-- 	/**+-- 	 * Interested in create events.+-- 	 */+-- 	export const Create = 1;+--+-- 	/**+-- 	 * Interested in change events+-- 	 */+-- 	export const Change = 2;+--+-- 	/**+-- 	 * Interested in delete events+-- 	 */+-- 	export const Delete = 4;+-- }++data DidChangeWatchedFilesRegistrationOptions =+  DidChangeWatchedFilesRegistrationOptions {+    _watchers :: List FileSystemWatcher+  } deriving (Show, Read, Eq)++data FileSystemWatcher =+  FileSystemWatcher {+    _globPattern :: String,+    _kind :: Maybe WatchKind+  } deriving (Show, Read, Eq)++data WatchKind =+  WatchKind {+    -- | Watch for create events+    _watchCreate :: Bool,+    -- | Watch for change events+    _watchChange :: Bool,+    -- | Watch for delete events+    _watchDelete :: Bool+  } deriving (Show, Read, Eq)++instance A.ToJSON WatchKind where+  toJSON wk = A.Number (createNum + changeNum + deleteNum)+    where+      createNum = if _watchCreate wk then 0x1 else 0x0+      changeNum = if _watchChange wk then 0x2 else 0x0+      deleteNum = if _watchDelete wk then 0x4 else 0x0++instance A.FromJSON WatchKind where+  parseJSON (A.Number n)+    | Right i <- floatingOrInteger n :: Either Double Int+    , 0 <= i && i <= 7 =+        pure $ WatchKind (testBit i 0x0) (testBit i 0x1) (testBit i 0x2)+    | otherwise = mempty+  parseJSON _            = mempty++deriveJSON lspOptions ''DidChangeWatchedFilesRegistrationOptions+deriveJSON lspOptions ''FileSystemWatcher  -- --------------------------------------------------------------------- {-

@@ -59,6 +59,49 @@   parseJSON (A.Number 4) = pure DsHint   parseJSON _            = mempty +{-+The diagnostic tags.++export namespace DiagnosticTag {+    /**+     * Unused or unnecessary code.+     *+     * Clients are allowed to render diagnostics with this tag faded out instead of having+     * an error squiggle.+     */+    export const Unnecessary: 1;+    /**+     * Deprecated or obsolete code.+     *+     * Clients are allowed to rendered diagnostics with this tag strike through.+     */+    export const Deprecated: 2;+}+-}+data DiagnosticTag+  -- | Unused or unnecessary code.+  --+  -- Clients are allowed to render diagnostics with this tag faded out+  -- instead of having an error squiggle.+  = DtUnnecessary+  -- | Deprecated or obsolete code.+  --+  -- Clients are allowed to rendered diagnostics with this tag strike+  -- through.+  | DtDeprecated+  deriving (Eq, Ord, Show, Read, Generic)++instance NFData DiagnosticTag++instance A.ToJSON DiagnosticTag where+  toJSON DtUnnecessary = A.Number 1+  toJSON DtDeprecated  = A.Number 2++instance A.FromJSON DiagnosticTag where+  parseJSON (A.Number 1) = pure DtUnnecessary+  parseJSON (A.Number 2) = pure DtDeprecated+  parseJSON _            = mempty+ -- --------------------------------------------------------------------- {- Represents a related message and source code location for a diagnostic. This should be@@ -126,6 +169,13 @@     message: string;      /**+     * Additional metadata about the diagnostic.+     *+     * @since 3.15.0+     */+    tags?: DiagnosticTag[];++    /**      * An array of related diagnostic information, e.g. when symbol-names within      * a scope collide all definitions can be marked via this property.      */@@ -150,6 +200,7 @@     , _code               :: Maybe NumberOrString     , _source             :: Maybe DiagnosticSource     , _message            :: Text+    , _tags               :: Maybe (List DiagnosticTag)     , _relatedInformation :: Maybe (List DiagnosticRelatedInformation)     } deriving (Show, Read, Eq, Ord, Generic) 

@@ -32,6 +32,7 @@ makeFieldsNoPrefix ''ExecuteClientCapabilities makeFieldsNoPrefix ''WorkspaceClientCapabilities makeFieldsNoPrefix ''SynchronizationTextDocumentClientCapabilities+makeFieldsNoPrefix ''CompletionItemTagsClientCapabilities makeFieldsNoPrefix ''CompletionItemClientCapabilities makeFieldsNoPrefix ''CompletionItemKindClientCapabilities makeFieldsNoPrefix ''CompletionClientCapabilities@@ -56,6 +57,7 @@ makeFieldsNoPrefix ''ColorProviderClientCapabilities makeFieldsNoPrefix ''RenameClientCapabilities makeFieldsNoPrefix ''PublishDiagnosticsClientCapabilities+makeFieldsNoPrefix ''PublishDiagnosticsTagsClientCapabilities makeFieldsNoPrefix ''TextDocumentClientCapabilities makeFieldsNoPrefix ''ClientCapabilities @@ -77,6 +79,9 @@ makeFieldsNoPrefix ''InitializeResponseCapabilities makeFieldsNoPrefix ''Registration makeFieldsNoPrefix ''RegistrationParams+makeFieldsNoPrefix ''DidChangeWatchedFilesRegistrationOptions+makeFieldsNoPrefix ''FileSystemWatcher+makeFieldsNoPrefix ''WatchKind makeFieldsNoPrefix ''TextDocumentRegistrationOptions makeFieldsNoPrefix ''Unregistration makeFieldsNoPrefix ''UnregistrationParams

@@ -1,15 +1,39 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-}-module Language.Haskell.LSP.Types.Uri where+module Language.Haskell.LSP.Types.Uri+  ( Uri(..)+  , uriToFilePath+  , filePathToUri+  , NormalizedUri(..)+  , toNormalizedUri+  , fromNormalizedUri+  , NormalizedFilePath(..)+  , toNormalizedFilePath+  , fromNormalizedFilePath+  , normalizedFilePathToUri+  , uriToNormalizedFilePath+  -- Private functions+  , platformAwareUriToFilePath+  , platformAwareFilePathToUri+  )+  where  import           Control.DeepSeq import qualified Data.Aeson                                 as A+import           Data.Binary                                (Binary, Get, put, get) import           Data.Hashable+import           Data.List                                  (isPrefixOf, stripPrefix)+#if __GLASGOW_HASKELL__ < 804+import           Data.Monoid                                ((<>))+#endif+import           Data.String                                (IsString, fromString) import           Data.Text                                  (Text) import qualified Data.Text                                  as T import           GHC.Generics import           Network.URI hiding (authority)+import qualified System.FilePath                            as FP import qualified System.FilePath.Posix                      as FPP import qualified System.FilePath.Windows                    as FPW import qualified System.Info@@ -19,10 +43,6 @@  instance NFData Uri --- | When URIs are supposed to be used as keys, it is important to normalize--- the percent encoding in the URI since URIs that only differ--- when it comes to the percent-encoding should be treated as equivalent.--- -- If you care about performance then you should use a hash map. The keys -- are cached in order to make hashing very fast. data NormalizedUri = NormalizedUri !Int !Text@@ -35,11 +55,28 @@ instance Hashable NormalizedUri where   hash (NormalizedUri h _) = h +instance NFData NormalizedUri++isUnescapedInUriPath :: SystemOS -> Char -> Bool+isUnescapedInUriPath systemOS c+   | systemOS == windowsOS = isUnreserved c || c `elem` [':', '\\', '/']+   | otherwise = isUnreserved c || c == '/'++-- | When URIs are supposed to be used as keys, it is important to normalize+-- the percent encoding in the URI since URIs that only differ+-- when it comes to the percent-encoding should be treated as equivalent.+normalizeUriEscaping :: String -> String+normalizeUriEscaping uri =+  case stripPrefix (fileScheme ++ "//") uri of+    Just p -> fileScheme ++ "//" ++ (escapeURIPath $ unEscapeString p)+    Nothing -> escapeURIString isUnescapedInURI $ unEscapeString uri+  where escapeURIPath = escapeURIString (isUnescapedInUriPath System.Info.os)+ toNormalizedUri :: Uri -> NormalizedUri toNormalizedUri uri = NormalizedUri (hash norm) norm   where (Uri t) = maybe uri filePathToUri (uriToFilePath uri)-        -- To ensure all `Uri`s have the file path like the created ones by `filePathToUri`-        norm = T.pack $ escapeURIString isUnescapedInURI $ unEscapeString $ T.unpack t+        -- To ensure all `Uri`s have the file path normalized+        norm = T.pack (normalizeUriEscaping (T.unpack t))  fromNormalizedUri :: NormalizedUri -> Uri fromNormalizedUri (NormalizedUri _ t) = Uri t@@ -55,6 +92,7 @@ uriToFilePath :: Uri -> Maybe FilePath uriToFilePath = platformAwareUriToFilePath System.Info.os +{-# WARNING platformAwareUriToFilePath "This function is considered private. Use normalizedFilePathToUri instead." #-} platformAwareUriToFilePath :: String -> Uri -> Maybe FilePath platformAwareUriToFilePath systemOS (Uri uri) = do   URI{..} <- parseURI $ T.unpack uri@@ -74,12 +112,15 @@   if systemOS /= windowsOS || null srcPath then srcPath     else let       firstSegment:rest = (FPP.splitDirectories . tail) srcPath  -- Drop leading '/' for absolute Windows paths-      drive = if FPW.isDrive firstSegment then FPW.addTrailingPathSeparator firstSegment else firstSegment+      drive = if FPW.isDrive firstSegment +              then FPW.addTrailingPathSeparator firstSegment +              else firstSegment       in FPW.joinDrive drive $ FPW.joinPath rest  filePathToUri :: FilePath -> Uri-filePathToUri = platformAwareFilePathToUri System.Info.os+filePathToUri = (platformAwareFilePathToUri System.Info.os) . FP.normalise +{-# WARNING platformAwareFilePathToUri "This function is considered private. Use normalizedUriToFilePath instead." #-} platformAwareFilePathToUri :: SystemOS -> FilePath -> Uri platformAwareFilePathToUri systemOS fp = Uri . T.pack . show $ URI   { uriScheme = fileScheme@@ -94,22 +135,62 @@   | systemOS == windowsOS = '/' : escapedPath   | otherwise = escapedPath   where-    (splitDirectories, splitDrive, normalise)+    (splitDirectories, splitDrive)       | systemOS == windowsOS =-          (FPW.splitDirectories, FPW.splitDrive, FPW.normalise)+          (FPW.splitDirectories, FPW.splitDrive)       | otherwise =-          (FPP.splitDirectories, FPP.splitDrive, FPP.normalise)+          (FPP.splitDirectories, FPP.splitDrive)     escapedPath =-        case splitDrive (normalise srcPath) of+        case splitDrive srcPath of             (drv, rest) ->                 convertDrive drv `FPP.joinDrive`-                FPP.joinPath (map (escapeURIString unescaped) $ splitDirectories rest)+                FPP.joinPath (map (escapeURIString (isUnescapedInUriPath systemOS)) $ splitDirectories rest)     -- splitDirectories does not remove the path separator after the drive so     -- we do a final replacement of \ to /     convertDrive drv       | systemOS == windowsOS && FPW.hasTrailingPathSeparator drv =           FPP.addTrailingPathSeparator (init drv)       | otherwise = drv-    unescaped c-      | systemOS == windowsOS = isUnreserved c || c `elem` [':', '\\', '/']-      | otherwise = isUnreserved c || c == '/'++-- | Newtype wrapper around FilePath that always has normalized slashes.+-- The NormalizedUri and hash of the FilePath are cached to avoided+-- repeated normalisation when we need to compute them (which is a lot).+--+-- This is one of the most performance critical parts of ghcide, do not+-- modify it without profiling.+data NormalizedFilePath = NormalizedFilePath NormalizedUri !FilePath+    deriving (Generic, Eq, Ord)++instance NFData NormalizedFilePath++instance Binary NormalizedFilePath where+  put (NormalizedFilePath _ fp) = put fp+  get = do+    v <- Data.Binary.get :: Get FilePath+    return (toNormalizedFilePath v)++instance Show NormalizedFilePath where+  show (NormalizedFilePath _ fp) = "NormalizedFilePath " ++ show fp++instance Hashable NormalizedFilePath where+  hash (NormalizedFilePath uri _) = hash uri++instance IsString NormalizedFilePath where+    fromString = toNormalizedFilePath++toNormalizedFilePath :: FilePath -> NormalizedFilePath+toNormalizedFilePath fp = NormalizedFilePath nuri nfp+  where nfp = FP.normalise fp+        uriPath = platformAdjustToUriPath System.Info.os nfp+        nuriStr = T.pack $ fileScheme <> "//" <> uriPath+        nuri = NormalizedUri (hash nuriStr) nuriStr++fromNormalizedFilePath :: NormalizedFilePath -> FilePath+fromNormalizedFilePath (NormalizedFilePath _ fp) = fp++normalizedFilePathToUri :: NormalizedFilePath -> NormalizedUri+normalizedFilePathToUri (NormalizedFilePath uri _) = uri++uriToNormalizedFilePath :: NormalizedUri -> Maybe NormalizedFilePath+uriToNormalizedFilePath nuri = fmap (NormalizedFilePath nuri) mbFilePath+  where mbFilePath = platformAwareUriToFilePath System.Info.os (fromNormalizedUri nuri)