From b92c42396092b87be90fb7fc6903f8793b6f7458 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Wed, 12 Jul 2023 10:54:42 +0900 Subject: [PATCH 01/16] refactor: Avoids misleading name (renames `extractRange` to `extractOverlappingLinesWithRange`) --- hls-plugin-api/src/Ide/PluginUtils.hs | 25 ++++++++++++++++--- .../src/Ide/Plugin/Floskell.hs | 2 +- .../src/Ide/Plugin/StylishHaskell.hs | 2 +- 3 files changed, 23 insertions(+), 6 deletions(-) diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 1c43c9c13c..3afc9b835d 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -19,7 +19,8 @@ module Ide.PluginUtils getPluginConfig, configForPlugin, pluginEnabled, - extractRange, + extractOverlappingLinesWithRange, + extractTextInRange, fullRange, mkLspCommand, mkLspCmdId, @@ -41,7 +42,7 @@ where import Control.Arrow ((&&&)) -import Control.Lens (re, (^.)) +import Control.Lens (_head, _last, re, (%~), (^.)) import Control.Monad.Extra (maybeM) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) @@ -223,11 +224,27 @@ usePropertyLsp kn pId p = do -- --------------------------------------------------------------------- -extractRange :: Range -> T.Text -> T.Text -extractRange (Range (Position sl _) (Position el _)) s = newS +-- | Extracts lines in the text overlapping the given range. +-- +-- See also: 'extractTextInRange' +extractOverlappingLinesWithRange :: Range -> T.Text -> T.Text +extractOverlappingLinesWithRange (Range (Position sl _) (Position el _)) s = newS where focusLines = take (fromIntegral $ el-sl+1) $ drop (fromIntegral sl) $ T.lines s newS = T.unlines focusLines +-- | Extracts strictly matching text in the range. +-- +-- See also: 'extractOverlappingLinesWithRange' +extractTextInRange :: Range -> T.Text -> T.Text +extractTextInRange (Range (Position sl sc) (Position el ec)) s = newS + where focusLines = take (fromIntegral $ el-sl+1) $ drop (fromIntegral sl) $ T.lines s + -- NOTE: We have to trim the last line first to handle the single-line case + newS = focusLines + & _last %~ T.take (fromIntegral ec) + & _head %~ T.drop (fromIntegral sc) + & T.unlines + + -- | Gets the range that covers the entire text fullRange :: T.Text -> Range fullRange s = Range startPos endPos diff --git a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs index 2c8f6fb92e..5c0abacba2 100644 --- a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs +++ b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs @@ -33,7 +33,7 @@ provider _ideState typ contents fp _ = liftIO $ do config <- findConfigOrDefault file let (range, selectedContents) = case typ of FormatText -> (fullRange contents, contents) - FormatRange r -> (normalize r, extractRange r contents) + FormatRange r -> (normalize r, extractOverlappingLinesWithRange r contents) result = reformat config (Just file) . TL.encodeUtf8 $ TL.fromStrict selectedContents case result of Left err -> pure $ Left $ responseError $ T.pack $ "floskellCmd: " ++ err diff --git a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs index c68e623401..af77e5dbac 100644 --- a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs +++ b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs @@ -36,7 +36,7 @@ provider ide typ contents fp _opts = do mergedConfig <- liftIO $ getMergedConfig dyn config let (range, selectedContents) = case typ of FormatText -> (fullRange contents, contents) - FormatRange r -> (normalize r, extractRange r contents) + FormatRange r -> (normalize r, extractOverlappingLinesWithRange r contents) result = runStylishHaskell file mergedConfig selectedContents case result of Left err -> return $ Left $ responseError $ T.pack $ "stylishHaskellCmd: " ++ err From 7bf71e390f65e2a1c19bcfdea26b9c3faa013257 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Wed, 12 Jul 2023 10:56:11 +0900 Subject: [PATCH 02/16] fix: first workaround for qualified imports in GHC 9.4 --- .../src/Development/IDE/Plugin/CodeAction.hs | 45 +++++++++++++++++-- plugins/hls-refactor-plugin/test/Main.hs | 22 +++++---- 2 files changed, 51 insertions(+), 16 deletions(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 727a959620..999485ccfd 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -38,8 +38,8 @@ import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Utf16.Rope as Rope -import Development.IDE.Core.Rules import Development.IDE.Core.RuleTypes +import Development.IDE.Core.Rules import Development.IDE.Core.Service import Development.IDE.Core.Shake hiding (Log) import Development.IDE.GHC.Compat hiding @@ -72,7 +72,8 @@ import qualified GHC.LanguageExtensions as Lang #if MIN_VERSION_ghc(9,4,0) import GHC.Parser.Annotation (TokenLocation (..)) #endif -import Ide.PluginUtils (subRange) +import Ide.PluginUtils (extractTextInRange, + subRange) import Ide.Types import Language.LSP.Protocol.Message (ResponseError, SMethod (..)) @@ -98,6 +99,7 @@ import Language.LSP.VFS (VirtualFile, import qualified Text.Fuzzy.Parallel as TFP import Text.Regex.TDFA ((=~), (=~~)) #if MIN_VERSION_ghc(9,2,0) +import Debug.Trace (trace) import GHC (AddEpAnn (AddEpAnn), Anchor (anchor_op), AnchorOperation (..), @@ -1473,8 +1475,9 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos where moduleText = moduleNameText identInfo suggestNewImport :: DynFlags -> ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] -suggestNewImport df packageExportsMap ps fileContents Diagnostic{_message} +suggestNewImport df packageExportsMap ps fileContents diag@Diagnostic{_message, ..} | msg <- unifySpaces _message + , trace ("suggestNew: " <> show diag) True , Just thingMissing <- extractNotInScopeName msg , qual <- extractQualifiedModuleName msg , qual' <- @@ -1482,17 +1485,46 @@ suggestNewImport df packageExportsMap ps fileContents Diagnostic{_message} >>= (findImportDeclByModuleName hsmodImports . T.unpack) >>= ideclAs . unLoc <&> T.pack . moduleNameString . unLoc + , -- tentative workaround for detecting qualification in GHC 9.4 + -- FIXME: We can delete this after dropping the support for GHC 9.4 + qualGHC94 <- + guard (ghcVersion == GHC94) + *> extractQualifiedModuleNameFromMissingName (extractTextInRange _range fileContents) , Just (range, indent) <- newImportInsertRange ps fileContents , extendImportSuggestions <- matchRegexUnifySpaces msg "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’" = let qis = qualifiedImportStyle df + -- FIXME: we can use thingMissing once the support for GHC 9.4 is dropped. + missing + | GHC94 <- ghcVersion + , isNothing (qual <|> qual') + , Just q <- qualGHC94 = + mapNotInScope ((q <> ".") <>) thingMissing + | otherwise = thingMissing suggestions = nubSortBy simpleCompareImportSuggestion - (constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions qis) in + (constructNewImportSuggestions packageExportsMap (qual <|> qual' <|> qualGHC94, missing) extendImportSuggestions qis) in map (\(ImportSuggestion _ kind (unNewImport -> imp)) -> (imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " "))) suggestions where L _ HsModule {..} = astA ps suggestNewImport _ _ _ _ _ = [] +-- tentative workaround for detecting qualification in GHC 9.4 +-- FIXME: We can delete this after dropping the support for GHC 9.4 +extractQualifiedModuleNameFromMissingName :: T.Text -> Maybe T.Text +extractQualifiedModuleNameFromMissingName (T.strip -> missing) + | -- Case 1: parenthesized operator + Just (nam : _) <- + matchRegexUnifySpaces missing + "\\`\\(([A-Z][A-Za-z0-9_]*(\\.[A-Z][A-Za-z0-9_]*)*)\\..+\\)\\'" + = Just nam + | -- Case 2: alphabetic name without parens + Just (nam : _) <- + matchRegexUnifySpaces missing + "\\`([A-Z][A-Za-z0-9_]*(\\.[A-Z][A-Za-z0-9_]*)*)\\..+\\'" + = Just nam + | otherwise = Nothing + + constructNewImportSuggestions :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> QualifiedImportStyle -> [ImportSuggestion] constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules qis = nubOrdBy simpleCompareImportSuggestion @@ -1740,6 +1772,11 @@ data NotInScope | NotInScopeThing T.Text deriving Show +mapNotInScope :: (T.Text -> T.Text) -> NotInScope -> NotInScope +mapNotInScope f (NotInScopeDataConstructor d) = NotInScopeDataConstructor (f d) +mapNotInScope f (NotInScopeTypeConstructorOrClass d) = NotInScopeTypeConstructorOrClass (f d) +mapNotInScope f (NotInScopeThing d) = NotInScopeThing (f d) + notInScope :: NotInScope -> T.Text notInScope (NotInScopeDataConstructor t) = t notInScope (NotInScopeTypeConstructorOrClass t) = t diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index d304c5c62f..2bbc77f23a 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -43,9 +43,9 @@ import Language.LSP.Protocol.Types hiding import Language.LSP.Test import System.Directory import System.FilePath -import System.Info.Extra (isMac, isWindows) -import qualified System.IO.Extra import System.IO.Extra hiding (withTempDir) +import qualified System.IO.Extra +import System.Info.Extra (isMac, isWindows) import System.Time.Extra import Test.Tasty import Test.Tasty.ExpectedFailure @@ -1670,10 +1670,11 @@ suggestImportTests = testGroup "suggest import actions" , test True [] "f = empty" [] "import Control.Applicative (empty)" , test True [] "f = empty" [] "import Control.Applicative" , test True [] "f = (&)" [] "import Data.Function ((&))" - , ignoreForGHC94 "On GHC 9.4 the error message doesn't contain the qualified module name: https://gitlab.haskell.org/ghc/ghc/-/issues/20472" - $ test True [] "f = NE.nonEmpty" [] "import qualified Data.List.NonEmpty as NE" - , ignoreForGHC94 "On GHC 9.4 the error message doesn't contain the qualified module name: https://gitlab.haskell.org/ghc/ghc/-/issues/20472" - $ test True [] "f = Data.List.NonEmpty.nonEmpty" [] "import qualified Data.List.NonEmpty" + , test True [] "f = NE.nonEmpty" [] "import qualified Data.List.NonEmpty as NE" + , test True [] "f = (NE.:|)" [] "import qualified Data.List.NonEmpty as NE" + , test True [] "f = (Data.List.NonEmpty.:|)" [] "import qualified Data.List.NonEmpty" + , test True [] "f = (B..|.)" [] "import qualified Data.Bits as B" + , test True [] "f = (Data.Bits..|.)" [] "import qualified Data.Bits" , test True [] "f :: Typeable a => a" ["f = undefined"] "import Data.Typeable (Typeable)" , test True [] "f = pack" [] "import Data.Text (pack)" , test True [] "f :: Text" ["f = undefined"] "import Data.Text (Text)" @@ -1682,17 +1683,14 @@ suggestImportTests = testGroup "suggest import actions" , test True [] "f = (.|.)" [] "import Data.Bits (Bits((.|.)))" , test True [] "f = (.|.)" [] "import Data.Bits ((.|.))" , test True [] "f :: a ~~ b" [] "import Data.Type.Equality ((~~))" - , ignoreForGHC94 "On GHC 9.4 the error message doesn't contain the qualified module name: https://gitlab.haskell.org/ghc/ghc/-/issues/20472" - $ test True + , test True ["qualified Data.Text as T" ] "f = T.putStrLn" [] "import qualified Data.Text.IO as T" - , ignoreForGHC94 "On GHC 9.4 the error message doesn't contain the qualified module name: https://gitlab.haskell.org/ghc/ghc/-/issues/20472" - $ test True + , test True [ "qualified Data.Text as T" , "qualified Data.Function as T" ] "f = T.putStrLn" [] "import qualified Data.Text.IO as T" - , ignoreForGHC94 "On GHC 9.4 the error message doesn't contain the qualified module name: https://gitlab.haskell.org/ghc/ghc/-/issues/20472" - $ test True + , test True [ "qualified Data.Text as T" , "qualified Data.Function as T" , "qualified Data.Functor as T" From ff348a288c190755c45f479c4d89b09fe3e3c640 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Wed, 12 Jul 2023 11:11:52 +0900 Subject: [PATCH 03/16] fix: stylish-haskell --- .../src/Development/IDE/Plugin/CodeAction.hs | 2 +- plugins/hls-refactor-plugin/test/Main.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 999485ccfd..216c138817 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -38,8 +38,8 @@ import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Utf16.Rope as Rope -import Development.IDE.Core.RuleTypes import Development.IDE.Core.Rules +import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service import Development.IDE.Core.Shake hiding (Log) import Development.IDE.GHC.Compat hiding diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 2bbc77f23a..00c0bfdad9 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -43,9 +43,9 @@ import Language.LSP.Protocol.Types hiding import Language.LSP.Test import System.Directory import System.FilePath -import System.IO.Extra hiding (withTempDir) -import qualified System.IO.Extra import System.Info.Extra (isMac, isWindows) +import qualified System.IO.Extra +import System.IO.Extra hiding (withTempDir) import System.Time.Extra import Test.Tasty import Test.Tasty.ExpectedFailure From 2eae0a7447931ec21231237a6cc380732ccdc340 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Wed, 12 Jul 2023 11:21:58 +0900 Subject: [PATCH 04/16] fix: stop using Debug.Trace --- .../src/Development/IDE/Plugin/CodeAction.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 216c138817..d620499b97 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -99,7 +99,6 @@ import Language.LSP.VFS (VirtualFile, import qualified Text.Fuzzy.Parallel as TFP import Text.Regex.TDFA ((=~), (=~~)) #if MIN_VERSION_ghc(9,2,0) -import Debug.Trace (trace) import GHC (AddEpAnn (AddEpAnn), Anchor (anchor_op), AnchorOperation (..), @@ -1475,9 +1474,8 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos where moduleText = moduleNameText identInfo suggestNewImport :: DynFlags -> ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] -suggestNewImport df packageExportsMap ps fileContents diag@Diagnostic{_message, ..} +suggestNewImport df packageExportsMap ps fileContents Diagnostic{_message, ..} | msg <- unifySpaces _message - , trace ("suggestNew: " <> show diag) True , Just thingMissing <- extractNotInScopeName msg , qual <- extractQualifiedModuleName msg , qual' <- From 1df314bc42286cf6d652f2621659846e26c846a5 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 15 Jul 2023 15:56:41 +0900 Subject: [PATCH 05/16] refactor: uses `regex-applicative-text` to comply with Haskell 2010 Module Name --- .../hls-refactor-plugin.cabal | 3 ++ .../src/Development/IDE/Plugin/CodeAction.hs | 40 ++++++++++++++----- 2 files changed, 32 insertions(+), 11 deletions(-) diff --git a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal index 7cd78a21f8..bc48ec99c0 100644 --- a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal +++ b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal @@ -86,6 +86,9 @@ library , lens , data-default , time + -- FIXME: Only needed to workaround for qualified imports in GHC 9.4 + , regex-applicative-text + , parser-combinators ghc-options: -Wall -Wno-name-shadowing default-language: Haskell2010 diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index d620499b97..32714bedee 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -69,6 +69,7 @@ import Development.IDE.Types.Logger hiding import Development.IDE.Types.Options import GHC.Exts (fromList) import qualified GHC.LanguageExtensions as Lang +import qualified Text.Regex.Applicative.Text as RE #if MIN_VERSION_ghc(9,4,0) import GHC.Parser.Annotation (TokenLocation (..)) #endif @@ -99,6 +100,7 @@ import Language.LSP.VFS (VirtualFile, import qualified Text.Fuzzy.Parallel as TFP import Text.Regex.TDFA ((=~), (=~~)) #if MIN_VERSION_ghc(9,2,0) +import Control.Applicative.Combinators.NonEmpty (sepBy1) import GHC (AddEpAnn (AddEpAnn), Anchor (anchor_op), AnchorOperation (..), @@ -1510,17 +1512,33 @@ suggestNewImport _ _ _ _ _ = [] -- FIXME: We can delete this after dropping the support for GHC 9.4 extractQualifiedModuleNameFromMissingName :: T.Text -> Maybe T.Text extractQualifiedModuleNameFromMissingName (T.strip -> missing) - | -- Case 1: parenthesized operator - Just (nam : _) <- - matchRegexUnifySpaces missing - "\\`\\(([A-Z][A-Za-z0-9_]*(\\.[A-Z][A-Za-z0-9_]*)*)\\..+\\)\\'" - = Just nam - | -- Case 2: alphabetic name without parens - Just (nam : _) <- - matchRegexUnifySpaces missing - "\\`([A-Z][A-Za-z0-9_]*(\\.[A-Z][A-Za-z0-9_]*)*)\\..+\\'" - = Just nam - | otherwise = Nothing + = missing RE.=~ qualIdentP + where + {- + NOTE: Haskell 2010 allows /unicode/ upper & lower letters + as a module name component; otoh, regex-tdfa only allows + /ASCII/ letters to be matched with @[[:upper:]]@ and/or @[[:lower:]]@. + Hence we use regex-applicative(-text) for finer-grained predicates. + + RULES (from [Section 10 of Haskell 2010 Report](https://www.haskell.org/onlinereport/haskell2010/haskellch10.html)): + modid → {conid .} conid + conid → large {small | large | digit | ' } + small → ascSmall | uniSmall | _ + ascSmall → a | b | … | z + uniSmall → any Unicode lowercase letter + large → ascLarge | uniLarge + ascLarge → A | B | … | Z + uniLarge → any uppercase or titlecase Unicode letter + -} + + qualIdentP = parensQualOpP <|> qualVarP + parensQualOpP = RE.sym '(' *> modNameP <* RE.sym '.' <* RE.anySym <* RE.few RE.anySym <* RE.sym ')' + qualVarP = modNameP <* RE.sym '.' <* RE.some RE.anySym + conIDP = RE.withMatched $ + RE.psym isUpper + *> RE.many + (RE.psym $ \c -> c == '\'' || c == '_' || isUpper c || isLower c || isDigit c) + modNameP = fmap snd $ RE.withMatched $ conIDP `sepBy1` RE.sym '.' constructNewImportSuggestions From 56b27a321e15bd7f8e2033428c6407de1d8b42de Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 15 Jul 2023 16:14:27 +0900 Subject: [PATCH 06/16] ci: `regex-applicative-text` constraint in nightly CI --- stack.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/stack.yaml b/stack.yaml index 473661211e..6095173547 100644 --- a/stack.yaml +++ b/stack.yaml @@ -56,6 +56,7 @@ extra-deps: - hw-fingertree-0.1.2.1 - hw-prim-0.6.3.2 - ansi-terminal-0.11.5 +- regex-applicative-text-0.1.0.1 configure-options: ghcide: From 907704c77e8b13d0412a973c13d518ee6ba5d171 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 15 Jul 2023 16:23:16 +0900 Subject: [PATCH 07/16] fix: Switches from `regex-applicative-text` to `regex-applicative` (due to version constraints) --- plugins/hls-refactor-plugin/hls-refactor-plugin.cabal | 2 +- .../src/Development/IDE/Plugin/CodeAction.hs | 4 ++-- stack.yaml | 1 - 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal index bc48ec99c0..42cd50c7ad 100644 --- a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal +++ b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal @@ -87,7 +87,7 @@ library , data-default , time -- FIXME: Only needed to workaround for qualified imports in GHC 9.4 - , regex-applicative-text + , regex-applicative , parser-combinators ghc-options: -Wall -Wno-name-shadowing default-language: Haskell2010 diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 32714bedee..08fd0859a1 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -69,7 +69,7 @@ import Development.IDE.Types.Logger hiding import Development.IDE.Types.Options import GHC.Exts (fromList) import qualified GHC.LanguageExtensions as Lang -import qualified Text.Regex.Applicative.Text as RE +import qualified Text.Regex.Applicative as RE #if MIN_VERSION_ghc(9,4,0) import GHC.Parser.Annotation (TokenLocation (..)) #endif @@ -1512,7 +1512,7 @@ suggestNewImport _ _ _ _ _ = [] -- FIXME: We can delete this after dropping the support for GHC 9.4 extractQualifiedModuleNameFromMissingName :: T.Text -> Maybe T.Text extractQualifiedModuleNameFromMissingName (T.strip -> missing) - = missing RE.=~ qualIdentP + = T.pack <$> (T.unpack missing RE.=~ qualIdentP) where {- NOTE: Haskell 2010 allows /unicode/ upper & lower letters diff --git a/stack.yaml b/stack.yaml index 6095173547..473661211e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -56,7 +56,6 @@ extra-deps: - hw-fingertree-0.1.2.1 - hw-prim-0.6.3.2 - ansi-terminal-0.11.5 -- regex-applicative-text-0.1.0.1 configure-options: ghcide: From eaf396ff49ede3dcefe29d40cda394ae2370e4d5 Mon Sep 17 00:00:00 2001 From: Hiromi Ishii Date: Sat, 15 Jul 2023 16:36:19 +0900 Subject: [PATCH 08/16] Fixes import list --- .../src/Development/IDE/Plugin/CodeAction.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 08fd0859a1..7c77aafd92 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -15,6 +15,7 @@ module Development.IDE.Plugin.CodeAction ) where import Control.Applicative ((<|>)) +import Control.Applicative.Combinators.NonEmpty (sepBy1) import Control.Arrow (second, (&&&), (>>>)) @@ -100,7 +101,6 @@ import Language.LSP.VFS (VirtualFile, import qualified Text.Fuzzy.Parallel as TFP import Text.Regex.TDFA ((=~), (=~~)) #if MIN_VERSION_ghc(9,2,0) -import Control.Applicative.Combinators.NonEmpty (sepBy1) import GHC (AddEpAnn (AddEpAnn), Anchor (anchor_op), AnchorOperation (..), From a8ecc929e39d4a5b66161ce50e340759e8ef39fa Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Jul 2023 11:15:57 +0900 Subject: [PATCH 09/16] doc: Notes on the rationale behind `missing` --- .../src/Development/IDE/Plugin/CodeAction.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 7c77aafd92..660cc6ad12 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -1495,6 +1495,10 @@ suggestNewImport df packageExportsMap ps fileContents Diagnostic{_message, ..} "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’" = let qis = qualifiedImportStyle df -- FIXME: we can use thingMissing once the support for GHC 9.4 is dropped. + -- In what fllows, @missing@ is assumed to be qualified name. + -- @thingMissing@ is already as desired with GHC != 9.4. + -- In GHC 9.4, however, GHC drops a module qualifier from a qualified symbol. + -- Thus we need to explicitly concatenate qualifier explicity in GHC 9.4. missing | GHC94 <- ghcVersion , isNothing (qual <|> qual') From 02cc20110d91e71e55c4a036202daf4f32f8aa69 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Jul 2023 11:38:51 +0900 Subject: [PATCH 10/16] doc: `extractQualifiedModuleNameFromMissingName` --- .../src/Development/IDE/Plugin/CodeAction.hs | 27 +++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 660cc6ad12..10f3f5bf48 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -1512,8 +1512,31 @@ suggestNewImport df packageExportsMap ps fileContents Diagnostic{_message, ..} L _ HsModule {..} = astA ps suggestNewImport _ _ _ _ _ = [] --- tentative workaround for detecting qualification in GHC 9.4 --- FIXME: We can delete this after dropping the support for GHC 9.4 +{- | +Extracts qualifier of the symbol from the migssing symbol. +Input must be either a plain qualified variable or possibly-parenthesized qualified binary operator (though no strict checking is done for symbol part). +This is only needed to alleviate the issue #3473. + +FIXME: We can delete this after dropping the support for GHC 9.4 + +>>> extractQualifiedModuleNameFromMissingName "P.lookup" +Just "P" + +>>> extractQualifiedModuleNameFromMissingName "ΣP3_'.σlookup" +Just "\931P3_'" + +>>> extractQualifiedModuleNameFromMissingName "ModuleA.Gre_ekσ.goodδ" +Just "ModuleA.Gre_ek\963" + +>>> extractQualifiedModuleNameFromMissingName "(ModuleA.Gre_ekσ.+)" +Just "ModuleA.Gre_ek\963" + +>>> extractQualifiedModuleNameFromMissingName "(ModuleA.Gre_ekσ..|.)" +Just "ModuleA.Gre_ek\963" + +>>> extractQualifiedModuleNameFromMissingName "A.B.|." +Just "A.B" +-} extractQualifiedModuleNameFromMissingName :: T.Text -> Maybe T.Text extractQualifiedModuleNameFromMissingName (T.strip -> missing) = T.pack <$> (T.unpack missing RE.=~ qualIdentP) From b2c5f78513b65b1f0efe2936f1a950b993870450 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Jul 2023 14:08:10 +0900 Subject: [PATCH 11/16] refactor: extractText-related refactoring --- hls-plugin-api/src/Ide/PluginUtils.hs | 172 ++++++++++-------- .../src/Ide/Plugin/Floskell.hs | 2 +- .../src/Ide/Plugin/StylishHaskell.hs | 2 +- 3 files changed, 95 insertions(+), 81 deletions(-) diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 3afc9b835d..794e176fa8 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -1,11 +1,13 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} + module Ide.PluginUtils ( -- * LSP Range manipulation functions normalize, extendNextLine, extendLineStart, + extendToFullLines, WithDeletions(..), getProcessID, makeDiffTextEdit, @@ -37,10 +39,9 @@ module Ide.PluginUtils handleMaybeM, throwPluginError, unescape, - ) + ) where - import Control.Arrow ((&&&)) import Control.Lens (_head, _last, re, (%~), (^.)) import Control.Monad.Extra (maybeM) @@ -91,17 +92,33 @@ extendLineStart :: Range -> Range extendLineStart (Range (Position sl _) e) = Range (Position sl 0) e +-- | Extend 'Range' to include the start of the first line and start of the next line of the last line. +-- +-- Caveat: It always extend the last line to the beginning of next line, even when the last position is at column 0. +-- This is to keep the compatibility with the implementation of old function @extractRange@. +-- +-- >>> extendToFullLines (Range (Position 5 5) (Position 5 10)) +-- Range (Position 5 0) (Position 6 0) +-- +-- >>> extendToFullLines (Range (Position 5 5) (Position 7 2)) +-- Range (Position 5 0) (Position 8 0) +-- +-- >>> extendToFullLines (Range (Position 5 5) (Position 7 0)) +-- Range (Position 5 0) (Position 8 0) +extendToFullLines :: Range -> Range +extendToFullLines = extendLineStart . extendNextLine + + -- --------------------------------------------------------------------- data WithDeletions = IncludeDeletions | SkipDeletions - deriving Eq + deriving (Eq) -- | Generate a 'WorkspaceEdit' value from a pair of source Text -diffText :: ClientCapabilities -> (VersionedTextDocumentIdentifier,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit +diffText :: ClientCapabilities -> (VersionedTextDocumentIdentifier, T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit diffText clientCaps old new withDeletions = - let - supports = clientSupportsDocumentChanges clientCaps - in diffText' supports old new withDeletions + let supports = clientSupportsDocumentChanges clientCaps + in diffText' supports old new withDeletions makeDiffTextEdit :: T.Text -> T.Text -> [TextEdit] makeDiffTextEdit f1 f2 = diffTextEdit f1 f2 IncludeDeletions @@ -115,13 +132,14 @@ diffTextEdit fText f2Text withDeletions = r r = map diffOperationToTextEdit diffOps d = getGroupedDiff (lines $ T.unpack fText) (lines $ T.unpack f2Text) - diffOps = filter (\x -> (withDeletions == IncludeDeletions) || not (isDeletion x)) - (diffToLineRanges d) + diffOps = + filter + (\x -> (withDeletions == IncludeDeletions) || not (isDeletion x)) + (diffToLineRanges d) isDeletion (Deletion _ _) = True isDeletion _ = False - diffOperationToTextEdit :: DiffOperation LineRange -> TextEdit diffOperationToTextEdit (Change fm to) = TextEdit range nt where @@ -137,17 +155,20 @@ diffTextEdit fText f2Text withDeletions = r -} diffOperationToTextEdit (Deletion (LineRange (sl, el) _) _) = TextEdit range "" where - range = Range (Position (fromIntegral $ sl - 1) 0) - (Position (fromIntegral el) 0) - + range = + Range + (Position (fromIntegral $ sl - 1) 0) + (Position (fromIntegral el) 0) diffOperationToTextEdit (Addition fm l) = TextEdit range nt - -- fm has a range wrt to the changed file, which starts in the current file at l + 1 - -- So the range has to be shifted to start at l + 1 where - range = Range (Position (fromIntegral l) 0) - (Position (fromIntegral l) 0) - nt = T.pack $ unlines $ lrContents fm + -- fm has a range wrt to the changed file, which starts in the current file at l + 1 + -- So the range has to be shifted to start at l + 1 + range = + Range + (Position (fromIntegral l) 0) + (Position (fromIntegral l) 0) + nt = T.pack $ unlines $ lrContents fm calcRange fm = Range s e where @@ -156,12 +177,11 @@ diffTextEdit fText f2Text withDeletions = r s = Position (fromIntegral $ sl - 1) sc -- Note: zero-based lines el = snd $ lrNumbers fm ec = fromIntegral $ length $ last $ lrContents fm - e = Position (fromIntegral $ el - 1) ec -- Note: zero-based lines - + e = Position (fromIntegral $ el - 1) ec -- Note: zero-based lines -- | A pure version of 'diffText' for testing -diffText' :: Bool -> (VersionedTextDocumentIdentifier,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit -diffText' supports (verTxtDocId,fText) f2Text withDeletions = +diffText' :: Bool -> (VersionedTextDocumentIdentifier, T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit +diffText' supports (verTxtDocId, fText) f2Text withDeletions = if supports then WorkspaceEdit Nothing (Just docChanges) Nothing else WorkspaceEdit (Just h) Nothing Nothing @@ -169,7 +189,7 @@ diffText' supports (verTxtDocId,fText) f2Text withDeletions = diff = diffTextEdit fText f2Text withDeletions h = M.singleton (verTxtDocId ^. L.uri) diff docChanges = [InL docEdit] - docEdit = TextDocumentEdit (verTxtDocId ^.re _versionedTextDocumentIdentifier) $ fmap InL diff + docEdit = TextDocumentEdit (verTxtDocId ^. re _versionedTextDocumentIdentifier) $ fmap InL diff -- --------------------------------------------------------------------- @@ -180,8 +200,7 @@ clientSupportsDocumentChanges caps = wCaps <- mwCaps WorkspaceEditClientCapabilities mDc _ _ _ _ <- _workspaceEdit wCaps mDc - in - Just True == supports + in Just True == supports -- --------------------------------------------------------------------- @@ -192,11 +211,11 @@ idePluginsToPluginDesc :: IdePlugins ideState -> [PluginDescriptor ideState] idePluginsToPluginDesc (IdePlugins pp) = pp -- --------------------------------------------------------------------- + -- | Returns the current client configuration. It is not wise to permanently -- cache the returned value of this function, as clients can at runtime change -- their configuration. --- -getClientConfig :: MonadLsp Config m => m Config +getClientConfig :: (MonadLsp Config m) => m Config getClientConfig = getConfig -- --------------------------------------------------------------------- @@ -204,10 +223,10 @@ getClientConfig = getConfig -- | Returns the current plugin configuration. It is not wise to permanently -- cache the returned value of this function, as clients can change their -- configuration at runtime. -getPluginConfig :: MonadLsp Config m => PluginDescriptor c -> m PluginConfig +getPluginConfig :: (MonadLsp Config m) => PluginDescriptor c -> m PluginConfig getPluginConfig plugin = do - config <- getClientConfig - return $ configForPlugin config plugin + config <- getClientConfig + return $ configForPlugin config plugin -- --------------------------------------------------------------------- @@ -224,40 +243,35 @@ usePropertyLsp kn pId p = do -- --------------------------------------------------------------------- --- | Extracts lines in the text overlapping the given range. --- --- See also: 'extractTextInRange' -extractOverlappingLinesWithRange :: Range -> T.Text -> T.Text -extractOverlappingLinesWithRange (Range (Position sl _) (Position el _)) s = newS - where focusLines = take (fromIntegral $ el-sl+1) $ drop (fromIntegral sl) $ T.lines s - newS = T.unlines focusLines - --- | Extracts strictly matching text in the range. +-- | Extracts exactly matching text in the range. -- -- See also: 'extractOverlappingLinesWithRange' extractTextInRange :: Range -> T.Text -> T.Text extractTextInRange (Range (Position sl sc) (Position el ec)) s = newS - where focusLines = take (fromIntegral $ el-sl+1) $ drop (fromIntegral sl) $ T.lines s - -- NOTE: We have to trim the last line first to handle the single-line case - newS = focusLines - & _last %~ T.take (fromIntegral ec) - & _head %~ T.drop (fromIntegral sc) - & T.unlines - + where + focusLines = take (fromIntegral $ el - sl + 1) $ drop (fromIntegral sl) $ T.lines s + -- NOTE: We have to trim the last line first to handle the single-line case + newS = + focusLines + & _last %~ T.take (fromIntegral ec) + & _head %~ T.drop (fromIntegral sc) + -- NOTE: We cannot use unlines here, because we don't want to add trailing newline! + & T.intercalate "\n" -- | Gets the range that covers the entire text fullRange :: T.Text -> Range fullRange s = Range startPos endPos - where startPos = Position 0 0 - endPos = Position lastLine 0 - {- - In order to replace everything including newline characters, - the end range should extend below the last line. From the specification: - "If you want to specify a range that contains a line including - the line ending character(s) then use an end position denoting - the start of the next line" - -} - lastLine = fromIntegral $ length $ T.lines s + where + startPos = Position 0 0 + endPos = Position lastLine 0 + {- + In order to replace everything including newline characters, + the end range should extend below the last line. From the specification: + "If you want to specify a range that contains a line including + the line ending character(s) then use an end position denoting + the start of the next line" + -} + lastLine = fromIntegral $ length $ T.lines s subRange :: Range -> Range -> Bool subRange = isSubrangeOf @@ -266,34 +280,34 @@ subRange = isSubrangeOf allLspCmdIds' :: T.Text -> IdePlugins ideState -> [T.Text] allLspCmdIds' pid (IdePlugins ls) = - allLspCmdIds pid $ map (pluginId &&& pluginCommands) ls + allLspCmdIds pid $ map (pluginId &&& pluginCommands) ls allLspCmdIds :: T.Text -> [(PluginId, [PluginCommand ideState])] -> [T.Text] allLspCmdIds pid commands = concatMap go commands where go (plid, cmds) = map (mkLspCmdId pid plid . commandId) cmds - -- --------------------------------------------------------------------- -getNormalizedFilePath :: Monad m => Uri -> ExceptT String m NormalizedFilePath -getNormalizedFilePath uri = handleMaybe errMsg - $ uriToNormalizedFilePath - $ toNormalizedUri uri - where - errMsg = T.unpack $ "Failed converting " <> getUri uri <> " to NormalizedFilePath" +getNormalizedFilePath :: (Monad m) => Uri -> ExceptT String m NormalizedFilePath +getNormalizedFilePath uri = + handleMaybe errMsg $ + uriToNormalizedFilePath $ + toNormalizedUri uri + where + errMsg = T.unpack $ "Failed converting " <> getUri uri <> " to NormalizedFilePath" -- --------------------------------------------------------------------- -throwPluginError :: Monad m => String -> ExceptT String m b +throwPluginError :: (Monad m) => String -> ExceptT String m b throwPluginError = throwE -handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b +handleMaybe :: (Monad m) => e -> Maybe b -> ExceptT e m b handleMaybe msg = maybe (throwE msg) return -handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b +handleMaybeM :: (Monad m) => e -> m (Maybe b) -> ExceptT e m b handleMaybeM msg act = maybeM (throwE msg) return $ lift act -pluginResponse :: Monad m => ExceptT String m a -> m (Either ResponseError a) +pluginResponse :: (Monad m) => ExceptT String m a -> m (Either ResponseError a) pluginResponse = fmap (first (\msg -> ResponseError (InR ErrorCodes_InternalError) (fromString msg) Nothing)) . runExceptT @@ -307,9 +321,9 @@ type TextParser = P.Parsec Void T.Text -- display as is. unescape :: T.Text -> T.Text unescape input = - case P.runParser escapedTextParser "inline" input of - Left _ -> input - Right strs -> T.pack strs + case P.runParser escapedTextParser "inline" input of + Left _ -> input + Right strs -> T.pack strs -- | Parser for a string that contains double quotes. Returns unescaped string. escapedTextParser :: TextParser String @@ -320,11 +334,11 @@ escapedTextParser = concat <$> P.many (outsideStringLiteral P.<|> stringLiteral) stringLiteral :: TextParser String stringLiteral = do - inside <- P.char '"' >> P.manyTill P.charLiteral (P.char '"') - let f '"' = "\\\"" -- double quote should still be escaped - -- Despite the docs, 'showLitChar' and 'showLitString' from 'Data.Char' DOES ESCAPE unicode printable - -- characters. So we need to call 'isPrint' from 'Data.Char' manually. - f ch = if isPrint ch then [ch] else showLitChar ch "" - inside' = concatMap f inside - - pure $ "\"" <> inside' <> "\"" + inside <- P.char '"' >> P.manyTill P.charLiteral (P.char '"') + let f '"' = "\\\"" -- double quote should still be escaped + -- Despite the docs, 'showLitChar' and 'showLitString' from 'Data.Char' DOES ESCAPE unicode printable + -- characters. So we need to call 'isPrint' from 'Data.Char' manually. + f ch = if isPrint ch then [ch] else showLitChar ch "" + inside' = concatMap f inside + + pure $ "\"" <> inside' <> "\"" diff --git a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs index 5c0abacba2..c8abd55b36 100644 --- a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs +++ b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs @@ -33,7 +33,7 @@ provider _ideState typ contents fp _ = liftIO $ do config <- findConfigOrDefault file let (range, selectedContents) = case typ of FormatText -> (fullRange contents, contents) - FormatRange r -> (normalize r, extractOverlappingLinesWithRange r contents) + FormatRange r -> (normalize r, extractTextInRange (extendToFullLines r) contents) result = reformat config (Just file) . TL.encodeUtf8 $ TL.fromStrict selectedContents case result of Left err -> pure $ Left $ responseError $ T.pack $ "floskellCmd: " ++ err diff --git a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs index af77e5dbac..6865bf9ee7 100644 --- a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs +++ b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs @@ -36,7 +36,7 @@ provider ide typ contents fp _opts = do mergedConfig <- liftIO $ getMergedConfig dyn config let (range, selectedContents) = case typ of FormatText -> (fullRange contents, contents) - FormatRange r -> (normalize r, extractOverlappingLinesWithRange r contents) + FormatRange r -> (normalize r, extractTextInRange (extendToFullLines r) contents) result = runStylishHaskell file mergedConfig selectedContents case result of Left err -> return $ Left $ responseError $ T.pack $ "stylishHaskellCmd: " ++ err From d0e5765af1803fe8fd4fb3ee687336aac6d83fa0 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Jul 2023 14:16:05 +0900 Subject: [PATCH 12/16] refactor: Use record wildcards alone --- .../src/Development/IDE/Plugin/CodeAction.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 10f3f5bf48..e9680eda43 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -1476,7 +1476,7 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos where moduleText = moduleNameText identInfo suggestNewImport :: DynFlags -> ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] -suggestNewImport df packageExportsMap ps fileContents Diagnostic{_message, ..} +suggestNewImport df packageExportsMap ps fileContents Diagnostic{..} | msg <- unifySpaces _message , Just thingMissing <- extractNotInScopeName msg , qual <- extractQualifiedModuleName msg From 9e1a23097581e05afff2daed660f9f8ccbcb1b5b Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Jul 2023 14:19:21 +0900 Subject: [PATCH 13/16] refactor: cosmetic chagnes around indentation consistency --- plugins/hls-refactor-plugin/test/Main.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 00c0bfdad9..b7fac7ce76 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -1671,10 +1671,10 @@ suggestImportTests = testGroup "suggest import actions" , test True [] "f = empty" [] "import Control.Applicative" , test True [] "f = (&)" [] "import Data.Function ((&))" , test True [] "f = NE.nonEmpty" [] "import qualified Data.List.NonEmpty as NE" - , test True [] "f = (NE.:|)" [] "import qualified Data.List.NonEmpty as NE" - , test True [] "f = (Data.List.NonEmpty.:|)" [] "import qualified Data.List.NonEmpty" - , test True [] "f = (B..|.)" [] "import qualified Data.Bits as B" - , test True [] "f = (Data.Bits..|.)" [] "import qualified Data.Bits" + , test True [] "f = (NE.:|)" [] "import qualified Data.List.NonEmpty as NE" + , test True [] "f = (Data.List.NonEmpty.:|)" [] "import qualified Data.List.NonEmpty" + , test True [] "f = (B..|.)" [] "import qualified Data.Bits as B" + , test True [] "f = (Data.Bits..|.)" [] "import qualified Data.Bits" , test True [] "f :: Typeable a => a" ["f = undefined"] "import Data.Typeable (Typeable)" , test True [] "f = pack" [] "import Data.Text (pack)" , test True [] "f :: Text" ["f = undefined"] "import Data.Text (Text)" From bc57292dd1fa8ccc03e01d5ca2837915341c07da Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Jul 2023 14:40:49 +0900 Subject: [PATCH 14/16] fix: Fixes dead export --- hls-plugin-api/src/Ide/PluginUtils.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 794e176fa8..d64a26fd4f 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -21,7 +21,6 @@ module Ide.PluginUtils getPluginConfig, configForPlugin, pluginEnabled, - extractOverlappingLinesWithRange, extractTextInRange, fullRange, mkLspCommand, @@ -243,9 +242,7 @@ usePropertyLsp kn pId p = do -- --------------------------------------------------------------------- --- | Extracts exactly matching text in the range. --- --- See also: 'extractOverlappingLinesWithRange' +-- | Extracts exact matching text in the range. extractTextInRange :: Range -> T.Text -> T.Text extractTextInRange (Range (Position sl sc) (Position el ec)) s = newS where From d96d47092b08c1da1f0eac38f7cbb8509dcb3f37 Mon Sep 17 00:00:00 2001 From: Hiromi Ishii Date: Sat, 22 Jul 2023 17:05:55 +0900 Subject: [PATCH 15/16] Corrects typo (Thanks @fendor!) Co-authored-by: fendor --- .../src/Development/IDE/Plugin/CodeAction.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index e9680eda43..a66b6f49b7 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -1513,7 +1513,7 @@ suggestNewImport df packageExportsMap ps fileContents Diagnostic{..} suggestNewImport _ _ _ _ _ = [] {- | -Extracts qualifier of the symbol from the migssing symbol. +Extracts qualifier of the symbol from the missing symbol. Input must be either a plain qualified variable or possibly-parenthesized qualified binary operator (though no strict checking is done for symbol part). This is only needed to alleviate the issue #3473. From e0eb90a159d0ede5c8b6aab106a79d2d994f1b7f Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Sat, 22 Jul 2023 17:11:29 +0900 Subject: [PATCH 16/16] refactor: Makes `mapNotInScope` local and renames to `qualify` --- .../src/Development/IDE/Plugin/CodeAction.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index a66b6f49b7..d915496a24 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -1503,12 +1503,16 @@ suggestNewImport df packageExportsMap ps fileContents Diagnostic{..} | GHC94 <- ghcVersion , isNothing (qual <|> qual') , Just q <- qualGHC94 = - mapNotInScope ((q <> ".") <>) thingMissing + qualify q thingMissing | otherwise = thingMissing suggestions = nubSortBy simpleCompareImportSuggestion (constructNewImportSuggestions packageExportsMap (qual <|> qual' <|> qualGHC94, missing) extendImportSuggestions qis) in map (\(ImportSuggestion _ kind (unNewImport -> imp)) -> (imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " "))) suggestions where + qualify q (NotInScopeDataConstructor d) = NotInScopeDataConstructor (q <> "." <> d) + qualify q (NotInScopeTypeConstructorOrClass d) = NotInScopeTypeConstructorOrClass (q <> "." <> d) + qualify q (NotInScopeThing d) = NotInScopeThing (q <> "." <> d) + L _ HsModule {..} = astA ps suggestNewImport _ _ _ _ _ = [] @@ -1815,11 +1819,6 @@ data NotInScope | NotInScopeThing T.Text deriving Show -mapNotInScope :: (T.Text -> T.Text) -> NotInScope -> NotInScope -mapNotInScope f (NotInScopeDataConstructor d) = NotInScopeDataConstructor (f d) -mapNotInScope f (NotInScopeTypeConstructorOrClass d) = NotInScopeTypeConstructorOrClass (f d) -mapNotInScope f (NotInScopeThing d) = NotInScopeThing (f d) - notInScope :: NotInScope -> T.Text notInScope (NotInScopeDataConstructor t) = t notInScope (NotInScopeTypeConstructorOrClass t) = t