Use capabilities to select text edit payload

Fix inverted replacement range

src/LanguageServer/IdePurescript/Assist.purs

@@ -39,7 +39,7 @@ lineRange pos@(Position { line, character }) = Range
 
 caseSplit :: DocumentStore -> Settings -> ServerState -> Array Foreign -> Aff Unit
 caseSplit docs settings state args = do
-  let ServerState { port, conn } = state
+  let ServerState { port, conn, clientCapabilities } = state
   case port, conn, args of
     Just port', Just conn', [ argUri, argLine, argChar, argType ]
         | Right uri <- runExcept $ readString argUri
@@ -53,7 +53,7 @@ caseSplit docs settings state args = do
             case identifierAtPoint lineText char of
                 Just { range: { left, right } } -> do
                     lines <- eitherToErr $ P.caseSplit port' lineText left right false tyStr
-                    let edit = makeWorkspaceEdit (DocumentUri uri) version (lineRange' line char) $ intercalate "\n" $ map trim lines
+                    let edit = makeWorkspaceEdit clientCapabilities (DocumentUri uri) version (lineRange' line char) $ intercalate "\n" $ map trim lines
                     void $ applyEdit conn' edit
                 _ -> do liftEffect $ log conn' "fail identifier"
                         pure unit
@@ -66,7 +66,7 @@ caseSplit docs settings state args = do
 
 addClause :: DocumentStore -> Settings -> ServerState -> Array Foreign -> Aff Unit
 addClause docs settings state args = do
-  let ServerState { port, conn } = state
+  let ServerState { port, conn, clientCapabilities } = state
   case port, conn, args of
     Just port', Just conn', [ argUri, argLine, argChar ]
         | Right uri <- runExcept $ readString argUri
@@ -79,7 +79,7 @@ addClause docs settings state args = do
             case identifierAtPoint lineText char of
                 Just { range: { left, right } } -> do
                     lines <- eitherToErr $ P.addClause port' lineText false
-                    let edit = makeWorkspaceEdit (DocumentUri uri) version (lineRange' line char) $ intercalate "\n" $ map trim lines
+                    let edit = makeWorkspaceEdit clientCapabilities (DocumentUri uri) version (lineRange' line char) $ intercalate "\n" $ map trim lines
                     void $ applyEdit conn' edit
                 _ -> pure unit
             pure unit
@@ -97,8 +97,7 @@ decodeTypoResult obj = do
   pure $ TypoResult { identifier, mod }
 
 fixTypo :: Notify -> DocumentStore -> Settings -> ServerState -> Array Foreign -> Aff Foreign
-fixTypo log docs settings state args = do
-  let ServerState { port, conn, modules } = state
+fixTypo log docs settings state@(ServerState { port, conn, modules, clientCapabilities }) args = do
   (unsafeToForeign <<< map encodeTypoResult) <$> case port, conn, args !! 0, args !! 1, args !! 2 of
     Just port', Just conn', Just argUri, Just argLine, Just argChar
       | Right uri <- runExcept $ readString argUri
@@ -122,16 +121,16 @@ fixTypo log docs settings state args = do
     emptyRes = unsafeToForeign []
     convertRes (TypeInfo { identifier, module' }) = TypoResult { identifier, mod: module' }
     replace conn uri version line {left, right} word mod = do 
-      let range = Range { start: Position { line, character: right }
-                        , end: Position { line, character: left }
+      let range = Range { start: Position { line, character: left }
+                        , end: Position { line, character: right }
                         }
-          edit = makeWorkspaceEdit (DocumentUri uri) version range word
+          edit = makeWorkspaceEdit clientCapabilities (DocumentUri uri) version range word
       void $ applyEdit conn edit
       addCompletionImport log docs settings state [ unsafeToForeign word, unsafeToForeign mod, unsafeToForeign Nothing, unsafeToForeign uri ]
 
 fillTypedHole :: Notify -> DocumentStore -> Settings -> ServerState -> Array Foreign -> Aff Unit
 fillTypedHole logFn docs settings state args = do
-  let ServerState { port, conn } = state
+  let ServerState { port, conn, clientCapabilities } = state
   case port, conn, args of
     Just port', Just conn', [ _, argUri, range', argChoice ]
       | Right range <- runExcept $ readRange range'
@@ -141,7 +140,7 @@ fillTypedHole logFn docs settings state args = do
       doc <- liftEffect $ getDocument docs (DocumentUri uri)
       version <- liftEffect $ getVersion doc
       text <- liftEffect $ getText doc
-      let edit = makeWorkspaceEdit (DocumentUri uri) version range identifier
+      let edit = makeWorkspaceEdit clientCapabilities (DocumentUri uri) version range identifier
       edit' <- either (const []) identity <$> addCompletionImportEdit logFn docs settings state 
          { identifier, mod: Just mod , qual: Nothing, uri: DocumentUri uri }
         doc version text

src/LanguageServer/IdePurescript/CodeActions.purs

@@ -3,7 +3,7 @@ module LanguageServer.IdePurescript.CodeActions where
 import Prelude
 
 import Control.Monad.Except (runExcept)
-import Data.Array (catMaybes, filter, foldl, head, length, mapMaybe, nubByEq, sort, sortWith, uncons, (:))
+import Data.Array (catMaybes, filter, foldl, head, length, mapMaybe, nubByEq, sortWith, (:))
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..), fromMaybe)
 
@@ -110,7 +110,7 @@ toNextLine (Range { start, end: end@(Position { line, character }) }) =
     }
 
 onReplaceSuggestion :: DocumentStore -> Settings -> ServerState -> Array Foreign -> Aff Unit
-onReplaceSuggestion docs config (ServerState { conn }) args =
+onReplaceSuggestion docs config (ServerState { conn, clientCapabilities }) args =
   case conn, args of
     Just conn', [ uri', replacement', range' ]
       | Right uri <- runExcept $ readString uri'
@@ -120,7 +120,7 @@ onReplaceSuggestion docs config (ServerState { conn }) args =
         doc <- liftEffect $ getDocument docs (DocumentUri uri)
         version <- liftEffect $ getVersion doc
         TextEdit { range: range'', newText } <- getReplacementEdit doc { replacement, range }
-        let edit = makeWorkspaceEdit (DocumentUri uri) version range'' newText
+        let edit = makeWorkspaceEdit clientCapabilities (DocumentUri uri) version range'' newText
 
         -- TODO: Check original & expected text ?
         void $ applyEdit conn' edit
@@ -150,7 +150,7 @@ getReplacementEdit doc { replacement, range } = do
       addNewline = trailingNewline && (not $ null extraText)
 
 onReplaceAllSuggestions :: DocumentStore -> Settings -> ServerState -> Array Foreign -> Aff Unit
-onReplaceAllSuggestions docs config (ServerState { conn }) args =
+onReplaceAllSuggestions docs config (ServerState { conn, clientCapabilities }) args =
   case conn, args of
     Just conn', [ uri', suggestions' ]
       | Right uri <- runExcept $ readString uri'
@@ -159,7 +159,7 @@ onReplaceAllSuggestions docs config (ServerState { conn }) args =
           doc <- liftEffect $ getDocument docs (DocumentUri uri)
           version <- liftEffect $ getVersion doc
           edits <- traverse (getReplacementEdit doc) suggestions
-          void $ applyEdit conn' $ workspaceEdit
+          void $ applyEdit conn' $ workspaceEdit clientCapabilities
             [ TextDocumentEdit
               { textDocument: TextDocumentIdentifier { uri: DocumentUri uri, version }
               , edits

src/LanguageServer/IdePurescript/Imports.purs

@@ -54,7 +54,7 @@ type CompletionImportArgs =
 addCompletionImportEdit :: Notify -> DocumentStore -> Settings -> ServerState
  -> CompletionImportArgs -> TextDocument -> Number -> String
  -> Aff (Either Foreign (Array WorkspaceEdit))
-addCompletionImportEdit log docs config state@(ServerState { port, modules, conn }) { identifier, mod, qual, uri } doc version text = do
+addCompletionImportEdit log docs config state@(ServerState { port, modules, conn, clientCapabilities }) { identifier, mod, qual, uri } doc version text = do
   let prelude = preludeModule config
   case port of
     Just port -> do
@@ -68,7 +68,7 @@ addCompletionImportEdit log docs config state@(ServerState { port, modules, conn
             addExplicitImport modules port (un DocumentUri uri) text mod' qual' identifier
       case result of
         UpdatedImports newText -> do
-          let edit = makeMinimalWorkspaceEdit uri version text newText
+          let edit = makeMinimalWorkspaceEdit clientCapabilities uri version text newText
           pure $ Right $ maybe [] singleton edit
         AmbiguousImport imps -> liftEffect do
           log Warning "Found ambiguous imports"
@@ -98,7 +98,7 @@ addCompletionImportEdit log docs config state@(ServerState { port, modules, conn
 
 addModuleImport' :: Notify -> DocumentStore -> Settings -> ServerState -> Array Foreign -> Aff Foreign
 addModuleImport' log docs config state args = do
-  let ServerState { port, modules, conn } = state
+  let ServerState { port, modules, conn, clientCapabilities } = state
   case port, (runExcept <<< readString) <$> args of
     Just port', [ Right mod', qual', Right uri ] -> do
       doc <- liftEffect $ getDocument docs (DocumentUri uri)
@@ -108,7 +108,7 @@ addModuleImport' log docs config state args = do
       res <- addModuleImport modules port' fileName text mod'
       case res of
         Just { result } -> do
-          let edit = makeMinimalWorkspaceEdit (DocumentUri uri) version text result
+          let edit = makeMinimalWorkspaceEdit clientCapabilities (DocumentUri uri) version text result
           case conn, edit of
             Just conn', Just edit' -> void $ applyEdit conn' edit'
             _, _ -> pure unit

src/LanguageServer/IdePurescript/Main.purs

@@ -63,6 +63,7 @@ defaultServerState = ServerState
   , modules: initialModulesState
   , modulesFile: Nothing
   , diagnostics: Object.empty
+  , clientCapabilities: Nothing
   }
 
 parseArgs :: Array String -> Maybe
@@ -153,14 +154,14 @@ main = do
         apathize stopPscIdeServer
         startPscIdeServer
 
-  conn <- initConnection commands $ \({ params: InitParams { rootPath, rootUri }, conn }) ->  do
+  conn <- initConnection commands $ \({ params: InitParams { rootPath, rootUri, capabilities }, conn }) ->  do
     argv >>= \args -> log conn $ "Starting with args: " <> show args
     root <- case toMaybe rootUri, toMaybe rootPath of
       Just uri, _ -> Just <$> uriToFilename uri
       _, Just path -> pure $ Just path
       Nothing, Nothing -> pure Nothing
     workingRoot <- maybe cwd pure root
-    Ref.modify_ (over ServerState $ _ { root = Just workingRoot }) state
+    Ref.modify_ (over ServerState $ _ { root = Just workingRoot, clientCapabilities = Just capabilities }) state
     (\(Tuple dir root') -> log conn ("Starting with cwd: " <> dir <> " and using root path: " <> root')) =<< Tuple <$> cwd <*> pure workingRoot
   Ref.modify_ (over ServerState $ _ { conn = Just conn }) state
 

src/LanguageServer/IdePurescript/Types.purs

@@ -8,7 +8,7 @@ import Effect.Aff (Aff)
 import Foreign (Foreign)
 import Foreign.Object (Object)
 import IdePurescript.Modules (State)
-import LanguageServer.Types (Connection, DocumentStore, DocumentUri, Settings)
+import LanguageServer.Types (Connection, DocumentStore, DocumentUri, Settings, ClientCapabilities)
 import PscIde.Command (RebuildError)
 
 newtype ServerState = ServerState
@@ -19,6 +19,7 @@ newtype ServerState = ServerState
   , modules :: State
   , modulesFile :: Maybe DocumentUri
   , diagnostics :: Object (Array RebuildError)
+  , clientCapabilities :: Maybe ClientCapabilities
   }
 
 derive instance newtypeServerState :: Newtype ServerState _

src/LanguageServer/Setup.purs

@@ -8,11 +8,12 @@ import Data.Nullable (Nullable)
 import Effect (Effect)
 import Effect.Aff (Aff)
 import Foreign (Foreign)
-import LanguageServer.Types (Connection, DocumentStore, DocumentUri)
+import LanguageServer.Types (ClientCapabilities, Connection, DocumentStore, DocumentUri)
 
-newtype InitParams = InitParams { rootUri :: Nullable DocumentUri, rootPath :: Nullable String, trace :: Nullable String }
+newtype InitParams = InitParams { rootUri :: Nullable DocumentUri, rootPath :: Nullable String, trace :: Nullable String, capabilities :: ClientCapabilities }
 type InitResult = { conn :: Connection, params :: InitParams }
 
+
 type Res a = Effect (Promise a)
 
 foreign import initConnection :: Array String -> (InitResult -> Effect Unit) -> Effect Connection

src/LanguageServer/Text.purs

@@ -10,19 +10,19 @@ import Data.String.Regex (regex)
 import Data.String.Regex as Regex
 import Data.String.Regex.Flags (noFlags)
 import Data.Tuple (uncurry)
-import LanguageServer.Types (DocumentUri, Position(..), Range(..), TextDocumentEdit(..), TextDocumentIdentifier(..), TextEdit(..), WorkspaceEdit, workspaceEdit)
+import LanguageServer.Types (DocumentUri, Position(..), Range(..), TextDocumentEdit(..), TextDocumentIdentifier(..), TextEdit(..), WorkspaceEdit, ClientCapabilities, workspaceEdit)
 
-makeWorkspaceEdit :: DocumentUri -> Number -> Range -> String -> WorkspaceEdit
-makeWorkspaceEdit uri version range newText = workspaceEdit [ edit ]
+makeWorkspaceEdit :: Maybe ClientCapabilities -> DocumentUri -> Number -> Range -> String -> WorkspaceEdit
+makeWorkspaceEdit capabilities uri version range newText = workspaceEdit capabilities [ edit ]
   where 
       textEdit = TextEdit { range, newText }
       docid = TextDocumentIdentifier { uri, version }
       edit = TextDocumentEdit { textDocument: docid, edits: [ textEdit ] }
 
 -- | Make a full-text workspace edit via a minimal diff under the assumption that at most one change is required
 -- | In particular the scenario of inserting text in the middle AC -> ABC becomes an edit of B only.
-makeMinimalWorkspaceEdit :: DocumentUri -> Number -> String -> String -> Maybe WorkspaceEdit
-makeMinimalWorkspaceEdit uri version oldText newText =
+makeMinimalWorkspaceEdit :: Maybe ClientCapabilities -> DocumentUri -> Number -> String -> String -> Maybe WorkspaceEdit
+makeMinimalWorkspaceEdit clientCapabilities uri version oldText newText =
   let splitLines t = either (const [t]) (\r -> Regex.split r t) $ regex "\r?\n" noFlags
       newLines = splitLines newText
       oldLines = case splitLines oldText of
@@ -39,7 +39,7 @@ makeMinimalWorkspaceEdit uri version oldText newText =
       firstDiff = findIndex (uncurry (/=)) (zip oldLines newLines)
       lastDiff = findIndex (uncurry (/=)) (zip (reverse oldLines) (reverse newLines))
 
-      e a b = Just $ makeWorkspaceEdit uri version a b
+      e a b = Just $ makeWorkspaceEdit clientCapabilities uri version a b
       oldLen = length oldLines
       newLen = length newLines
 

src/LanguageServer/Types.purs

@@ -4,7 +4,7 @@ import Prelude
 
 import Data.Array (concat, groupBy, sortWith, (:))
 import Data.Array.NonEmpty (toNonEmpty)
-import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Maybe (Maybe(..), fromMaybe, isNothing)
 import Data.Newtype (class Newtype, over)
 import Data.NonEmpty (foldl1, (:|))
 import Data.Nullable (Nullable, toMaybe, toNullable)
@@ -237,12 +237,18 @@ newtype WorkspaceEdit = WorkspaceEdit
 instance semigroupWorkspaceEdit :: Semigroup WorkspaceEdit where
   append (WorkspaceEdit { documentChanges, changes }) (WorkspaceEdit { documentChanges: documentChanges', changes: changes' }) =
     WorkspaceEdit
-      { documentChanges: toNullable $ Just $ 
-          map (foldl1 combine) $
-          map toNonEmpty $
-          groupBy (\d1 d2 -> docId d1 == docId d2)
-            (fromNullableArray documentChanges <> fromNullableArray documentChanges')
-      , changes: toNullable $ Just $ Object.fromFoldableWith (<>) (goStrMap changes <> goStrMap changes')
+      { documentChanges: toNullable $ case isNothing (toMaybe documentChanges), isNothing (toMaybe documentChanges') of
+                                        true, true -> Nothing
+                                        _, _ -> 
+                                          Just $ 
+                                              map (foldl1 combine) $
+                                              map toNonEmpty $
+                                              groupBy (\d1 d2 -> docId d1 == docId d2)
+                                                (fromNullableArray documentChanges <> fromNullableArray documentChanges')
+      , changes: toNullable $ case isNothing (toMaybe changes), isNothing (toMaybe changes') of
+                                true, true -> Nothing
+                                _, _ ->
+                                  Just $ Object.fromFoldableWith (<>) (goStrMap changes <> goStrMap changes')
       }
     where
       combine (TextDocumentEdit { textDocument, edits }) (TextDocumentEdit { edits: edits' }) =
@@ -254,22 +260,31 @@ instance semigroupWorkspaceEdit :: Semigroup WorkspaceEdit where
       goStrMap a = Object.toUnfoldable $ fromMaybe Object.empty $ toMaybe a
 
 instance monoidWorkspaceEdit :: Monoid WorkspaceEdit where
-  mempty = WorkspaceEdit { documentChanges: toNullable $ Just [], changes: toNullable $ Just $ Object.empty }
+  mempty = WorkspaceEdit { documentChanges: toNullable Nothing, changes: toNullable Nothing }
 
 -- | Create workspace edit, supporting both documentChanges and older changes property for v2 clients
-workspaceEdit :: Array TextDocumentEdit -> WorkspaceEdit
-workspaceEdit edits = WorkspaceEdit
-  { documentChanges: toNullable $ Just edits
-  , changes: toNullable $ Just $ 
-      Object.fromFoldable $
-      map (\(h :| t) -> Tuple (uri h) (concat $ edit h : map edit t) ) $
-        map toNonEmpty $
-        groupBy (\a b -> uri a == uri b) $ sortWith uri edits
+workspaceEdit :: Maybe ClientCapabilities -> Array TextDocumentEdit -> WorkspaceEdit
+workspaceEdit capabilities edits = WorkspaceEdit
+  { documentChanges: toNullable $
+      if useDocumentChanges then Just edits else Nothing
+  , changes: toNullable $ 
+      if useDocumentChanges then Nothing
+      else
+        Just $
+          Object.fromFoldable $
+          map (\(h :| t) -> Tuple (uri h) (concat $ edit h : map edit t) ) $
+            map toNonEmpty $
+            groupBy (\a b -> uri a == uri b) $ sortWith uri edits
   }
   where
+  useDocumentChanges = supportsDocumentChanges capabilities
   uri (TextDocumentEdit { textDocument: TextDocumentIdentifier { uri: DocumentUri uri' } }) = uri'
   edit (TextDocumentEdit { edits: edits' }) = edits'
 
+supportsDocumentChanges ::  Maybe ClientCapabilities -> Boolean
+supportsDocumentChanges Nothing = false
+supportsDocumentChanges (Just {workspace}) = fromMaybe false $ toMaybe workspace >>= (_.workspaceEdit >>> toMaybe) >>= (_.documentChanges >>> toMaybe) 
+
 newtype TextDocumentEdit = TextDocumentEdit { textDocument :: TextDocumentIdentifier, edits :: Array TextEdit }
 
 newtype TextDocumentIdentifier = TextDocumentIdentifier { uri :: DocumentUri, version :: Number }
@@ -296,4 +311,11 @@ intToFileChangeType = case _ of
   3 -> Just DeletedChangeType
   _ -> Nothing
 
-newtype FileEvent = FileEvent { uri :: DocumentUri, type :: FileChangeTypeCode }
+newtype FileEvent = FileEvent { uri :: DocumentUri, type :: FileChangeTypeCode }
+
+
+type ClientCapabilities = { workspace :: Nullable WorkspaceClientCapabilities }
+type WorkspaceClientCapabilities = { applyEdit :: Nullable Boolean, workspaceEdit :: Nullable WorkspaceEditClientCapabilities }
+
+-- https://microsoft.github.io/language-server-protocol/specifications/specification-current/#workspaceEditClientCapabilities
+type WorkspaceEditClientCapabilities = { documentChanges :: Nullable Boolean }