Fix all suggestions commands

nwolverson · Mar 12, 2018 · 2b33ab6 · 2b33ab6
1 parent b278043
commit 2b33ab6
Show file tree

Hide file tree

Showing 5 changed files with 105 additions and 43 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,37 +1,33 @@
 # Changelog
 
+### next
+
+- Replace typed hole command & code action (requires LSP client support) https://github.com/nwolverson/purescript-language-server/issues/14
+- Move dependencies from purescript-ide-purescript-core
+- Configurable output directory #30
+
 ### 0.9.0
 
 - Add documentation to hover tooltips https://github.com/nwolverson/purescript-language-server/pull/25 [@Krzysztof-Cieslak](https://github.com/Krzysztof-Cieslak)
-
 - Make compiler fixes (particularly import fixes) not leave extra blank lines https://github.com/nwolverson/purescript-language-server/issues/13
-
 - Fix `preludeModule` adding a prelude import if it is already imported explicitly https://github.com/nwolverson/purescript-language-server/issues/26
-
 - Ensure IDE server dependencies are reloaded on full build (particularly in case of editor mode) https://github.com/nwolverson/purescript-language-server/issues/19
-
 - Fix completion edits in some circumstances https://github.com/nwolverson/vscode-ide-purescript/issues/96
 
 ### 0.8.0
 
 - Add suggestion ranking heuristics, currently these are for qualified import suggestions https://github.com/nwolverson/purescript-language-server/pull/15 [@natefaubion](https://github.com/natefaubion)
-
 - Add configurable Prelude open import via `preludeModule` https://github.com/nwolverson/purescript-language-server/pull/16 [@natefaubion](https://github.com/natefaubion)
-
 - Use Markdown for suggestion details https://github.com/nwolverson/purescript-language-server/pull/23 [@Krzysztof-Cieslak](https://github.com/Krzysztof-Cieslak)
 
 ### 0.7.1 
 
 - Automatically add qualified imports on completion with an unknown qualifier https://github.com/nwolverson/purescript-language-server/pull/7 [@natefaubion](https://github.com/natefaubion)
-
 - Fix extraneous newlines in case split/add clause https://github.com/nwolverson/purescript-language-server/pull/9
 
 ### 0.6.0
 
 - Add changelog :)
-
 - Support psc-package source globs. Toggled via `addPscPackageSources` config (default `false`) and using `psc-package sources` command.
-
 - Show expanded type in tooltips (when different from non-expanded one)
-
 - Show module tooltip for qualified imports (hover over the qualifier of a qualified identifier)
diff --git a/src/IdePurescript/QuickFix.purs b/src/IdePurescript/QuickFix.purs
@@ -2,6 +2,7 @@ module IdePurescript.QuickFix where
 
 import Prelude
 
+import Data.Foldable (elem)
 import Data.String (null)
 import Data.String.Regex (regex)
 import Data.String.Regex.Flags (global, noFlags)
@@ -25,15 +26,26 @@ getTitle code = case code of
   "DeprecatedQualifiedSyntax"   -> "Remove qualified keyword"
   "ImplicitImport"              -> "Make import explicit"
   "UnusedExplicitImport"        -> "Remove unused references"
-  _                             -> "Apply Suggestion"
+  _                             -> "Apply suggestion"
 
 -- | Determine whether an error code represents an unknown token (unknown identifier or missing import)
 isUnknownToken :: String -> Boolean
-isUnknownToken code = case code of
-  "UnknownValue" -> true
-  "UnknownType" -> true
-  "UnknownDataConstructor" -> true
-  "UnknownTypeConstructor" -> true
+isUnknownToken = flip elem
+  [ "UnknownValue"
+  , "UnknownType"
+  , "UnknownDataConstructor"
+  , "UnknownTypeConstructor"
     -- In later compiler versions UnknownName covers all of the above
-  "UnknownName" -> true
-  _ -> false
+  , "UnknownName" ]
+
+isImport :: String -> Boolean
+isImport = flip elem
+  [ "UnusedImport" 
+  , "DuplicateImport"
+  , "HidingImport"
+  , "ImplicitImport"
+  , "ImplicitQualifiedImport"
+  , "UnusedDctorExplicitImport"
+  , "UnusedDctorImport"
+  , "UnusedExplicitImport"
+  ]
diff --git a/src/LanguageServer/IdePurescript/CodeActions.purs b/src/LanguageServer/IdePurescript/CodeActions.purs
@@ -5,9 +5,9 @@ import Prelude
 import Control.Monad.Aff (Aff)
 import Control.Monad.Eff.Class (liftEff)
 import Control.Monad.Except (runExcept)
-import Data.Array (catMaybes, mapMaybe)
+import Data.Array (catMaybes, filter, length, mapMaybe)
 import Data.Either (Either(..))
-import Data.Foreign (F, Foreign, readInt, readString)
+import Data.Foreign (F, Foreign, readArray, readInt, readString)
 import Data.Foreign.Index ((!))
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Newtype (un)
@@ -16,33 +16,45 @@ import Data.String (null, trim)
 import Data.String.Regex (regex)
 import Data.String.Regex.Flags (global, noFlags)
 import Data.Traversable (traverse)
-import IdePurescript.QuickFix (getTitle, isUnknownToken)
+import IdePurescript.QuickFix (getTitle, isImport, isUnknownToken)
 import IdePurescript.Regex (replace', test')
 import LanguageServer.DocumentStore (getDocument)
 import LanguageServer.Handlers (CodeActionParams, applyEdit)
 import LanguageServer.IdePurescript.Build (positionToRange)
-import LanguageServer.IdePurescript.Commands (build, fixTypo, replaceSuggestion, typedHole)
+import LanguageServer.IdePurescript.Commands (Replacement, build, fixTypo, replaceAllSuggestions, replaceSuggestion, typedHole)
 import LanguageServer.IdePurescript.Types (ServerState(..), MainEff)
 import LanguageServer.Text (makeWorkspaceEdit)
-import LanguageServer.TextDocument (getTextAtRange, getVersion)
-import LanguageServer.Types (Command, DocumentStore, DocumentUri(DocumentUri), Position(Position), Range(Range), Settings, TextDocumentIdentifier(TextDocumentIdentifier))
+import LanguageServer.TextDocument (TextDocument, getTextAtRange, getVersion)
+import LanguageServer.Types (Command, DocumentStore, DocumentUri(DocumentUri), Position(Position), Range(Range), Settings, TextDocumentEdit(..), TextDocumentIdentifier(TextDocumentIdentifier), TextEdit(..), workspaceEdit)
 import PscIde.Command (PscSuggestion(..), PursIdeInfo(..), RebuildError(..))
 
 getActions :: forall eff. DocumentStore -> Settings -> ServerState (MainEff eff) -> CodeActionParams -> Aff (MainEff eff) (Array Command)
 getActions documents settings (ServerState { diagnostics, conn }) { textDocument, range } =  
   case lookup (un DocumentUri $ docUri) diagnostics of
-    Just errs -> do 
-      replacements <- catMaybes <$> traverse asCommand errs
-      pure $ replacements <> mapMaybe commandForCode errs
+    Just errs -> pure $
+      (catMaybes $ map asCommand errs)
+      <> fixAllCommand "Apply all suggestions" errs
+      <> fixAllCommand "Apply all import suggestions" (filter (\(RebuildError { errorCode }) -> isImport errorCode) errs)
+      <> mapMaybe commandForCode errs
     _ -> pure []
   where
     docUri = _.uri $ un TextDocumentIdentifier textDocument
 
-    asCommand (RebuildError { position: Just position, suggestion: Just (PscSuggestion { replacement, replaceRange }), errorCode })
-      | contains range (positionToRange position) = do
-      let range' = positionToRange $ fromMaybe position replaceRange
-      pure $ Just $ replaceSuggestion (getTitle errorCode) (_.uri $ un TextDocumentIdentifier textDocument) replacement range'
-    asCommand _ = pure Nothing
+    asCommand error@(RebuildError { position: Just position, errorCode })
+      | Just { replacement, range: replaceRange } <- getReplacementRange error
+      , contains range (positionToRange position) = do
+      Just $ replaceSuggestion (getTitle errorCode) docUri replacement replaceRange
+    asCommand _ = Nothing
+
+    getReplacementRange (RebuildError { position: Just position, suggestion: Just (PscSuggestion { replacement, replaceRange }) }) =
+      Just $ { replacement, range }
+      where
+      range = positionToRange $ fromMaybe position replaceRange
+    getReplacementRange _ = Nothing
+
+    fixAllCommand text rebuildErrors = if length replacements > 0 then [ replaceAllSuggestions text docUri replacements ] else [ ]
+      where
+      replacements = mapMaybe getReplacementRange rebuildErrors
 
     commandForCode (err@RebuildError { position: Just position, errorCode }) | contains range (positionToRange position) =
       case errorCode of
@@ -95,20 +107,26 @@ onReplaceSuggestion docs config (ServerState { conn }) args =
       -> do
         doc <- liftEff $ getDocument docs (DocumentUri uri)
         version <- liftEff $ getVersion doc
-        origText <- liftEff $ getTextAtRange doc range
-        afterText <- liftEff $ replace' (regex "\n$" noFlags) "" <$> getTextAtRange doc (afterEnd range)
-
-        let newText = getReplacement replacement afterText
-
-        let range' = if newText == "" && afterText == "" then
-                      toNextLine range
-                     else
-                      range
+        TextEdit { range: range', newText } <- getReplacementEdit doc { replacement, range }
         let edit = makeWorkspaceEdit (DocumentUri uri) version range' newText
 
         -- TODO: Check original & expected text ?
         void $ applyEdit conn' edit
     _, _ -> pure unit
+
+
+getReplacementEdit :: forall eff. TextDocument -> Replacement -> Aff (MainEff eff) TextEdit
+getReplacementEdit doc { replacement, range } = do
+  origText <- liftEff $ getTextAtRange doc range
+  afterText <- liftEff $ replace' (regex "\n$" noFlags) "" <$> getTextAtRange doc (afterEnd range)
+
+  let newText = getReplacement replacement afterText
+
+  let range' = if newText == "" && afterText == "" then
+                toNextLine range
+                else
+                range
+  pure $ TextEdit { range: range', newText }
   where
     -- | Modify suggestion replacement text, removing extraneous newlines
     getReplacement :: String -> String -> String
@@ -118,3 +136,28 @@ onReplaceSuggestion docs config (ServerState { conn }) args =
       where
       trailingNewline = test' (regex "\n\\s+$" noFlags) replacement
       addNewline = trailingNewline && (not $ null extraText)
+
+onReplaceAllSuggestions :: forall eff. DocumentStore -> Settings -> ServerState (MainEff eff) -> Array Foreign -> Aff (MainEff eff) Unit
+onReplaceAllSuggestions docs config (ServerState { conn }) args =
+  case conn, args of 
+    Just conn', [ uri', suggestions' ]
+      | Right uri <- runExcept $ readString uri'
+      , Right suggestions <- runExcept $ readArray suggestions' >>= traverse readSuggestion
+      -> do
+          doc <- liftEff $ getDocument docs (DocumentUri uri)
+          version <- liftEff $ getVersion doc
+          edits <- traverse (getReplacementEdit doc) suggestions
+          void $ applyEdit conn' $ workspaceEdit
+            [ TextDocumentEdit
+              { textDocument: TextDocumentIdentifier { uri: DocumentUri uri, version } 
+              , edits
+              }
+            ]
+    _, _ -> pure unit
+
+readSuggestion :: Foreign -> F Replacement
+readSuggestion o = do
+  replacement <- o ! "replacement" >>= readString
+  range <- o ! "range" >>= readRange
+  pure $ { replacement, range }
+
diff --git a/src/LanguageServer/IdePurescript/Commands.purs b/src/LanguageServer/IdePurescript/Commands.purs
@@ -40,6 +40,15 @@ replaceSuggestion :: String -> DocumentUri -> String -> Range -> Command
 replaceSuggestion title uri replacement fixRange = c (CommandInfo title "replaceSuggestion") $ 
   Just [ toForeign uri, toForeign replacement, toForeign fixRange ]
 
+replaceAllSuggestionsCmd :: CommandInfo
+replaceAllSuggestionsCmd = CommandInfo "Replace all suggestions" "replaceAllSuggestions"
+
+type Replacement = { replacement:: String, range :: Range }
+
+replaceAllSuggestions :: String -> DocumentUri -> Array Replacement -> Command
+replaceAllSuggestions text uri replacements = c (CommandInfo text "replaceAllSuggestions") $ 
+  Just [ toForeign uri, toForeign replacements ]
+
 buildCmd :: CommandInfo
 buildCmd = CommandInfo "Build" "build"
 
@@ -87,5 +96,6 @@ commands = cmdName <$>
   , stopPscIdeCmd
   , restartPscIdeCmd
   , typedHoleExplicitCmd
+  , replaceAllSuggestionsCmd
   ]
 
diff --git a/src/LanguageServer/IdePurescript/Main.purs b/src/LanguageServer/IdePurescript/Main.purs
@@ -27,8 +27,8 @@ import LanguageServer.DocumentStore (getDocument, onDidChangeContent, onDidSaveD
 import LanguageServer.Handlers (onCodeAction, onCompletion, onDefinition, onDidChangeConfiguration, onDidChangeWatchedFiles, onDocumentSymbol, onExecuteCommand, onHover, onShutdown, onWorkspaceSymbol, publishDiagnostics, sendDiagnosticsBegin, sendDiagnosticsEnd)
 import LanguageServer.IdePurescript.Assist (addClause, caseSplit, fillTypedHole, fixTypo)
 import LanguageServer.IdePurescript.Build (collectByFirst, fullBuild, getDiagnostics)
-import LanguageServer.IdePurescript.CodeActions (getActions, onReplaceSuggestion)
-import LanguageServer.IdePurescript.Commands (addClauseCmd, addCompletionImportCmd, addModuleImportCmd, buildCmd, caseSplitCmd, cmdName, commands, fixTypoCmd, getAvailableModulesCmd, replaceSuggestionCmd, restartPscIdeCmd, searchCmd, startPscIdeCmd, stopPscIdeCmd, typedHoleExplicitCmd)
+import LanguageServer.IdePurescript.CodeActions (getActions, onReplaceAllSuggestions, onReplaceSuggestion)
+import LanguageServer.IdePurescript.Commands (addClauseCmd, addCompletionImportCmd, addModuleImportCmd, buildCmd, caseSplitCmd, cmdName, commands, fixTypoCmd, getAvailableModulesCmd, replaceAllSuggestionsCmd, replaceSuggestionCmd, restartPscIdeCmd, searchCmd, startPscIdeCmd, stopPscIdeCmd, typedHoleExplicitCmd)
 import LanguageServer.IdePurescript.Completion (getCompletions)
 import LanguageServer.IdePurescript.Config (fastRebuild)
 import LanguageServer.IdePurescript.Imports (addCompletionImport, addModuleImport', getAllModules)
@@ -214,6 +214,7 @@ main = do
       [ Tuple caseSplitCmd $ voidHandler caseSplit
       , Tuple addClauseCmd $ voidHandler addClause
       , Tuple replaceSuggestionCmd $ voidHandler onReplaceSuggestion
+      , Tuple replaceAllSuggestionsCmd $ voidHandler onReplaceAllSuggestions
       , Tuple buildCmd $ voidHandler onBuild
       , Tuple addCompletionImportCmd $ addCompletionImport logError
       , Tuple addModuleImportCmd $ voidHandler $ addModuleImport' logError