lsp-types 1.0.0.1 → 1.1.0.0

raw patch · 15 files changed

+357/−80 lines, 15 filesdep +dependent-sumPVP ok

version bump matches the API change (PVP)

Dependencies added: dependent-sum

API changes (from Hackage documentation)

Files

• ChangeLog.md +33/−0
• lsp-types.cabal +4/−3
• src/Language/LSP/Types/CodeAction.hs +6/−0
• src/Language/LSP/Types/Completion.hs +2/−2
• src/Language/LSP/Types/Diagnostic.hs +1/−1
• src/Language/LSP/Types/DocumentLink.hs +2/−1
• src/Language/LSP/Types/Formatting.hs +1/−1
• src/Language/LSP/Types/Lens.hs +87/−44
• src/Language/LSP/Types/Message.hs +1/−1
• src/Language/LSP/Types/Method.hs +1/−1
• src/Language/LSP/Types/SignatureHelp.hs +3/−3
• src/Language/LSP/Types/WatchedFiles.hs +2/−1
• src/Language/LSP/Types/WorkspaceEdit.hs +129/−1
• src/Language/LSP/Types/WorkspaceSymbol.hs +2/−1
• src/Language/LSP/VFS.hs +83/−20

@@ -1,5 +1,38 @@ # Revision history for haskell-lsp-types +## 1.1.0.0++* Fix prepareRename reponse and prepareProvider (@kirelagin)+* Fix deriving instance of MonadUnliftIO (@banacorn)+* Add support for file and folder operations in WorkspaceEdit (@banacorn)+Instead of having TextDocumentEdit in WorkspaceEdit++```haskell+data WorkspaceEdit =+  WorkspaceEdit+    { _changes         :: Maybe WorkspaceEditMap+    , _documentChanges :: Maybe (List TextDocumentEdit)+    } deriving (Show, Read, Eq)+```+It is now replaced by a new type called DocumentChange++```haskell+data WorkspaceEdit =+  WorkspaceEdit+    { _changes         :: Maybe WorkspaceEditMap+    , _documentChanges :: Maybe (List DocumentChange)+    } deriving (Show, Read, Eq)+```+Which is just a synonym of union of WorkspaceEdit and other operations++```haskell+type DocumentChange = TextDocumentEdit |? CreateFile |? RenameFile |? DeleteFile+```+* Add new CodeAction features (isPreferred, disabled) (@pepeiborra)+* Respond to requests with missing handlers (@wz1000)+* Use Text over String in more places (@wz1000)+* Add missing lenses (@wz1000, @bubba)+ ## 1.0.0.0  1.0.0.0 is a major rework with both internal and external facing changes, and

@@ -1,5 +1,5 @@ name:                lsp-types-version:             1.0.0.1+version:             1.1.0.0 synopsis:            Haskell library for the Microsoft Language Server Protocol, data types  description:         An implementation of the types to allow language implementors to@@ -10,7 +10,7 @@ license-file:        LICENSE author:              Alan Zimmerman maintainer:          alan.zimm@gmail.com-copyright:           Alan Zimmerman, 2016-2020+copyright:           Alan Zimmerman, 2016-2021 category:            Development build-type:          Simple extra-source-files:  ChangeLog.md, README.md@@ -84,6 +84,7 @@                      , scientific                      , some                      , dependent-sum-template+                     , dependent-sum >= 0.6.2.2                      , text                      , template-haskell                      , temporary@@ -93,4 +94,4 @@  source-repository head   type:     git-  location: https://github.com/alanz/haskell-lsp+  location: https://github.com/alanz/lsp

@@ -173,6 +173,11 @@   ] deriveJSON lspOptions ''CodeActionParams +newtype Reason = Reason {_reason :: Text}+  deriving (Read, Show, Eq)++deriveJSON lspOptions ''Reason+ -- | A code action represents a change that can be performed in code, e.g. to fix a problem or -- to refactor code. --@@ -194,6 +199,7 @@     --     -- Since LSP 3.15.0     _isPreferred :: Maybe Bool,+    _disabled    :: Maybe Reason, -- ^ Marks that the code action cannot currently be applied.     -- | The workspace edit this code action performs.     _edit :: Maybe WorkspaceEdit,     -- | A command this code action executes. If a code action

@@ -303,8 +303,8 @@   parseJSON _          = mempty  makeExtendingDatatype "CompletionOptions" [''WorkDoneProgressOptions]-  [ ("_triggerCharacters", [t| Maybe [String] |])-  , ("_allCommitCharacters", [t| Maybe [String] |])+  [ ("_triggerCharacters", [t| Maybe [Text] |])+  , ("_allCommitCharacters", [t| Maybe [Text] |])   , ("_resolveProvider", [t| Maybe Bool|])   ] deriveJSON lspOptions ''CompletionOptions

@@ -82,7 +82,7 @@   Diagnostic     { _range              :: Range     , _severity           :: Maybe DiagnosticSeverity-    , _code               :: Maybe (Int |? String)+    , _code               :: Maybe (Int |? Text)     , _source             :: Maybe DiagnosticSource     , _message            :: Text     , _tags               :: Maybe (List DiagnosticTag)

@@ -10,6 +10,7 @@ import Language.LSP.Types.TextDocument import Language.LSP.Types.Uri import Language.LSP.Types.Utils+import Data.Text (Text)  data DocumentLinkClientCapabilities =   DocumentLinkClientCapabilities@@ -62,7 +63,7 @@     -- localization.     --     -- Since LSP 3.15.0-  , _tooltip :: Maybe String+  , _tooltip :: Maybe Text     -- | A data entry field that is preserved on a document link between a     -- DocumentLinkRequest and a DocumentLinkResolveRequest.   , _xdata :: Maybe Value

@@ -107,7 +107,7 @@ deriveJSON lspOptions ''DocumentOnTypeFormattingRegistrationOptions  makeExtendingDatatype "DocumentOnTypeFormattingParams" [''TextDocumentPositionParams]-  [ ("_ch", [t| String |])+  [ ("_ch", [t| Text |])   , ("_options", [t| FormattingOptions |])   ] deriveJSON lspOptions ''DocumentOnTypeFormattingParams

@@ -30,6 +30,7 @@ import           Language.LSP.Types.Implementation import           Language.LSP.Types.Initialize import           Language.LSP.Types.Location+import           Language.LSP.Types.MarkupContent import           Language.LSP.Types.Progress import           Language.LSP.Types.Registration import           Language.LSP.Types.References@@ -37,6 +38,7 @@ import           Language.LSP.Types.SignatureHelp import           Language.LSP.Types.SelectionRange import           Language.LSP.Types.ServerCapabilities+import           Language.LSP.Types.StaticRegistrationOptions import           Language.LSP.Types.DocumentSymbol import           Language.LSP.Types.TextDocument import           Language.LSP.Types.TypeDefinition@@ -51,64 +53,22 @@ -- TODO: This is out of date and very unmantainable, use TH to call all these!!  -- client capabilities-makeFieldsNoPrefix ''WorkspaceEditClientCapabilities-makeFieldsNoPrefix ''DidChangeConfigurationClientCapabilities-makeFieldsNoPrefix ''ExecuteCommandClientCapabilities makeFieldsNoPrefix ''WorkspaceClientCapabilities-makeFieldsNoPrefix ''TextDocumentSyncClientCapabilities-makeFieldsNoPrefix ''CompletionItemTagsClientCapabilities-makeFieldsNoPrefix ''CompletionItemClientCapabilities-makeFieldsNoPrefix ''CompletionItemKindClientCapabilities-makeFieldsNoPrefix ''CompletionClientCapabilities-makeFieldsNoPrefix ''HoverClientCapabilities-makeFieldsNoPrefix ''SignatureHelpSignatureInformation-makeFieldsNoPrefix ''SignatureHelpParameterInformation-makeFieldsNoPrefix ''SignatureHelpClientCapabilities-makeFieldsNoPrefix ''ReferencesClientCapabilities-makeFieldsNoPrefix ''DefinitionClientCapabilities-makeFieldsNoPrefix ''TypeDefinitionClientCapabilities-makeFieldsNoPrefix ''ImplementationClientCapabilities-makeFieldsNoPrefix ''PublishDiagnosticsClientCapabilities-makeFieldsNoPrefix ''PublishDiagnosticsTagsClientCapabilities-makeFieldsNoPrefix ''TextDocumentClientCapabilities+makeFieldsNoPrefix ''WindowClientCapabilities makeFieldsNoPrefix ''ClientCapabilities  -- --------------------------------------------------------------------- -makeFieldsNoPrefix ''CompletionOptions-makeFieldsNoPrefix ''SignatureHelpOptions-makeFieldsNoPrefix ''ExecuteCommandOptions makeFieldsNoPrefix ''SaveOptions-makeFieldsNoPrefix ''TextDocumentSyncOptions makeFieldsNoPrefix ''WorkspaceServerCapabilities makeFieldsNoPrefix ''WorkspaceFoldersServerCapabilities makeFieldsNoPrefix ''ServerCapabilities makeFieldsNoPrefix ''Registration makeFieldsNoPrefix ''RegistrationParams-makeFieldsNoPrefix ''TextDocumentRegistrationOptions makeFieldsNoPrefix ''Unregistration makeFieldsNoPrefix ''UnregistrationParams-makeFieldsNoPrefix ''DidChangeConfigurationParams-makeFieldsNoPrefix ''ConfigurationItem-makeFieldsNoPrefix ''ConfigurationParams-makeFieldsNoPrefix ''DidOpenTextDocumentParams-makeFieldsNoPrefix ''TextDocumentContentChangeEvent-makeFieldsNoPrefix ''DidChangeTextDocumentParams-makeFieldsNoPrefix ''TextDocumentChangeRegistrationOptions-makeFieldsNoPrefix ''WillSaveTextDocumentParams-makeFieldsNoPrefix ''DidSaveTextDocumentParams-makeFieldsNoPrefix ''TextDocumentSaveRegistrationOptions-makeFieldsNoPrefix ''DidCloseTextDocumentParams-makeFieldsNoPrefix ''PublishDiagnosticsParams-makeFieldsNoPrefix ''LanguageString makeFieldsNoPrefix ''ParameterInformation makeFieldsNoPrefix ''SignatureInformation-makeFieldsNoPrefix ''SignatureHelp-makeFieldsNoPrefix ''SignatureHelpRegistrationOptions-makeFieldsNoPrefix ''ReferenceContext-makeFieldsNoPrefix ''ReferenceParams-makeFieldsNoPrefix ''ExecuteCommandParams-makeFieldsNoPrefix ''ExecuteCommandRegistrationOptions makeFieldsNoPrefix ''ApplyWorkspaceEditParams makeFieldsNoPrefix ''ApplyWorkspaceEditResponseBody @@ -122,6 +82,12 @@ makeFieldsNoPrefix ''ServerInfo makeFieldsNoPrefix ''InitializedParams +-- Configuration+makeFieldsNoPrefix ''DidChangeConfigurationParams+makeFieldsNoPrefix ''ConfigurationItem+makeFieldsNoPrefix ''ConfigurationParams+makeFieldsNoPrefix ''DidChangeConfigurationClientCapabilities+ -- Watched files makeFieldsNoPrefix ''DidChangeWatchedFilesClientCapabilities makeFieldsNoPrefix ''DidChangeWatchedFilesRegistrationOptions@@ -141,13 +107,22 @@ makeFieldsNoPrefix ''Position makeFieldsNoPrefix ''Range makeFieldsNoPrefix ''Location+makeFieldsNoPrefix ''LocationLink +-- Markup+makeFieldsNoPrefix ''MarkupContent+ -- Completion makeFieldsNoPrefix ''CompletionItem makeFieldsNoPrefix ''CompletionContext makeFieldsNoPrefix ''CompletionList makeFieldsNoPrefix ''CompletionParams+makeFieldsNoPrefix ''CompletionOptions makeFieldsNoPrefix ''CompletionRegistrationOptions+makeFieldsNoPrefix ''CompletionItemTagsClientCapabilities+makeFieldsNoPrefix ''CompletionItemClientCapabilities+makeFieldsNoPrefix ''CompletionItemKindClientCapabilities+makeFieldsNoPrefix ''CompletionClientCapabilities  -- Declaration makeFieldsNoPrefix ''DeclarationClientCapabilities@@ -220,6 +195,13 @@ makeFieldsNoPrefix ''PrepareRenameParams makeFieldsNoPrefix ''RangeWithPlaceholder +-- References+makeFieldsNoPrefix ''ReferencesClientCapabilities+makeFieldsNoPrefix ''ReferenceOptions+makeFieldsNoPrefix ''ReferenceRegistrationOptions+makeFieldsNoPrefix ''ReferenceContext+makeFieldsNoPrefix ''ReferenceParams+ -- FoldingRange makeFieldsNoPrefix ''FoldingRangeClientCapabilities makeFieldsNoPrefix ''FoldingRangeOptions@@ -257,7 +239,14 @@ makeFieldsNoPrefix ''TextEdit makeFieldsNoPrefix ''VersionedTextDocumentIdentifier makeFieldsNoPrefix ''TextDocumentEdit+makeFieldsNoPrefix ''CreateFileOptions+makeFieldsNoPrefix ''CreateFile+makeFieldsNoPrefix ''RenameFileOptions+makeFieldsNoPrefix ''RenameFile+makeFieldsNoPrefix ''DeleteFileOptions+makeFieldsNoPrefix ''DeleteFile makeFieldsNoPrefix ''WorkspaceEdit+makeFieldsNoPrefix ''WorkspaceEditClientCapabilities  -- Workspace Folders makeFieldsNoPrefix ''WorkspaceFolder@@ -275,19 +264,59 @@ makeFieldsNoPrefix ''TextDocumentItem makeFieldsNoPrefix ''TextDocumentIdentifier makeFieldsNoPrefix ''TextDocumentPositionParams+makeFieldsNoPrefix ''TextDocumentSyncClientCapabilities+makeFieldsNoPrefix ''TextDocumentClientCapabilities+makeFieldsNoPrefix ''TextDocumentRegistrationOptions+makeFieldsNoPrefix ''TextDocumentSyncOptions+makeFieldsNoPrefix ''DidOpenTextDocumentParams+makeFieldsNoPrefix ''TextDocumentContentChangeEvent+makeFieldsNoPrefix ''DidChangeTextDocumentParams+makeFieldsNoPrefix ''TextDocumentChangeRegistrationOptions+makeFieldsNoPrefix ''WillSaveTextDocumentParams+makeFieldsNoPrefix ''DidSaveTextDocumentParams+makeFieldsNoPrefix ''TextDocumentSaveRegistrationOptions+makeFieldsNoPrefix ''DidCloseTextDocumentParams  -- Command makeFieldsNoPrefix ''Command+makeFieldsNoPrefix ''ExecuteCommandParams+makeFieldsNoPrefix ''ExecuteCommandRegistrationOptions+makeFieldsNoPrefix ''ExecuteCommandClientCapabilities+makeFieldsNoPrefix ''ExecuteCommandOptions  -- Diagnostic-makeFieldsNoPrefix ''Diagnostic makeFieldsNoPrefix ''DiagnosticRelatedInformation+makeFieldsNoPrefix ''Diagnostic+makeFieldsNoPrefix ''PublishDiagnosticsTagsClientCapabilities+makeFieldsNoPrefix ''PublishDiagnosticsClientCapabilities+makeFieldsNoPrefix ''PublishDiagnosticsParams  -- Hover+makeFieldsNoPrefix ''HoverClientCapabilities makeFieldsNoPrefix ''Hover+makeFieldsNoPrefix ''HoverParams+makeFieldsNoPrefix ''HoverOptions makeFieldsNoPrefix ''HoverRegistrationOptions+makeFieldsNoPrefix ''LanguageString +-- Implementation+makeFieldsNoPrefix ''ImplementationClientCapabilities+makeFieldsNoPrefix ''ImplementationOptions+makeFieldsNoPrefix ''ImplementationRegistrationOptions+makeFieldsNoPrefix ''ImplementationParams +-- Definition+makeFieldsNoPrefix ''DefinitionOptions+makeFieldsNoPrefix ''DefinitionRegistrationOptions+makeFieldsNoPrefix ''DefinitionParams+makeFieldsNoPrefix ''DefinitionClientCapabilities++-- Type Definition+makeFieldsNoPrefix ''TypeDefinitionOptions+makeFieldsNoPrefix ''TypeDefinitionRegistrationOptions+makeFieldsNoPrefix ''TypeDefinitionParams+makeFieldsNoPrefix ''TypeDefinitionClientCapabilities+ -- Window makeFieldsNoPrefix ''ShowMessageParams makeFieldsNoPrefix ''MessageActionItem@@ -299,3 +328,17 @@ makeFieldsNoPrefix ''WorkDoneProgressEndParams makeFieldsNoPrefix ''WorkDoneProgressCancelParams makeFieldsNoPrefix ''WorkDoneProgressCreateParams+makeFieldsNoPrefix ''WorkDoneProgressOptions+makeFieldsNoPrefix ''WorkDoneProgressParams+makeFieldsNoPrefix ''PartialResultParams++-- Signature Help+makeFieldsNoPrefix ''SignatureHelpSignatureInformation+makeFieldsNoPrefix ''SignatureHelpParameterInformation+makeFieldsNoPrefix ''SignatureHelpClientCapabilities+makeFieldsNoPrefix ''SignatureHelpOptions+makeFieldsNoPrefix ''SignatureHelpRegistrationOptions+makeFieldsNoPrefix ''SignatureHelp++-- Static registration+makeFieldsNoPrefix ''StaticRegistrationOptions

@@ -193,7 +193,7 @@   ResponseResult TextDocumentOnTypeFormatting  = List TextEdit   -- Rename   ResponseResult TextDocumentRename            = WorkspaceEdit-  ResponseResult TextDocumentPrepareRename     = Range |? RangeWithPlaceholder+  ResponseResult TextDocumentPrepareRename     = Maybe (Range |? RangeWithPlaceholder)   -- FoldingRange   ResponseResult TextDocumentFoldingRange      = List FoldingRange   ResponseResult TextDocumentSelectionRange    = List SelectionRange

@@ -16,7 +16,7 @@ import           Language.LSP.Types.Utils import           Data.Function (on) import Control.Applicative-import  Data.GADT.Compare.TH+import Data.GADT.Compare.TH  -- --------------------------------------------------------------------- 

@@ -59,8 +59,8 @@ -- -------------------------------------  makeExtendingDatatype "SignatureHelpOptions" [''WorkDoneProgressOptions]-  [ ("_triggerCharacters", [t| Maybe (List String) |])-  , ("_retriggerCharacters", [t| Maybe (List String) |])+  [ ("_triggerCharacters", [t| Maybe (List Text) |])+  , ("_retriggerCharacters", [t| Maybe (List Text) |])   ] deriveJSON lspOptions ''SignatureHelpOptions @@ -126,7 +126,7 @@       -- | Character that caused signature help to be triggered. This is       -- undefined when @triggerKind !==       -- SignatureHelpTriggerKind.TriggerCharacter@-    , _triggerCharacter :: Maybe String+    , _triggerCharacter :: Maybe Text       -- | 'True' if signature help was already showing when it was triggered.       --        -- Retriggers occur when the signature help is already active and can be

@@ -10,6 +10,7 @@ import Language.LSP.Types.Common import Language.LSP.Types.Uri import Language.LSP.Types.Utils+import Data.Text (Text)  -- ------------------------------------- @@ -38,7 +39,7 @@     -- - @{}@ 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,+    _globPattern :: Text,     -- | The kind of events of interest. If omitted it defaults     -- to WatchKind.Create | WatchKind.Change | WatchKind.Delete     -- which is 7.

@@ -1,11 +1,16 @@ {-# LANGUAGE DuplicateRecordFields      #-} {-# LANGUAGE TemplateHaskell            #-}+{-# LANGUAGE TypeOperators              #-} {-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-}+ module Language.LSP.Types.WorkspaceEdit where +import           Control.Monad                              (unless) import           Data.Aeson import           Data.Aeson.TH import qualified Data.HashMap.Strict                        as H+import           Data.Maybe                                 (catMaybes) import           Data.Text                                  (Text) import qualified Data.Text                                  as T @@ -38,12 +43,135 @@  -- --------------------------------------------------------------------- +-- | Options to create a file.+data CreateFileOptions =+  CreateFileOptions+    { -- | Overwrite existing file. Overwrite wins over `ignoreIfExists`+      _overwrite      :: Maybe Bool+      -- | Ignore if exists.+    , _ignoreIfExists :: Maybe Bool+    } deriving (Show, Read, Eq)++deriveJSON lspOptions ''CreateFileOptions++-- | Create file operation+data CreateFile =+  CreateFile+    { -- | The resource to create.+      _uri      :: Uri+      -- | Additional options+    , _options  :: Maybe CreateFileOptions+    } deriving (Show, Read, Eq)++instance ToJSON CreateFile where+    toJSON CreateFile{..} =+      object $ catMaybes+        [ Just $ "kind" .= ("create" :: Text)+        , Just $ "uri" .= _uri+        , ("options" .=) <$> _options+        ]++instance FromJSON CreateFile where+    parseJSON = withObject "CreateFile" $ \o -> do+        kind <- o .: "kind"+        unless (kind == ("create" :: Text)) +          $ fail $ "Expected kind \"create\" but got " ++ show kind+        _uri <- o .: "uri"+        _options <- o .:? "options"+        pure CreateFile{..}++-- Rename file options+data RenameFileOptions =+  RenameFileOptions+    { -- | Overwrite target if existing. Overwrite wins over `ignoreIfExists`+      _overwrite      :: Maybe Bool+      -- | Ignores if target exists.+    , _ignoreIfExists :: Maybe Bool+    } deriving (Show, Read, Eq)++deriveJSON lspOptions ''RenameFileOptions++-- | Rename file operation+data RenameFile =+  RenameFile+    { -- | The old (existing) location.+      _oldUri   :: Uri+      -- | The new location.+    , _newUri   :: Uri+      -- | Rename options.+    , _options  :: Maybe RenameFileOptions+    } deriving (Show, Read, Eq)++instance ToJSON RenameFile where+    toJSON RenameFile{..} =+      object $ catMaybes+        [ Just $ "kind" .= ("rename" :: Text)+        , Just $ "oldUri" .= _oldUri+        , Just $ "newUri" .= _newUri+        , ("options" .=) <$> _options+        ]++instance FromJSON RenameFile where+    parseJSON = withObject "RenameFile" $ \o -> do+        kind <- o .: "kind"+        unless (kind == ("rename" :: Text)) +          $ fail $ "Expected kind \"rename\" but got " ++ show kind+        _oldUri <- o .: "oldUri"+        _newUri <- o .: "newUri"+        _options <- o .:? "options"+        pure RenameFile{..}++-- Delete file options+data DeleteFileOptions =+  DeleteFileOptions+    { -- | Delete the content recursively if a folder is denoted.+      _recursive          :: Maybe Bool+      -- | Ignore the operation if the file doesn't exist.+    , _ignoreIfNotExists  :: Maybe Bool+    } deriving (Show, Read, Eq)++deriveJSON lspOptions ''DeleteFileOptions++-- | Delete file operation+data DeleteFile =+  DeleteFile+    { -- | The file to delete.+      _uri      :: Uri+      -- | Delete options.+    , _options  :: Maybe DeleteFileOptions+    } deriving (Show, Read, Eq)++instance ToJSON DeleteFile where+    toJSON DeleteFile{..} =+      object $ catMaybes+        [ Just $ "kind" .= ("delete" :: Text)+        , Just $ "uri" .= _uri+        , ("options" .=) <$> _options+        ]++instance FromJSON DeleteFile where+    parseJSON = withObject "DeleteFile" $ \o -> do+        kind <- o .: "kind"+        unless (kind == ("delete" :: Text)) +          $ fail $ "Expected kind \"delete\" but got " ++ show kind+        _uri <- o .: "uri"+        _options <- o .:? "options"+        pure DeleteFile{..}+++-- ---------------------------------------------------------------------++-- | `TextDocumentEdit |? CreateFile |? RenameFile |? DeleteFile` is a bit mouthful, here's the synonym+type DocumentChange = TextDocumentEdit |? CreateFile |? RenameFile |? DeleteFile++-- ---------------------------------------------------------------------+ type WorkspaceEditMap = H.HashMap Uri (List TextEdit)  data WorkspaceEdit =   WorkspaceEdit     { _changes         :: Maybe WorkspaceEditMap-    , _documentChanges :: Maybe (List TextDocumentEdit)+    , _documentChanges :: Maybe (List DocumentChange)     } deriving (Show, Read, Eq)  instance Semigroup WorkspaceEdit where

@@ -9,6 +9,7 @@ import Language.LSP.Types.DocumentSymbol import Language.LSP.Types.Progress import Language.LSP.Types.Utils+import Data.Text (Text)  data WorkspaceSymbolKindClientCapabilities =   WorkspaceSymbolKindClientCapabilities@@ -71,6 +72,6 @@   [ ''WorkDoneProgressParams   , ''PartialResultParams   ]-  [("_query", [t| String |])]+  [("_query", [t| Text |])]  deriveJSON lspOptions ''WorkspaceSymbolParams

@@ -129,41 +129,104 @@  -- --------------------------------------------------------------------- +applyCreateFile :: J.CreateFile -> VFS -> VFS+applyCreateFile (J.CreateFile uri options) = +  updateVFS $ Map.insertWith +                (\ new old -> if shouldOverwrite then new else old)+                (J.toNormalizedUri uri)+                (VirtualFile 0 0 (Rope.fromText ""))+  where +    shouldOverwrite :: Bool +    shouldOverwrite = case options of +        Nothing                                               -> False  -- default+        Just (J.CreateFileOptions Nothing       Nothing     ) -> False  -- default+        Just (J.CreateFileOptions Nothing       (Just True) ) -> False  -- `ignoreIfExists` is True +        Just (J.CreateFileOptions Nothing       (Just False)) -> True   -- `ignoreIfExists` is False +        Just (J.CreateFileOptions (Just True)   Nothing     ) -> True   -- `overwrite` is True+        Just (J.CreateFileOptions (Just True)   (Just True) ) -> True   -- `overwrite` wins over `ignoreIfExists`+        Just (J.CreateFileOptions (Just True)   (Just False)) -> True   -- `overwrite` is True+        Just (J.CreateFileOptions (Just False)  Nothing     ) -> False  -- `overwrite` is False+        Just (J.CreateFileOptions (Just False)  (Just True) ) -> False  -- `overwrite` is False+        Just (J.CreateFileOptions (Just False)  (Just False)) -> False  -- `overwrite` wins over `ignoreIfExists`++applyRenameFile :: J.RenameFile -> VFS -> VFS+applyRenameFile (J.RenameFile oldUri' newUri' options) vfs = +  let oldUri = J.toNormalizedUri oldUri'+      newUri = J.toNormalizedUri newUri'+  in  case Map.lookup oldUri (vfsMap vfs) of +        -- nothing to rename +        Nothing -> vfs +        Just file -> case Map.lookup newUri (vfsMap vfs) of +          -- the target does not exist, just move over +          Nothing -> updateVFS (Map.insert newUri file . Map.delete oldUri) vfs+          Just _  -> if shouldOverwrite +                      then updateVFS (Map.insert newUri file . Map.delete oldUri) vfs+                      else vfs +  where +    shouldOverwrite :: Bool +    shouldOverwrite = case options of +        Nothing                                               -> False  -- default+        Just (J.RenameFileOptions Nothing       Nothing     ) -> False  -- default+        Just (J.RenameFileOptions Nothing       (Just True) ) -> False  -- `ignoreIfExists` is True +        Just (J.RenameFileOptions Nothing       (Just False)) -> True   -- `ignoreIfExists` is False +        Just (J.RenameFileOptions (Just True)   Nothing     ) -> True   -- `overwrite` is True+        Just (J.RenameFileOptions (Just True)   (Just True) ) -> True   -- `overwrite` wins over `ignoreIfExists`+        Just (J.RenameFileOptions (Just True)   (Just False)) -> True   -- `overwrite` is True+        Just (J.RenameFileOptions (Just False)  Nothing     ) -> False  -- `overwrite` is False+        Just (J.RenameFileOptions (Just False)  (Just True) ) -> False  -- `overwrite` is False+        Just (J.RenameFileOptions (Just False)  (Just False)) -> False  -- `overwrite` wins over `ignoreIfExists`++-- NOTE: we are ignoring the `recursive` option here because we don't know which file is a directory+applyDeleteFile :: J.DeleteFile -> VFS -> VFS+applyDeleteFile (J.DeleteFile uri _options) = +  updateVFS $ Map.delete (J.toNormalizedUri uri)+++applyTextDocumentEdit :: J.TextDocumentEdit -> VFS -> IO VFS+applyTextDocumentEdit (J.TextDocumentEdit vid (J.List edits)) vfs = do+  -- all edits are supposed to be applied at once+  -- so apply from bottom up so they don't affect others+  let sortedEdits = sortOn (Down . (^. J.range)) edits+      changeEvents = map editToChangeEvent sortedEdits+      ps = J.DidChangeTextDocumentParams vid (J.List changeEvents)+      notif = J.NotificationMessage "" J.STextDocumentDidChange ps+  let (vfs',ls) = changeFromClientVFS vfs notif+  mapM_ (debugM "haskell-lsp.applyTextDocumentEdit") ls+  return vfs'++  where +    editToChangeEvent (J.TextEdit range text) = J.TextDocumentContentChangeEvent (Just range) Nothing text++applyDocumentChange :: J.DocumentChange -> VFS -> IO VFS +applyDocumentChange (J.InL               change)   = applyTextDocumentEdit change+applyDocumentChange (J.InR (J.InL        change))  = return . applyCreateFile change+applyDocumentChange (J.InR (J.InR (J.InL change))) = return . applyRenameFile change+applyDocumentChange (J.InR (J.InR (J.InR change))) = return . applyDeleteFile change+ -- ^ Applies the changes from a 'ApplyWorkspaceEditRequest' to the 'VFS' changeFromServerVFS :: VFS -> J.Message 'J.WorkspaceApplyEdit -> IO VFS changeFromServerVFS initVfs (J.RequestMessage _ _ _ params) = do   let J.ApplyWorkspaceEditParams _label edit = params       J.WorkspaceEdit mChanges mDocChanges = edit   case mDocChanges of-    Just (J.List textDocEdits) -> applyEdits textDocEdits+    Just (J.List docChanges) -> applyDocumentChanges docChanges     Nothing -> case mChanges of-      Just cs -> applyEdits $ HashMap.foldlWithKey' changeToTextDocumentEdit [] cs+      Just cs -> applyDocumentChanges $ map J.InL $ HashMap.foldlWithKey' changeToTextDocumentEdit [] cs       Nothing -> do         debugM "haskell-lsp.changeVfs" "No changes"         return initVfs    where-     changeToTextDocumentEdit acc uri edits =       acc ++ [J.TextDocumentEdit (J.VersionedTextDocumentIdentifier uri (Just 0)) edits] -    -- applyEdits :: [J.TextDocumentEdit] -> VFS-    applyEdits :: [J.TextDocumentEdit] -> IO VFS-    applyEdits = foldM f initVfs . sortOn (^. J.textDocument . J.version)--    f :: VFS -> J.TextDocumentEdit -> IO VFS-    f vfs (J.TextDocumentEdit vid (J.List edits)) = do-      -- all edits are supposed to be applied at once-      -- so apply from bottom up so they don't affect others-      let sortedEdits = sortOn (Down . (^. J.range)) edits-          changeEvents = map editToChangeEvent sortedEdits-          ps = J.DidChangeTextDocumentParams vid (J.List changeEvents)-          notif = J.NotificationMessage "" J.STextDocumentDidChange ps-      let (vfs',ls) = changeFromClientVFS vfs notif-      mapM_ (debugM "haskell-lsp.changeFromServerVFS") ls-      return vfs'--    editToChangeEvent (J.TextEdit range text) = J.TextDocumentContentChangeEvent (Just range) Nothing text+    applyDocumentChanges :: [J.DocumentChange] -> IO VFS +    applyDocumentChanges = foldM (flip applyDocumentChange) initVfs . sortOn project+        +    -- for sorting [DocumentChange]+    project :: J.DocumentChange -> J.TextDocumentVersion -- type TextDocumentVersion = Maybe Int+    project (J.InL textDocumentEdit) = textDocumentEdit ^. J.textDocument . J.version+    project _ = Nothing  -- --------------------------------------------------------------------- virtualFileName :: FilePath -> J.NormalizedUri -> VirtualFile -> FilePath