diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 1c43c9c13c..d64a26fd4f 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, @@ -19,7 +21,7 @@ module Ide.PluginUtils getPluginConfig, configForPlugin, pluginEnabled, - extractRange, + extractTextInRange, fullRange, mkLspCommand, mkLspCmdId, @@ -36,12 +38,11 @@ module Ide.PluginUtils handleMaybeM, throwPluginError, unescape, - ) + ) 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) @@ -90,17 +91,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 @@ -114,13 +131,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 @@ -136,17 +154,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 @@ -155,12 +176,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 @@ -168,7 +188,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 -- --------------------------------------------------------------------- @@ -179,8 +199,7 @@ clientSupportsDocumentChanges caps = wCaps <- mwCaps WorkspaceEditClientCapabilities mDc _ _ _ _ <- _workspaceEdit wCaps mDc - in - Just True == supports + in Just True == supports -- --------------------------------------------------------------------- @@ -191,11 +210,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 -- --------------------------------------------------------------------- @@ -203,10 +222,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 -- --------------------------------------------------------------------- @@ -223,24 +242,33 @@ usePropertyLsp kn pId p = do -- --------------------------------------------------------------------- -extractRange :: Range -> T.Text -> T.Text -extractRange (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 exact matching text in the range. +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) + -- 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 @@ -249,34 +277,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 @@ -290,9 +318,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 @@ -303,11 +331,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 2c8f6fb92e..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, extractRange 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-refactor-plugin/hls-refactor-plugin.cabal b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal index 7cd78a21f8..42cd50c7ad 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 + , 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 aef45e552b..eafe606e69 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, (&&&), (>>>)) @@ -69,10 +70,12 @@ import GHC.Exts (fromList) import qualified GHC.LanguageExtensions as Lang import Ide.Logger hiding (group) +import qualified Text.Regex.Applicative as RE #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 (..)) @@ -1473,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 @@ -1482,17 +1485,93 @@ 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. + -- 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') + , Just q <- qualGHC94 = + qualify 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 + 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 _ _ _ _ _ = [] +{- | +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. + +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) + 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 :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> QualifiedImportStyle -> [ImportSuggestion] constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules qis = nubOrdBy simpleCompareImportSuggestion diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index d304c5c62f..b7fac7ce76 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -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" 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..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, extractRange 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