diff --git a/ghcide/src/Development/IDE.hs b/ghcide/src/Development/IDE.hs index 7ec68bc8af..8741c98c37 100644 --- a/ghcide/src/Development/IDE.hs +++ b/ghcide/src/Development/IDE.hs @@ -10,7 +10,9 @@ import Development.IDE.Core.Actions as X (getAtPoint, getDefinition, getTypeDefinition) import Development.IDE.Core.FileExists as X (getFileExists) -import Development.IDE.Core.FileStore as X (getFileContents) +import Development.IDE.Core.FileStore as X (getFileContents, + getFileModTimeContents, + getUriContents) import Development.IDE.Core.IdeConfiguration as X (IdeConfiguration (..), isWorkspaceFile) import Development.IDE.Core.OfInterest as X (getFilesOfInterestUntracked) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 6c0cb875b0..3de21e175d 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -3,7 +3,10 @@ {-# LANGUAGE TypeFamilies #-} module Development.IDE.Core.FileStore( + getFileModTimeContents, getFileContents, + getUriContents, + getVersionedTextDoc, setFileModified, setSomethingModified, fileStoreRules, @@ -18,12 +21,13 @@ module Development.IDE.Core.FileStore( isWatchSupported, registerFileWatches, shareFilePath, - Log(..) + Log(..), ) where import Control.Concurrent.STM.Stats (STM, atomically) import Control.Concurrent.STM.TQueue (writeTQueue) import Control.Exception +import Control.Lens ((^.)) import Control.Monad.Extra import Control.Monad.IO.Class import qualified Data.Binary as B @@ -33,6 +37,7 @@ import qualified Data.HashMap.Strict as HashMap import Data.IORef import qualified Data.Text as T import qualified Data.Text as Text +import Data.Text.Utf16.Rope.Mixed (Rope) import Data.Time import Data.Time.Clock.POSIX import Development.IDE.Core.FileUtils @@ -56,13 +61,16 @@ import Ide.Logger (Pretty (pretty), logWith, viaShow, (<+>)) import qualified Ide.Logger as L -import Ide.Plugin.Config (CheckParents (..), - Config) +import Ide.Types +import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message (toUntypedRegistration) import qualified Language.LSP.Protocol.Message as LSP import Language.LSP.Protocol.Types (DidChangeWatchedFilesRegistrationOptions (DidChangeWatchedFilesRegistrationOptions), FileSystemWatcher (..), - _watchers) + TextDocumentIdentifier (..), + VersionedTextDocumentIdentifier (..), + _watchers, + uriToNormalizedFilePath) import qualified Language.LSP.Protocol.Types as LSP import qualified Language.LSP.Server as LSP import Language.LSP.VFS @@ -175,20 +183,20 @@ getFileContentsRule recorder = define (cmapWithPrio LogShake recorder) $ \GetFil getFileContentsImpl :: NormalizedFilePath - -> Action ([FileDiagnostic], Maybe (FileVersion, Maybe T.Text)) + -> Action ([FileDiagnostic], Maybe (FileVersion, Maybe Rope)) getFileContentsImpl file = do -- need to depend on modification time to introduce a dependency with Cutoff time <- use_ GetModificationTime file res <- do mbVirtual <- getVirtualFile file - pure $ virtualFileText <$> mbVirtual + pure $ _file_text <$> mbVirtual pure ([], Just (time, res)) -- | Returns the modification time and the contents. -- For VFS paths, the modification time is the current time. -getFileContents :: NormalizedFilePath -> Action (UTCTime, Maybe T.Text) -getFileContents f = do - (fv, txt) <- use_ GetFileContents f +getFileModTimeContents :: NormalizedFilePath -> Action (UTCTime, Maybe Rope) +getFileModTimeContents f = do + (fv, contents) <- use_ GetFileContents f modTime <- case modificationTime fv of Just t -> pure t Nothing -> do @@ -198,7 +206,29 @@ getFileContents f = do _ -> do posix <- getModTime $ fromNormalizedFilePath f pure $ posixSecondsToUTCTime posix - return (modTime, txt) + return (modTime, contents) + +getFileContents :: NormalizedFilePath -> Action (Maybe Rope) +getFileContents f = snd <$> use_ GetFileContents f + +getUriContents :: NormalizedUri -> Action (Maybe Rope) +getUriContents uri = + join <$> traverse getFileContents (uriToNormalizedFilePath uri) + +-- | Given a text document identifier, annotate it with the latest version. +-- +-- Like Language.LSP.Server.Core.getVersionedTextDoc, but gets the virtual file +-- from the Shake VFS rather than the LSP VFS. +getVersionedTextDoc :: TextDocumentIdentifier -> Action VersionedTextDocumentIdentifier +getVersionedTextDoc doc = do + let uri = doc ^. L.uri + mvf <- + maybe (pure Nothing) getVirtualFile $ + uriToNormalizedFilePath $ toNormalizedUri uri + let ver = case mvf of + Just (VirtualFile lspver _ _) -> lspver + Nothing -> 0 + return (VersionedTextDocumentIdentifier uri ver) fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules () fileStoreRules recorder isWatched = do @@ -303,4 +333,3 @@ shareFilePath k = unsafePerformIO $ do Just v -> (km, v) Nothing -> (HashMap.insert k k km, k) {-# NOINLINE shareFilePath #-} - diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index 76c88421c9..8f1da496e8 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -23,8 +23,12 @@ module Development.IDE.Core.PluginUtils , toCurrentRangeE , toCurrentRangeMT , fromCurrentRangeE -, fromCurrentRangeMT) where +, fromCurrentRangeMT +-- Formatting handlers +, mkFormattingHandlers) where +import Control.Lens ((^.)) +import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Reader (runReaderT) @@ -32,7 +36,10 @@ import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe import Data.Functor.Identity import qualified Data.Text as T +import qualified Data.Text.Utf16.Rope.Mixed as Rope +import Development.IDE.Core.FileStore import Development.IDE.Core.PositionMapping +import Development.IDE.Core.Service (runAction) import Development.IDE.Core.Shake (IdeAction, IdeRule, IdeState (shakeExtras), mkDelayedAction, @@ -44,6 +51,9 @@ import Development.IDE.Types.Location (NormalizedFilePath) import qualified Development.IDE.Types.Location as Location import qualified Ide.Logger as Logger import Ide.Plugin.Error +import Ide.Types +import qualified Language.LSP.Protocol.Lens as LSP +import Language.LSP.Protocol.Message (SMethod (..)) import qualified Language.LSP.Protocol.Types as LSP -- ---------------------------------------------------------------------------- @@ -162,3 +172,34 @@ fromCurrentRangeE mapping = maybeToExceptT (PluginInvalidUserState "fromCurrentR -- |MaybeT version of `fromCurrentRange` fromCurrentRangeMT :: Monad m => PositionMapping -> LSP.Range -> MaybeT m LSP.Range fromCurrentRangeMT mapping = MaybeT . pure . fromCurrentRange mapping + +-- ---------------------------------------------------------------------------- +-- Formatting handlers +-- ---------------------------------------------------------------------------- + +-- `mkFormattingHandlers` was moved here from hls-plugin-api package so that +-- `mkFormattingHandlers` can refer to `IdeState`. `IdeState` is defined in the +-- ghcide package, but hls-plugin-api does not depend on ghcide, so `IdeState` +-- is not in scope there. + +mkFormattingHandlers :: FormattingHandler IdeState -> PluginHandlers IdeState +mkFormattingHandlers f = mkPluginHandler SMethod_TextDocumentFormatting ( provider SMethod_TextDocumentFormatting) + <> mkPluginHandler SMethod_TextDocumentRangeFormatting (provider SMethod_TextDocumentRangeFormatting) + where + provider :: forall m. FormattingMethod m => SMethod m -> PluginMethodHandler IdeState m + provider m ide _pid params + | Just nfp <- LSP.uriToNormalizedFilePath $ LSP.toNormalizedUri uri = do + contentsMaybe <- liftIO $ runAction "mkFormattingHandlers" ide $ getFileContents nfp + case contentsMaybe of + Just contents -> do + let (typ, mtoken) = case m of + SMethod_TextDocumentFormatting -> (FormatText, params ^. LSP.workDoneToken) + SMethod_TextDocumentRangeFormatting -> (FormatRange (params ^. LSP.range), params ^. LSP.workDoneToken) + _ -> Prelude.error "mkFormattingHandlers: impossible" + f ide mtoken typ (Rope.toText contents) nfp opts + Nothing -> throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri + + | otherwise = throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri + where + uri = params ^. LSP.textDocument . LSP.uri + opts = params ^. LSP.options diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 3d60669f5c..046cc9246e 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -35,7 +35,7 @@ import Development.IDE.Types.KnownTargets import GHC.Generics (Generic) import Data.ByteString (ByteString) -import Data.Text (Text) +import Data.Text.Utf16.Rope.Mixed (Rope) import Development.IDE.Import.FindImports (ArtifactsLocation) import Development.IDE.Spans.Common import Development.IDE.Spans.LocalBindings @@ -275,7 +275,7 @@ type instance RuleResult GetModIfaceFromDiskAndIndex = HiFileResult type instance RuleResult GetModIface = HiFileResult -- | Get the contents of a file, either dirty (if the buffer is modified) or Nothing to mean use from disk. -type instance RuleResult GetFileContents = (FileVersion, Maybe Text) +type instance RuleResult GetFileContents = (FileVersion, Maybe Rope) type instance RuleResult GetFileExists = Bool diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index b0d61579cc..4f80b2e635 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -91,6 +91,7 @@ import Data.Maybe import Data.Proxy import qualified Data.Text as T import qualified Data.Text.Encoding as T +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Data.Time (UTCTime (..)) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Tuple.Extra @@ -99,6 +100,7 @@ import Development.IDE.Core.Compile import Development.IDE.Core.FileExists hiding (Log, LogShake) import Development.IDE.Core.FileStore (getFileContents, + getFileModTimeContents, getModTime) import Development.IDE.Core.IdeConfiguration import Development.IDE.Core.OfInterest hiding (Log, @@ -220,10 +222,10 @@ toIdeResult = either (, Nothing) (([],) . Just) -- TODO: return text --> return rope getSourceFileSource :: NormalizedFilePath -> Action BS.ByteString getSourceFileSource nfp = do - (_, msource) <- getFileContents nfp + msource <- getFileContents nfp case msource of Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath nfp) - Just source -> pure $ T.encodeUtf8 source + Just source -> pure $ T.encodeUtf8 $ Rope.toText source -- | Parse the contents of a haskell file. getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule) @@ -861,10 +863,10 @@ getModSummaryRule displayTHWarning recorder = do session' <- hscEnv <$> use_ GhcSession f modify_dflags <- getModifyDynFlags dynFlagsModifyGlobal let session = hscSetFlags (modify_dflags $ hsc_dflags session') session' - (modTime, mFileContent) <- getFileContents f + (modTime, mFileContent) <- getFileModTimeContents f let fp = fromNormalizedFilePath f modS <- liftIO $ runExceptT $ - getModSummaryFromImports session fp modTime (textToStringBuffer <$> mFileContent) + getModSummaryFromImports session fp modTime (textToStringBuffer . Rope.toText <$> mFileContent) case modS of Right res -> do -- Check for Template Haskell diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index e37c3741c7..1c25fa9ee0 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -162,9 +162,7 @@ import Ide.Logger hiding (Priority) import qualified Ide.Logger as Logger import Ide.Plugin.Config import qualified Ide.PluginUtils as HLS -import Ide.Types (IdePlugins (IdePlugins), - PluginDescriptor (pluginId), - PluginId) +import Ide.Types import Language.LSP.Diagnostics import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 337f159424..0564855177 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -19,6 +19,7 @@ import qualified Data.HashSet as Set import Data.Maybe import qualified Data.Text as T import Development.IDE.Core.Compile +import Development.IDE.Core.FileStore (getUriContents) import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes @@ -165,8 +166,9 @@ getCompletionsLSP ide plId CompletionParams{_textDocument=TextDocumentIdentifier uri ,_position=position ,_context=completionContext} = ExceptT $ do - contents <- pluginGetVirtualFile $ toNormalizedUri uri - fmap Right $ case (contents, uriToFilePath' uri) of + contentsMaybe <- + liftIO $ runAction "Completion" ide $ getUriContents $ toNormalizedUri uri + fmap Right $ case (contentsMaybe, uriToFilePath' uri) of (Just cnts, Just path) -> do let npath = toNormalizedFilePath' path (ideOpts, compls, moduleExports, astres) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do @@ -200,7 +202,7 @@ getCompletionsLSP ide plId pure (opts, fmap (,pm,binds) compls, moduleExports, astres) case compls of Just (cci', parsedMod, bindMap) -> do - let pfix = getCompletionPrefix position cnts + let pfix = getCompletionPrefixFromRope position cnts case (pfix, completionContext) of (PosPrefixInfo _ "" _ _, Just CompletionContext { _triggerCharacter = Just "."}) -> return (InL []) diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index a2b4981a38..4df16c6704 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -15,6 +15,8 @@ import qualified Data.List as List import qualified Data.Maybe as Maybe import Data.Text (Text, pack) import qualified Data.Text as Text +import Data.Text.Utf16.Rope.Mixed (Rope) +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE (srcSpanToRange, IdeState, NormalizedFilePath, GhcSession (..), getFileContents, hscEnv, runAction) import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util @@ -27,10 +29,10 @@ import qualified Data.Text as T import Development.IDE.Core.PluginUtils import qualified Language.LSP.Protocol.Lens as L -getNextPragmaInfo :: DynFlags -> Maybe Text -> NextPragmaInfo -getNextPragmaInfo dynFlags mbSourceText = - if | Just sourceText <- mbSourceText - , let sourceStringBuffer = stringToStringBuffer (Text.unpack sourceText) +getNextPragmaInfo :: DynFlags -> Maybe Rope -> NextPragmaInfo +getNextPragmaInfo dynFlags mbSource = + if | Just source <- mbSource + , let sourceStringBuffer = stringToStringBuffer (Text.unpack (Rope.toText source)) , POk _ parserState <- parsePreDecl dynFlags sourceStringBuffer -> case parserState of ParserStateNotDone{ nextPragma } -> nextPragma @@ -56,7 +58,7 @@ insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma = LSP.TextEdit prag getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m NextPragmaInfo getFirstPragma (PluginId pId) state nfp = do (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE (T.unpack pId <> ".GhcSession") state $ useWithStaleE GhcSession nfp - (_, fileContents) <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp + fileContents <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp pure $ getNextPragmaInfo sessionDynFlags fileContents -- Pre-declaration comments parser ----------------------------------------------------- diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 85c1146f6e..447882a61e 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -137,6 +137,7 @@ library hls-cabal-fmt-plugin , process-extras , text +-- The `hls-cabal-plugin` is needed for tests, as we need to install notification handlers test-suite hls-cabal-fmt-plugin-tests import: defaults, pedantic, test-defaults, warnings if !flag(cabalfmt) @@ -148,7 +149,9 @@ test-suite hls-cabal-fmt-plugin-tests , base , directory , filepath + , haskell-language-server:hls-cabal-plugin , haskell-language-server:hls-cabal-fmt-plugin + , hls-plugin-api == 2.9.0.1 , hls-test-utils == 2.9.0.1 if flag(isolateCabalfmtTests) @@ -192,6 +195,7 @@ library hls-cabal-gild-plugin , mtl , process-extras +-- The `hls-cabal-plugin` is needed for tests, as we need to install notification handlers test-suite hls-cabal-gild-plugin-tests import: defaults, pedantic, test-defaults, warnings if !flag(cabalgild) @@ -203,7 +207,9 @@ test-suite hls-cabal-gild-plugin-tests , base , directory , filepath + , haskell-language-server:hls-cabal-plugin , haskell-language-server:hls-cabal-gild-plugin + , hls-plugin-api == 2.9.0.1 , hls-test-utils == 2.9.0.1 if flag(isolateCabalGildTests) @@ -269,6 +275,7 @@ library hls-cabal-plugin , lsp-types ^>=2.3 , regex-tdfa ^>=1.3.1 , text + , text-rope , transformers , unordered-containers >=0.2.10.0 , containers @@ -485,6 +492,7 @@ library hls-eval-plugin , mtl , parser-combinators >=1.2 , text + , text-rope , transformers , unliftio , unordered-containers @@ -665,6 +673,7 @@ library hls-retrie-plugin , safe-exceptions , stm , text + , text-rope , transformers , unordered-containers @@ -733,6 +742,7 @@ library hls-hlint-plugin , stm , temporary , text + , text-rope , transformers , unordered-containers , ghc-lib-parser-ex @@ -863,6 +873,7 @@ library hls-module-name-plugin , hls-plugin-api == 2.9.0.1 , lsp , text + , text-rope , transformers @@ -1077,6 +1088,7 @@ library hls-qualify-imported-names-plugin , lens , lsp , text + , text-rope , dlist , transformers @@ -1672,6 +1684,7 @@ library hls-refactor-plugin , hls-plugin-api == 2.9.0.1 , lsp , text + , text-rope , transformers , unordered-containers , containers diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index fac6cd6b6b..b77c5404fc 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -26,12 +26,12 @@ module Ide.Types , ConfigDescriptor(..), defaultConfigDescriptor, configForPlugin , CustomConfig(..), mkCustomConfig , FallbackCodeActionParams(..) -, FormattingType(..), FormattingMethod, FormattingHandler, mkFormattingHandlers +, FormattingType(..), FormattingMethod, FormattingHandler , HasTracing(..) , PluginCommand(..), CommandId(..), CommandFunction, mkLspCommand, mkLspCmdId , PluginId(..) , PluginHandler(..), mkPluginHandler -, HandlerM, runHandlerM, pluginGetClientCapabilities, pluginGetVirtualFile, pluginGetVersionedTextDoc, pluginSendNotification, pluginSendRequest, pluginWithIndefiniteProgress +, HandlerM, runHandlerM, pluginGetClientCapabilities, pluginSendNotification, pluginSendRequest, pluginWithIndefiniteProgress , PluginHandlers(..) , PluginMethod(..) , PluginMethodHandler @@ -64,7 +64,6 @@ import Control.Lens (_Just, view, (.~), (?~), (^.), import Control.Monad (void) import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.IO.Class (MonadIO) -import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Trans.Except (ExceptT, runExceptT) import Data.Aeson hiding (Null, defaultOptions) import qualified Data.Aeson.Types as A @@ -911,29 +910,15 @@ instance GCompare IdeNotification where -- | Restricted version of 'LspM' specific to plugins. -- --- We plan to use this monad for running plugins instead of 'LspM', since there --- are parts of the LSP server state which plugins should not access directly, --- but instead only via the build system. Note that this restriction of the LSP --- server state has not yet been implemented. See 'pluginGetVirtualFile'. +-- We use this monad for running plugins instead of 'LspM', since there are +-- parts of the LSP server state which plugins should not access directly, but +-- instead only via the build system. newtype HandlerM config a = HandlerM { _runHandlerM :: LspM config a } deriving newtype (Applicative, Functor, Monad, MonadIO, MonadUnliftIO) runHandlerM :: HandlerM config a -> LspM config a runHandlerM = _runHandlerM --- | Wrapper of 'getVirtualFile' for HandlerM --- --- TODO: To be replaced by a lookup of the Shake build graph -pluginGetVirtualFile :: NormalizedUri -> HandlerM config (Maybe VirtualFile) -pluginGetVirtualFile uri = HandlerM $ getVirtualFile uri - --- | Version of 'getVersionedTextDoc' for HandlerM --- --- TODO: Should use 'pluginGetVirtualFile' instead of wrapping 'getVersionedTextDoc'. --- At the time of writing, 'getVersionedTextDoc' of the "lsp" package is implemented with 'getVirtualFile'. -pluginGetVersionedTextDoc :: TextDocumentIdentifier -> HandlerM config VersionedTextDocumentIdentifier -pluginGetVersionedTextDoc = HandlerM . getVersionedTextDoc - -- | Wrapper of 'getClientCapabilities' for HandlerM pluginGetClientCapabilities :: HandlerM config ClientCapabilities pluginGetClientCapabilities = HandlerM getClientCapabilities @@ -1195,31 +1180,8 @@ type FormattingHandler a -> FormattingOptions -> ExceptT PluginError (HandlerM Config) ([TextEdit] |? Null) -mkFormattingHandlers :: forall a. FormattingHandler a -> PluginHandlers a -mkFormattingHandlers f = mkPluginHandler SMethod_TextDocumentFormatting ( provider SMethod_TextDocumentFormatting) - <> mkPluginHandler SMethod_TextDocumentRangeFormatting (provider SMethod_TextDocumentRangeFormatting) - where - provider :: forall m. FormattingMethod m => SMethod m -> PluginMethodHandler a m - provider m ide _pid params - | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do - mf <- lift $ pluginGetVirtualFile $ toNormalizedUri uri - case mf of - Just vf -> do - let (typ, mtoken) = case m of - SMethod_TextDocumentFormatting -> (FormatText, params ^. L.workDoneToken) - SMethod_TextDocumentRangeFormatting -> (FormatRange (params ^. L.range), params ^. L.workDoneToken) - _ -> Prelude.error "mkFormattingHandlers: impossible" - f ide mtoken typ (virtualFileText vf) nfp opts - Nothing -> throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri - - | otherwise = throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri - where - uri = params ^. L.textDocument . L.uri - opts = params ^. L.options - -- --------------------------------------------------------------------- - data FallbackCodeActionParams = FallbackCodeActionParams { fallbackWorkspaceEdit :: Maybe WorkspaceEdit diff --git a/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs b/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs index 305f1df685..8c49f379d7 100644 --- a/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs +++ b/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs @@ -6,22 +6,23 @@ module Ide.Plugin.CabalFmt where import Control.Lens -import Control.Monad.Except (throwError) +import Control.Monad.Except (throwError) import Control.Monad.IO.Class -import qualified Data.Text as T -import Development.IDE hiding (pluginHandlers) -import Ide.Plugin.Error (PluginError (PluginInternalError, PluginInvalidParams)) +import qualified Data.Text as T +import Development.IDE hiding (pluginHandlers) +import Development.IDE.Core.PluginUtils (mkFormattingHandlers) +import Ide.Plugin.Error (PluginError (PluginInternalError, PluginInvalidParams)) import Ide.Plugin.Properties import Ide.PluginUtils import Ide.Types -import qualified Language.LSP.Protocol.Lens as L +import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Types -import Prelude hiding (log) +import Prelude hiding (log) import System.Directory import System.Exit import System.FilePath import System.Process.ListLike -import qualified System.Process.Text as Process +import qualified System.Process.Text as Process data Log = LogProcessInvocationFailure Int diff --git a/plugins/hls-cabal-fmt-plugin/test/Main.hs b/plugins/hls-cabal-fmt-plugin/test/Main.hs index 5069a9d153..be899e517e 100644 --- a/plugins/hls-cabal-fmt-plugin/test/Main.hs +++ b/plugins/hls-cabal-fmt-plugin/test/Main.hs @@ -1,14 +1,26 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Main ( main ) where +import Ide.Logger +import qualified Ide.Plugin.Cabal as Cabal import qualified Ide.Plugin.CabalFmt as CabalFmt import System.Directory (findExecutable) import System.FilePath import Test.Hls +data TestLog + = LogCabalFmt CabalFmt.Log + | LogCabal Cabal.Log + +instance Pretty TestLog where + pretty = \case + LogCabalFmt msg -> pretty msg + LogCabal msg -> pretty msg + data CabalFmtFound = Found | NotFound isTestIsolated :: Bool @@ -30,8 +42,11 @@ main = do foundCabalFmt <- isCabalFmtFound defaultTestRunner (tests foundCabalFmt) -cabalFmtPlugin :: PluginTestDescriptor CabalFmt.Log -cabalFmtPlugin = mkPluginTestDescriptor CabalFmt.descriptor "cabal-fmt" +cabalFmtPlugin :: PluginTestDescriptor TestLog +cabalFmtPlugin = mconcat + [ mkPluginTestDescriptor (CabalFmt.descriptor . cmapWithPrio LogCabalFmt) "cabal-fmt" + , mkPluginTestDescriptor (Cabal.descriptor . cmapWithPrio LogCabal) "cabal" + ] tests :: CabalFmtFound -> TestTree tests found = testGroup "cabal-fmt" diff --git a/plugins/hls-cabal-gild-plugin/src/Ide/Plugin/CabalGild.hs b/plugins/hls-cabal-gild-plugin/src/Ide/Plugin/CabalGild.hs index d0b220e6d0..1d698d637b 100644 --- a/plugins/hls-cabal-gild-plugin/src/Ide/Plugin/CabalGild.hs +++ b/plugins/hls-cabal-gild-plugin/src/Ide/Plugin/CabalGild.hs @@ -5,21 +5,22 @@ module Ide.Plugin.CabalGild where -import Control.Monad.Except (throwError) +import Control.Monad.Except (throwError) import Control.Monad.IO.Class -import qualified Data.Text as T -import Development.IDE hiding (pluginHandlers) -import Ide.Plugin.Error (PluginError (PluginInternalError, PluginInvalidParams)) +import qualified Data.Text as T +import Development.IDE hiding (pluginHandlers) +import Development.IDE.Core.PluginUtils (mkFormattingHandlers) +import Ide.Plugin.Error (PluginError (PluginInternalError, PluginInvalidParams)) import Ide.Plugin.Properties import Ide.PluginUtils import Ide.Types import Language.LSP.Protocol.Types -import Prelude hiding (log) +import Prelude hiding (log) import System.Directory import System.Exit import System.FilePath import System.Process.ListLike -import qualified System.Process.Text as Process +import qualified System.Process.Text as Process data Log = LogProcessInvocationFailure Int T.Text diff --git a/plugins/hls-cabal-gild-plugin/test/Main.hs b/plugins/hls-cabal-gild-plugin/test/Main.hs index 5bf519c69a..5aa5ba9fba 100644 --- a/plugins/hls-cabal-gild-plugin/test/Main.hs +++ b/plugins/hls-cabal-gild-plugin/test/Main.hs @@ -1,14 +1,26 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Main ( main ) where +import Ide.Logger +import qualified Ide.Plugin.Cabal as Cabal import qualified Ide.Plugin.CabalGild as CabalGild import System.Directory (findExecutable) import System.FilePath import Test.Hls +data TestLog + = LogCabalGild CabalGild.Log + | LogCabal Cabal.Log + +instance Pretty TestLog where + pretty = \case + LogCabalGild msg -> pretty msg + LogCabal msg -> pretty msg + data CabalGildFound = Found | NotFound isTestIsolated :: Bool @@ -30,8 +42,11 @@ main = do foundCabalFmt <- isCabalFmtFound defaultTestRunner (tests foundCabalFmt) -cabalGildPlugin :: PluginTestDescriptor CabalGild.Log -cabalGildPlugin = mkPluginTestDescriptor CabalGild.descriptor "cabal-gild" +cabalGildPlugin :: PluginTestDescriptor TestLog +cabalGildPlugin = mconcat + [ mkPluginTestDescriptor (CabalGild.descriptor . cmapWithPrio LogCabalGild) "cabal-gild" + , mkPluginTestDescriptor (Cabal.descriptor . cmapWithPrio LogCabal) "cabal" + ] tests :: CabalGildFound -> TestTree tests found = testGroup "cabal-gild" diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index fdde678845..d68f61639a 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -11,7 +11,7 @@ import Control.DeepSeq import Control.Lens ((^.)) import Control.Monad.Extra import Control.Monad.IO.Class -import Control.Monad.Trans.Class +import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (runMaybeT) import qualified Data.ByteString as BS import Data.Hashable @@ -21,8 +21,10 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as Encoding +import Data.Text.Utf16.Rope.Mixed as Rope import Data.Typeable import Development.IDE as D +import Development.IDE.Core.FileStore (getVersionedTextDoc) import Development.IDE.Core.PluginUtils import Development.IDE.Core.Shake (restartShakeSession) import qualified Development.IDE.Core.Shake as Shake @@ -204,7 +206,7 @@ cabalRules recorder plId = do log' Debug $ LogModificationTime file t contents <- case mCabalSource of Just sources -> - pure $ Encoding.encodeUtf8 sources + pure $ Encoding.encodeUtf8 $ Rope.toText sources Nothing -> do liftIO $ BS.readFile $ fromNormalizedFilePath file @@ -233,7 +235,7 @@ cabalRules recorder plId = do log' Debug $ LogModificationTime file t contents <- case mCabalSource of Just sources -> - pure $ Encoding.encodeUtf8 sources + pure $ Encoding.encodeUtf8 $ Rope.toText sources Nothing -> do liftIO $ BS.readFile $ fromNormalizedFilePath file @@ -291,10 +293,10 @@ licenseSuggestCodeAction ideState _ (CodeActionParams _ _ (TextDocumentIdentifie -- use some sort of fuzzy matching in the future, see issue #4357. fieldSuggestCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do - vfileM <- lift (pluginGetVirtualFile $ toNormalizedUri uri) - case (,) <$> vfileM <*> uriToFilePath' uri of + mContents <- liftIO $ runAction "cabal-plugin.getUriContents" ide $ getUriContents $ toNormalizedUri uri + case (,) <$> mContents <*> uriToFilePath' uri of Nothing -> pure $ InL [] - Just (vfile, path) -> do + Just (fileContents, path) -> do -- We decide on `useWithStale` here, since `useWithStaleFast` often leads to the wrong completions being suggested. -- In case it fails, we still will get some completion results instead of an error. mFields <- liftIO $ runAction "cabal-plugin.fields" ide $ useWithStale ParseCabalFields $ toNormalizedFilePath path @@ -303,13 +305,13 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif pure $ InL [] Just (cabalFields, _) -> do let fields = Maybe.mapMaybe FieldSuggest.fieldErrorName diags - results <- forM fields (getSuggestion vfile path cabalFields) + results <- forM fields (getSuggestion fileContents path cabalFields) pure $ InL $ map InR $ concat results where - getSuggestion vfile fp cabalFields (fieldName,Diagnostic{ _range=_range@(Range (Position lineNr col) _) }) = do + getSuggestion fileContents fp cabalFields (fieldName,Diagnostic{ _range=_range@(Range (Position lineNr col) _) }) = do let -- Compute where we would anticipate the cursor to be. fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length fieldName)) - lspPrefixInfo = Ghcide.getCompletionPrefix fakeLspCursorPosition vfile + lspPrefixInfo = Ghcide.getCompletionPrefixFromRope fakeLspCursorPosition fileContents cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo fp cabalFields let completionTexts = fmap (^. JL.label) completions @@ -329,7 +331,8 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) case mbCabalFile of Nothing -> pure $ InL [] Just cabalFilePath -> do - verTxtDocId <- lift $ pluginGetVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath) + verTxtDocId <- runActionE "cabalAdd.getVersionedTextDoc" state $ + lift $ getVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath) mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath case mbGPD of Nothing -> pure $ InL [] @@ -473,8 +476,8 @@ completion :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.M completion recorder ide _ complParams = do let TextDocumentIdentifier uri = complParams ^. JL.textDocument position = complParams ^. JL.position - mVf <- lift $ pluginGetVirtualFile $ toNormalizedUri uri - case (,) <$> mVf <*> uriToFilePath' uri of + mContents <- liftIO $ runAction "cabal-plugin.getUriContents" ide $ getUriContents $ toNormalizedUri uri + case (,) <$> mContents <*> uriToFilePath' uri of Just (cnts, path) -> do -- We decide on `useWithStale` here, since `useWithStaleFast` often leads to the wrong completions being suggested. -- In case it fails, we still will get some completion results instead of an error. @@ -483,7 +486,7 @@ completion recorder ide _ complParams = do Nothing -> pure . InR $ InR Null Just (fields, _) -> do - let lspPrefInfo = Ghcide.getCompletionPrefix position cnts + let lspPrefInfo = Ghcide.getCompletionPrefixFromRope position cnts cabalPrefInfo = Completions.getCabalPrefixInfo path lspPrefInfo let res = computeCompletionsAt recorder ide cabalPrefInfo path fields liftIO $ fmap InL res diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index e60d06db78..1a086dbc85 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -31,10 +31,11 @@ import Data.String (IsString) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import qualified Data.Text.Encoding as T +import Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE (IdeState, + getFileContents, useWithStale) import Development.IDE.Core.Rules (runAction) -import Development.IDE.Core.RuleTypes (GetFileContents (..)) import Distribution.Client.Add as Add import Distribution.Compat.Prelude (Generic) import Distribution.PackageDescription (GenericPackageDescription, @@ -235,12 +236,12 @@ getDependencyEdit :: MonadIO m => Recorder (WithPriority Log) -> (IdeState, Clie getDependencyEdit recorder env cabalFilePath buildTarget dependency = do let (state, caps, verTxtDocId) = env (mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do - contents <- useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath + contents <- getFileContents $ toNormalizedFilePath cabalFilePath inFields <- useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath inPackDescr <- useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath - let mbCnfOrigContents = case snd . fst <$> contents of - Just (Just txt) -> Just $ encodeUtf8 txt - _ -> Nothing + let mbCnfOrigContents = case contents of + (Just txt) -> Just $ encodeUtf8 $ Rope.toText txt + _ -> Nothing let mbFields = fst <$> inFields let mbPackDescr = fst <$> inPackDescr pure (mbCnfOrigContents, mbFields, mbPackDescr) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs index fa2a1dd46c..5ff79e2e37 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs @@ -24,6 +24,7 @@ import qualified Data.Set as Set import qualified Data.Text as T import Development.IDE import Development.IDE.Core.Compile (sourceTypecheck) +import Development.IDE.Core.FileStore (getVersionedTextDoc) import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping (fromCurrentRange) import Development.IDE.GHC.Compat @@ -80,7 +81,7 @@ addMethodPlaceholders _ state _ param@AddMinimalMethodsParams{..} = do -- sensitive to the format of diagnostic messages from GHC. codeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction codeAction recorder state plId (CodeActionParams _ _ docId _ context) = do - verTxtDocId <- lift $ pluginGetVersionedTextDoc docId + verTxtDocId <- liftIO $ runAction "classplugin.codeAction.getVersionedTextDoc" state $ getVersionedTextDoc docId nfp <- getNormalizedFilePathE (verTxtDocId ^. L.uri) actions <- join <$> mapM (mkActions nfp verTxtDocId) methodDiags pure $ InL actions diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs index 129251ffe5..e73344c341 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs @@ -64,7 +64,7 @@ insertPragmaIfNotPresent :: (MonadIO m) insertPragmaIfNotPresent state nfp pragma = do (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE "classplugin.insertPragmaIfNotPresent.GhcSession" state $ useWithStaleE GhcSession nfp - (_, fileContents) <- liftIO $ runAction "classplugin.insertPragmaIfNotPresent.GetFileContents" state + fileContents <- liftIO $ runAction "classplugin.insertPragmaIfNotPresent.GetFileContents" state $ getFileContents nfp (pm, _) <- runActionE "classplugin.insertPragmaIfNotPresent.GetParsedModuleWithComments" state $ useWithStaleE GetParsedModuleWithComments nfp diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index bf8849a79c..800980ae4a 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -39,7 +39,9 @@ import Data.Maybe (catMaybes) import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Data.Typeable (Typeable) +import Development.IDE.Core.FileStore (getUriContents) import Development.IDE.Core.Rules (IdeState, runAction) import Development.IDE.Core.RuleTypes (LinkableResult (linkableHomeMod), @@ -120,7 +122,6 @@ import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import Language.LSP.Server -import Language.LSP.VFS (virtualFileText) {- | Code Lens provider NOTE: Invoked every time the document is modified, not just when the document is saved. @@ -189,7 +190,7 @@ runEvalCmd recorder plId st mtoken EvalParams{..} = let TextDocumentIdentifier{_uri} = module_ fp <- uriToFilePathE _uri let nfp = toNormalizedFilePath' fp - mdlText <- moduleText _uri + mdlText <- moduleText st _uri -- enable codegen for the module which we need to evaluate. final_hscEnv <- liftIO $ bracket_ @@ -284,12 +285,15 @@ finalReturn txt = p = Position l c in TextEdit (Range p p) "\n" -moduleText :: Uri -> ExceptT PluginError (HandlerM config) Text -moduleText uri = - handleMaybeM (PluginInternalError "mdlText") $ - (virtualFileText <$>) - <$> pluginGetVirtualFile - (toNormalizedUri uri) +moduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text +moduleText state uri = do + contents <- + handleMaybeM (PluginInternalError "mdlText") $ + liftIO $ + runAction "eval.getUriContents" state $ + getUriContents $ + toNormalizedUri uri + pure $ Rope.toText contents testsBySection :: [Section] -> [(Section, EvalId, Test)] testsBySection sections = diff --git a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs index 87f9f49e5b..f78761958c 100644 --- a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs +++ b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs @@ -6,12 +6,13 @@ module Ide.Plugin.Floskell , provider ) where -import Control.Monad.Except (throwError) +import Control.Monad.Except (throwError) import Control.Monad.IO.Class -import Data.List (find) -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import Development.IDE hiding (pluginHandlers) +import Data.List (find) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import Development.IDE hiding (pluginHandlers) +import Development.IDE.Core.PluginUtils (mkFormattingHandlers) import Floskell import Ide.Plugin.Error import Ide.PluginUtils diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index 7615b7d2f2..c12866d7f3 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -12,42 +12,44 @@ module Ide.Plugin.Fourmolu ( ) where import Control.Exception -import Control.Lens ((^.)) -import Control.Monad (guard) -import Control.Monad.Error.Class (MonadError (throwError)) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Trans.Class (MonadTrans (lift)) -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Data.Bifunctor (bimap) -import Data.List (intercalate) -import Data.Maybe (catMaybes) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Version (showVersion) -import Development.IDE hiding (pluginHandlers) -import Development.IDE.GHC.Compat as Compat hiding (Cpp, Warning, - hang, vcat) -import qualified Development.IDE.GHC.Compat.Util as S -import GHC.LanguageExtensions.Type (Extension (Cpp)) +import Control.Lens ((^.)) +import Control.Monad (guard) +import Control.Monad.Error.Class (MonadError (throwError)) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Trans.Class (MonadTrans (lift)) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Data.Bifunctor (bimap) +import Data.List (intercalate) +import Data.Maybe (catMaybes) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Version (showVersion) +import Development.IDE hiding (pluginHandlers) +import Development.IDE.Core.PluginUtils (mkFormattingHandlers) +import Development.IDE.GHC.Compat as Compat hiding (Cpp, + Warning, hang, + vcat) +import qualified Development.IDE.GHC.Compat.Util as S +import GHC.LanguageExtensions.Type (Extension (Cpp)) import Ide.Plugin.Error import Ide.Plugin.Properties -import Ide.PluginUtils (makeDiffTextEdit) +import Ide.PluginUtils (makeDiffTextEdit) import Ide.Types -import Language.LSP.Protocol.Lens (HasTabSize (tabSize)) +import Language.LSP.Protocol.Lens (HasTabSize (tabSize)) import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types -import Language.LSP.Server hiding (defaultConfig) +import Language.LSP.Server hiding (defaultConfig) import Ormolu import Ormolu.Config -import qualified Paths_fourmolu as Fourmolu +import qualified Paths_fourmolu as Fourmolu import System.Exit import System.FilePath -import System.Process.Run (cwd, proc) -import System.Process.Text (readCreateProcessWithExitCode) -import Text.Read (readMaybe) +import System.Process.Run (cwd, proc) +import System.Process.Text (readCreateProcessWithExitCode) +import Text.Read (readMaybe) #if MIN_VERSION_fourmolu(0,16,0) -import qualified Data.Yaml as Yaml +import qualified Data.Yaml as Yaml #endif descriptor :: Recorder (WithPriority LogEvent) -> PluginId -> PluginDescriptor IdeState diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 23a5683c29..b1c88210ad 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -31,7 +31,6 @@ import Control.Exception import Control.Lens ((?~), (^.)) import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson.Types (FromJSON (..), @@ -44,11 +43,14 @@ import qualified Data.Map as M import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as T +import Data.Text.Utf16.Rope.Mixed (Rope) +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Data.Typeable import Development.IDE hiding (Error, getExtensions) import Development.IDE.Core.Compile (sourceParser) +import Development.IDE.Core.FileStore (getVersionedTextDoc) import Development.IDE.Core.Rules (defineNoFile, getParsedModuleWithComments) import Development.IDE.Core.Shake (getDiagnostics) @@ -300,9 +302,9 @@ getIdeas recorder nfp = do then return Nothing else do flags' <- setExtensions flags - (_, contents) <- getFileContents nfp + contents <- getFileContents nfp let fp = fromNormalizedFilePath nfp - let contents' = T.unpack <$> contents + let contents' = T.unpack . Rope.toText <$> contents Just <$> liftIO (parseModuleEx flags' fp contents') setExtensions flags = do @@ -361,7 +363,10 @@ codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context | let TextDocumentIdentifier uri = documentId , Just docNormalizedFilePath <- uriToNormalizedFilePath (toNormalizedUri uri) = do - verTxtDocId <- lift $ pluginGetVersionedTextDoc documentId + verTxtDocId <- + liftIO $ + runAction "Hlint.getVersionedTextDoc" ideState $ + getVersionedTextDoc documentId liftIO $ fmap (InL . map LSP.InR) $ do allDiagnostics <- atomically $ getDiagnostics ideState @@ -440,7 +445,7 @@ mkCodeAction title diagnostic data_ isPreferred = , _data_ = data_ } -mkSuppressHintTextEdits :: DynFlags -> T.Text -> T.Text -> [LSP.TextEdit] +mkSuppressHintTextEdits :: DynFlags -> Rope -> T.Text -> [LSP.TextEdit] mkSuppressHintTextEdits dynFlags fileContents hint = let NextPragmaInfo{ nextPragmaLine, lineSplitTextEdits } = getNextPragmaInfo dynFlags (Just fileContents) @@ -511,7 +516,7 @@ applyHint recorder ide nfp mhint verTxtDocId = let commands = map ideaRefactoring ideas' logWith recorder Debug $ LogGeneratedIdeas nfp commands let fp = fromNormalizedFilePath nfp - (_, mbOldContent) <- liftIO $ runAction' $ getFileContents nfp + mbOldContent <- fmap (fmap Rope.toText) $ liftIO $ runAction' $ getFileContents nfp oldContent <- maybe (liftIO $ fmap T.decodeUtf8 (BS.readFile fp)) return mbOldContent modsum <- liftIO $ runAction' $ use_ GetModSummary nfp let dflags = ms_hspp_opts $ msrModSummary modsum diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index 1b43c45ebe..5dc053f47d 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -30,6 +30,7 @@ import Data.Maybe (mapMaybe) import Data.Ord (comparing) import Data.String (IsString) import qualified Data.Text as T +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE (GetParsedModule (GetParsedModule), GhcSession (GhcSession), IdeState, Pretty, @@ -40,6 +41,7 @@ import Development.IDE (GetParsedModule (GetParse realSrcSpanToRange, rootDir, runAction, useWithStale, (<+>)) +import Development.IDE.Core.FileStore (getFileContents) import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping (toCurrentRange) import Development.IDE.GHC.Compat (GenLocated (L), @@ -54,7 +56,6 @@ import Ide.PluginUtils (toAbsolute) import Ide.Types import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types -import Language.LSP.VFS (virtualFileText) import System.FilePath (dropExtension, normalise, pathSeparator, splitDirectories, @@ -109,8 +110,8 @@ action recorder state uri = do nfp <- getNormalizedFilePathE uri fp <- uriToFilePathE uri - contents <- lift . pluginGetVirtualFile $ toNormalizedUri uri - let emptyModule = maybe True (T.null . T.strip . virtualFileText) contents + contents <- liftIO $ runAction "ModuleName.getFileContents" state $ getFileContents nfp + let emptyModule = maybe True (T.null . T.strip . Rope.toText) contents correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nfp fp logWith recorder Debug (CorrectNames correctNames) diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs index 3d9f398ece..1c40ea76b3 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -3,7 +3,6 @@ module Ide.Plugin.Notes (descriptor, Log) where import Control.Lens ((^.)) import Control.Monad.Except (throwError) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans (lift) import qualified Data.Array as A import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM @@ -25,7 +24,6 @@ import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message (Method (Method_TextDocumentDefinition), SMethod (SMethod_TextDocumentDefinition)) import Language.LSP.Protocol.Types -import Language.LSP.VFS (VirtualFile (..)) import Text.Regex.TDFA (Regex, caseSensitive, defaultCompOpt, defaultExecOpt, @@ -79,8 +77,9 @@ jumpToNote state _ param | Just nfp <- uriToNormalizedFilePath uriOrig = do let Position l c = param ^. L.position - contents <- fmap _file_text . err "Error getting file contents" - =<< lift (pluginGetVirtualFile uriOrig) + contents <- + err "Error getting file contents" + =<< liftIO (runAction "notes.getfileContents" state (getFileContents nfp)) line <- err "Line not found in file" (listToMaybe $ Rope.lines $ fst (Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) contents)) let noteOpt = listToMaybe $ mapMaybe (atPos $ fromIntegral c) $ matchAllText noteRefRegex line @@ -110,7 +109,7 @@ findNotesInFile file recorder = do -- the user. If not, we need to read it from disk. contentOpt <- (snd =<<) <$> use GetFileContents file content <- case contentOpt of - Just x -> pure x + Just x -> pure $ Rope.toText x Nothing -> liftIO $ readFileUtf8 $ fromNormalizedFilePath file let matches = (A.! 1) <$> matchAllText noteRegex content m = toPositions matches content diff --git a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs index 741f158eff..90c5214d8e 100644 --- a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs +++ b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs @@ -10,36 +10,37 @@ module Ide.Plugin.Ormolu ) where -import Control.Exception (Handler (..), IOException, - SomeException (..), catches, - handle) -import Control.Monad.Except (runExceptT, throwError) +import Control.Exception (Handler (..), IOException, + SomeException (..), catches, + handle) +import Control.Monad.Except (runExceptT, throwError) import Control.Monad.Extra import Control.Monad.Trans -import Control.Monad.Trans.Except (ExceptT (..), mapExceptT) -import Data.Functor ((<&>)) -import Data.List (intercalate) -import Data.Maybe (catMaybes) -import Data.Text (Text) -import qualified Data.Text as T -import Development.IDE hiding (pluginHandlers) -import Development.IDE.GHC.Compat (hsc_dflags, moduleNameString) -import qualified Development.IDE.GHC.Compat as D -import qualified Development.IDE.GHC.Compat.Util as S +import Control.Monad.Trans.Except (ExceptT (..), mapExceptT) +import Data.Functor ((<&>)) +import Data.List (intercalate) +import Data.Maybe (catMaybes) +import Data.Text (Text) +import qualified Data.Text as T +import Development.IDE hiding (pluginHandlers) +import Development.IDE.Core.PluginUtils (mkFormattingHandlers) +import Development.IDE.GHC.Compat (hsc_dflags, moduleNameString) +import qualified Development.IDE.GHC.Compat as D +import qualified Development.IDE.GHC.Compat.Util as S import GHC.LanguageExtensions.Type -import Ide.Plugin.Error (PluginError (PluginInternalError)) +import Ide.Plugin.Error (PluginError (PluginInternalError)) import Ide.Plugin.Properties import Ide.PluginUtils -import Ide.Types hiding (Config) -import qualified Ide.Types as Types +import Ide.Types hiding (Config) +import qualified Ide.Types as Types import Language.LSP.Protocol.Types -import Language.LSP.Server hiding (defaultConfig) +import Language.LSP.Server hiding (defaultConfig) import Ormolu import System.Exit import System.FilePath -import System.Process.Run (cwd, proc) -import System.Process.Text (readCreateProcessWithExitCode) -import Text.Read (readMaybe) +import System.Process.Run (cwd, proc) +import System.Process.Text (readCreateProcessWithExitCode) +import Text.Read (readMaybe) -- --------------------------------------------------------------------- diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index 1f218fb1df..3bca988580 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -17,7 +17,6 @@ module Ide.Plugin.Pragmas import Control.Lens hiding (List) import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Trans.Class (lift) import Data.Char (isAlphaNum) import Data.List.Extra (nubOrdOn) import qualified Data.Map as M @@ -29,7 +28,7 @@ import Development.IDE.Core.Compile (sourceParser, import Development.IDE.Core.PluginUtils import Development.IDE.GHC.Compat import Development.IDE.Plugin.Completions (ghcideCompletionsPluginPriority) -import Development.IDE.Plugin.Completions.Logic (getCompletionPrefix) +import Development.IDE.Plugin.Completions.Logic (getCompletionPrefixFromRope) import Development.IDE.Plugin.Completions.Types (PosPrefixInfo (..)) import qualified Development.IDE.Spans.Pragmas as Pragmas import Ide.Plugin.Error @@ -80,7 +79,7 @@ mkCodeActionProvider mkSuggest state _plId -- ghc session to get some dynflags even if module isn't parsed (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE "Pragmas.GhcSession" state $ useWithStaleE GhcSession normalizedFilePath - (_, fileContents) <- liftIO $ runAction "Pragmas.GetFileContents" state $ getFileContents normalizedFilePath + fileContents <- liftIO $ runAction "Pragmas.GetFileContents" state $ getFileContents normalizedFilePath parsedModule <- liftIO $ runAction "Pragmas.GetParsedModule" state $ getParsedModule normalizedFilePath let parsedModuleDynFlags = ms_hspp_opts . pm_mod_summary <$> parsedModule nextPragmaInfo = Pragmas.getNextPragmaInfo sessionDynFlags fileContents @@ -195,13 +194,13 @@ flags :: [T.Text] flags = map T.pack $ flagsForCompletion False completion :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCompletion -completion _ide _ complParams = do +completion ide _ complParams = do let (LSP.TextDocumentIdentifier uri) = complParams ^. L.textDocument position@(Position ln col) = complParams ^. L.position - contents <- lift $ pluginGetVirtualFile $ toNormalizedUri uri + contents <- liftIO $ runAction "Pragmas.GetUriContents" ide $ getUriContents $ toNormalizedUri uri fmap LSP.InL $ case (contents, uriToFilePath' uri) of (Just cnts, Just _path) -> - pure $ result $ getCompletionPrefix position cnts + pure $ result $ getCompletionPrefixFromRope position cnts where result pfix | "{-# language" `T.isPrefixOf` line diff --git a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs index 8b73c9114e..011910b880 100644 --- a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs +++ b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs @@ -21,6 +21,9 @@ import Data.Maybe (fromMaybe, isJust, mapMaybe) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as Text +import qualified Data.Text.Lines as Text.Lines +import Data.Text.Utf16.Rope.Mixed (Rope) +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE (spanContainsRange) import Development.IDE.Core.PluginUtils import Development.IDE.Core.RuleTypes (GetFileContents (GetFileContents), @@ -178,10 +181,12 @@ updateColOffset row lineOffset colOffset | row == lineOffset = colOffset | otherwise = 0 -usedIdentifiersToTextEdits :: Range -> NameEnv [ImportedBy] -> Text -> [UsedIdentifier] -> [TextEdit] -usedIdentifiersToTextEdits range nameToImportedByMap sourceText usedIdentifiers +usedIdentifiersToTextEdits :: Range -> NameEnv [ImportedBy] -> Rope -> [UsedIdentifier] -> [TextEdit] +usedIdentifiersToTextEdits range nameToImportedByMap source usedIdentifiers | let sortedUsedIdentifiers = sortOn usedIdentifierSpan usedIdentifiers = - State.evalState (makeStateComputation sortedUsedIdentifiers) (Text.lines sourceText, 0, 0) + State.evalState + (makeStateComputation sortedUsedIdentifiers) + (Text.Lines.lines (Rope.toTextLines source), 0, 0) where folder :: [TextEdit] -> UsedIdentifier -> State ([Text], Int, Int) [TextEdit] folder prevTextEdits UsedIdentifier{usedIdentifierName, usedIdentifierSpan} @@ -227,12 +232,12 @@ codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId range _) if isJust (findLImportDeclAt range tmrParsed) then do HAR {..} <- runActionE "QualifyImportedNames.GetHieAst" ideState (useE GetHieAst normalizedFilePath) - (_, sourceTextM) <- runActionE "QualifyImportedNames.GetFileContents" ideState (useE GetFileContents normalizedFilePath) - sourceText <- handleMaybe (PluginRuleFailed "GetFileContents") sourceTextM + (_, sourceM) <- runActionE "QualifyImportedNames.GetFileContents" ideState (useE GetFileContents normalizedFilePath) + source <- handleMaybe (PluginRuleFailed "GetFileContents") sourceM let globalRdrEnv = tcg_rdr_env tmrTypechecked nameToImportedByMap = globalRdrEnvToNameToImportedByMap globalRdrEnv usedIdentifiers = refMapToUsedIdentifiers refMap - textEdits = usedIdentifiersToTextEdits range nameToImportedByMap sourceText usedIdentifiers + textEdits = usedIdentifiersToTextEdits range nameToImportedByMap source usedIdentifiers pure $ InL (makeCodeActions (documentId ^. L.uri) textEdits) else pure $ InL [] 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 a50ed3f3d8..367628e48d 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -23,7 +23,6 @@ import Control.Arrow (second, import Control.Concurrent.STM.Stats (atomically) import Control.Monad.Extra import Control.Monad.IO.Class -import Control.Monad.Trans import Control.Monad.Trans.Except (ExceptT (ExceptT)) import Control.Monad.Trans.Maybe import Data.Char @@ -41,6 +40,8 @@ import Data.Ord (comparing) 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.Mixed as Rope +import Development.IDE.Core.FileStore (getUriContents) import Development.IDE.Core.Rules import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service @@ -96,7 +97,6 @@ import Language.LSP.Protocol.Types (ApplyWorkspa WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), type (|?) (InL, InR), uriToFilePath) -import Language.LSP.VFS (virtualFileText) import qualified Text.Fuzzy.Parallel as TFP import qualified Text.Regex.Applicative as RE import Text.Regex.TDFA ((=~), (=~~)) @@ -122,15 +122,15 @@ import GHC.Types.SrcLoc (srcSpanToRea -- | Generate code actions. codeAction :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) range _) = do - contents <- lift $ pluginGetVirtualFile $ toNormalizedUri uri + contents <- liftIO $ runAction "hls-refactor-plugin.codeAction.getUriContents" state $ getUriContents $ toNormalizedUri uri liftIO $ do - let text = virtualFileText <$> contents - mbFile = toNormalizedFilePath' <$> uriToFilePath uri + let mbFile = toNormalizedFilePath' <$> uriToFilePath uri allDiags <- atomically $ fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state (join -> parsedModule) <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModule `traverse` mbFile let - actions = caRemoveRedundantImports parsedModule text allDiags range uri - <> caRemoveInvalidExports parsedModule text allDiags range uri + textContents = fmap Rope.toText contents + actions = caRemoveRedundantImports parsedModule textContents allDiags range uri + <> caRemoveInvalidExports parsedModule textContents allDiags range uri pure $ InL actions ------------------------------------------------------------------------------------------------- @@ -249,7 +249,7 @@ extendImportHandler' ideState ExtendImport {..} it = case thingParent of Nothing -> newThing Just p -> p <> "(" <> newThing <> ")" - t <- liftMaybe $ snd <$> newImportToEdit n ps (fromMaybe "" contents) + t <- liftMaybe $ snd <$> newImportToEdit n ps (Rope.toText (fromMaybe mempty contents)) return (nfp, WorkspaceEdit {_changes=Just (M.singleton doc [t]), _documentChanges=Nothing, _changeAnnotations=Nothing}) | otherwise = mzero @@ -1991,11 +1991,19 @@ smallerRangesForBindingExport lies b = where unqualify = snd . breakOnEnd "." b' = wrapOperatorInParens $ unqualify b + ranges' + ( L + _ + ( IEThingWith + _ + thing + _ + inners #if MIN_VERSION_ghc(9,9,0) - ranges' (L _ (IEThingWith _ thing _ inners _)) -#else - ranges' (L _ (IEThingWith _ thing _ inners)) + _ #endif + ) + ) | T.unpack (printOutputable thing) == b' = [] | otherwise = [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b'] diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs index 0be04656bd..53ee5200c0 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -24,6 +24,7 @@ import Data.IORef.Extra import qualified Data.Map as Map import Data.Maybe (fromMaybe) import qualified Data.Text as T +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE hiding (pluginHandlers) import Development.IDE.Core.Shake @@ -69,7 +70,7 @@ runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _ra caaContents <- onceIO $ runRule GetFileContents <&> \case - Just (_, txt) -> txt + Just (_, mbContents) -> fmap Rope.toText mbContents Nothing -> Nothing caaDf <- onceIO $ fmap (ms_hspp_opts . pm_mod_summary) <$> caaParsedModule caaAnnSource <- onceIO $ runRule GetAnnotatedParsedSource diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index 2aeb16a808..7cc1122982 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -29,6 +29,7 @@ import qualified Data.Set as S import qualified Data.Text as T import Development.IDE (Recorder, WithPriority, usePropertyAction) +import Development.IDE.Core.FileStore (getVersionedTextDoc) import Development.IDE.Core.PluginUtils import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service @@ -109,7 +110,7 @@ renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) p let newName = mkTcOcc $ T.unpack newNameText filesRefs = collectWith locToUri refs getFileEdit (uri, locations) = do - verTxtDocId <- lift $ pluginGetVersionedTextDoc (TextDocumentIdentifier uri) + verTxtDocId <- liftIO $ runAction "rename: getVersionedTextDoc" state $ getVersionedTextDoc (TextDocumentIdentifier uri) getSrcEdit state verTxtDocId (replaceRefs newName locations) fileEdits <- mapM getFileEdit filesRefs pure $ InL $ fold fileEdits diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index 242405274b..e65eafa52b 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -42,6 +42,7 @@ import Data.Monoid (First (First)) import Data.String (IsString) import qualified Data.Text as T import qualified Data.Text.Encoding as T +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE hiding (pluginHandlers) import Development.IDE.Core.Actions (lookupMod) import Development.IDE.Core.PluginUtils @@ -778,10 +779,10 @@ getCPPmodule recorder state session t = do return (fixities, parsed) contents <- do - (_, mbContentsVFS) <- + mbContentsVFS <- runAction "Retrie.GetFileContents" state $ getFileContents nt case mbContentsVFS of - Just contents -> return contents + Just contents -> return $ Rope.toText contents Nothing -> T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath nt) if any (T.isPrefixOf "#if" . T.toLower) (T.lines contents) then do diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 75a5593cd0..43bdf5decb 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -38,6 +38,7 @@ import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import qualified Data.Text as T import Development.IDE +import Development.IDE.Core.FileStore (getVersionedTextDoc) import Development.IDE.Core.PluginUtils import Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.ExactPrint @@ -475,7 +476,7 @@ fromSearchResult _ = Nothing -- TODO: Declaration Splices won't appear in HieAst; perhaps we must just use Parsed/Renamed ASTs? codeAction :: PluginMethodHandler IdeState Method_TextDocumentCodeAction codeAction state plId (CodeActionParams _ _ docId ran _) = do - verTxtDocId <- lift $ pluginGetVersionedTextDoc docId + verTxtDocId <- liftIO $ runAction "splice.codeAction.getVersionedTextDoc" state $ getVersionedTextDoc docId liftIO $ fmap (fromMaybe ( InL [])) $ runMaybeT $ do fp <- MaybeT $ pure $ uriToNormalizedFilePath $ toNormalizedUri theUri