From 2275959dd24cf552af100d3b55affa5017ebe372 Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Wed, 19 Jun 2024 23:58:00 -0600 Subject: [PATCH 1/7] Change return type of getFileContents from Text to Rope - This avoids a few conversions between Rope and Text in the next commit - Note: Syntactic changes to Development.IDE.Plugin.CodeAction around line 2000 are to work around the following stylish-haskell failure: plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs: :2002:5: error: [GHC-58481] parse error (possibly incorrect indentation or mismatched brackets) --- ghcide/src/Development/IDE/Core/FileStore.hs | 11 ++--- .../src/Development/IDE/Core/PluginUtils.hs | 43 ++++++++++++++++++- ghcide/src/Development/IDE/Core/RuleTypes.hs | 4 +- ghcide/src/Development/IDE/Core/Rules.hs | 5 ++- ghcide/src/Development/IDE/Spans/Pragmas.hs | 10 +++-- haskell-language-server.cabal | 5 +++ .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 5 ++- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 8 ++-- .../hls-notes-plugin/src/Ide/Plugin/Notes.hs | 2 +- .../src/Ide/Plugin/QualifyImportedNames.hs | 17 +++++--- .../src/Development/IDE/Plugin/CodeAction.hs | 17 ++++++-- .../Development/IDE/Plugin/CodeAction/Args.hs | 3 +- .../src/Ide/Plugin/Retrie.hs | 3 +- 13 files changed, 101 insertions(+), 32 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 6c0cb875b0..e2b79d77d5 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -33,6 +33,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 @@ -175,20 +176,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 :: NormalizedFilePath -> Action (UTCTime, Maybe Rope) getFileContents f = do - (fv, txt) <- use_ GetFileContents f + (fv, contents) <- use_ GetFileContents f modTime <- case modificationTime fv of Just t -> pure t Nothing -> do @@ -198,7 +199,7 @@ getFileContents f = do _ -> do posix <- getModTime $ fromNormalizedFilePath f pure $ posixSecondsToUTCTime posix - return (modTime, txt) + return (modTime, contents) fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules () fileStoreRules recorder isWatched = do diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index 76c88421c9..d3adb30747 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,9 @@ import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe import Data.Functor.Identity import qualified Data.Text as T +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 +50,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 +171,35 @@ 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 the Ide.Types module of the +-- hls-plugin-api package so that `mkFormattingHandlers` could 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 + mVirtualFileContents <- + liftIO $ runAction "mkFormattingHandlers" ide $ fmap snd $ getFileContents nfp + case mVirtualFileContents 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 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 13f6db6f69..05718f5ea8 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 @@ -233,7 +234,7 @@ getSourceFileSource nfp = do (_, 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) @@ -898,7 +899,7 @@ getModSummaryRule displayTHWarning recorder = do (modTime, mFileContent) <- getFileContents 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/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index a2b4981a38..60519a63a5 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 diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 859d65dcd9..08c027d760 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -264,6 +264,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 @@ -649,6 +650,7 @@ library hls-retrie-plugin , safe-exceptions , stm , text + , text-rope , transformers , unordered-containers @@ -718,6 +720,7 @@ library hls-hlint-plugin , stm , temporary , text + , text-rope , transformers , unordered-containers , ghc-lib-parser-ex @@ -1061,6 +1064,7 @@ library hls-qualify-imported-names-plugin , lens , lsp , text + , text-rope , dlist , transformers @@ -1655,6 +1659,7 @@ library hls-refactor-plugin , hls-plugin-api == 2.9.0.0 , lsp , text + , text-rope , transformers , unordered-containers , containers diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 3c471a21b7..4bc5ae0f59 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -20,6 +20,7 @@ import qualified Data.HashMap.Strict as HashMap import qualified Data.List.NonEmpty as NE import qualified Data.Maybe as Maybe import qualified Data.Text.Encoding as Encoding +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Data.Typeable import Development.IDE as D import Development.IDE.Core.Shake (restartShakeSession) @@ -162,7 +163,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 @@ -191,7 +192,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 diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 97b9cabcae..50c17e4a6e 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -50,6 +50,8 @@ 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, @@ -307,7 +309,7 @@ getIdeas recorder nfp = do flags' <- setExtensions flags (_, 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 @@ -445,7 +447,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) @@ -516,7 +518,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 + (_, fmap Rope.toText -> mbOldContent) <- 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-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs index 3d9f398ece..99d9c2831b 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -110,7 +110,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-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 175aced38f..16fbb7a5ff 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -41,6 +41,7 @@ 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.Rules import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service @@ -249,7 +250,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 @@ -1995,11 +1996,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-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index ca82fc73e8..d69dadcd41 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 @@ -787,7 +788,7 @@ getCPPmodule recorder state session t = do (_, 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 From 71ada5daaa659214f39fc8bcb090f70b01a189f1 Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Thu, 20 Jun 2024 01:43:52 -0600 Subject: [PATCH 2/7] Get virtual files from the Shake VFS in plugins This commit changes plugins to get virtual files from the Shake VFS rather than from the language server's VFS. - Replace `Ide.Types.pluginGetVirtualFile` with `Development.IDE.Core.FileStore.getFileContents` - Replace `Ide.Types.pluginGetVersionedTextDoc` with `Development.IDE.Core.FileStore.getVersionedTextDoc` --- ghcide/src/Development/IDE/Core/FileStore.hs | 29 +++++++++-- .../src/Development/IDE/Core/PluginUtils.hs | 16 +++--- ghcide/src/Development/IDE/Core/Shake.hs | 4 +- .../src/Development/IDE/Plugin/Completions.hs | 8 +-- haskell-language-server.cabal | 2 + hls-plugin-api/src/Ide/Types.hs | 48 ++--------------- .../src/Ide/Plugin/CabalFmt.hs | 15 +++--- .../src/Ide/Plugin/CabalGild.hs | 13 ++--- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 7 ++- .../src/Ide/Plugin/Class/CodeAction.hs | 3 +- .../src/Ide/Plugin/Eval/CodeLens.hs | 18 ++++--- .../src/Ide/Plugin/Floskell.hs | 11 ++-- .../src/Ide/Plugin/Fourmolu.hs | 52 ++++++++++--------- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 7 ++- .../src/Ide/Plugin/ModuleName.hs | 7 +-- .../hls-notes-plugin/src/Ide/Plugin/Notes.hs | 7 ++- .../src/Ide/Plugin/Ormolu.hs | 43 +++++++-------- .../src/Ide/Plugin/Pragmas.hs | 9 ++-- .../src/Development/IDE/Plugin/CodeAction.hs | 15 +++--- .../src/Ide/Plugin/Rename.hs | 3 +- .../src/Ide/Plugin/Splice.hs | 3 +- 21 files changed, 158 insertions(+), 162 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index e2b79d77d5..c4215c05db 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -4,6 +4,7 @@ module Development.IDE.Core.FileStore( getFileContents, + getVersionedTextDoc, setFileModified, setSomethingModified, fileStoreRules, @@ -18,12 +19,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 @@ -57,13 +59,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 @@ -201,6 +206,21 @@ getFileContents f = do pure $ posixSecondsToUTCTime posix return (modTime, contents) +-- | 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 getModificationTimeRule recorder @@ -304,4 +324,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 d3adb30747..3915b14ee3 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -36,6 +36,7 @@ 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) @@ -176,10 +177,10 @@ fromCurrentRangeMT mapping = MaybeT . pure . fromCurrentRange mapping -- Formatting handlers -- ---------------------------------------------------------------------------- --- `mkFormattingHandlers` was moved here from the Ide.Types module of the --- hls-plugin-api package so that `mkFormattingHandlers` could 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` 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) @@ -188,15 +189,14 @@ mkFormattingHandlers f = mkPluginHandler SMethod_TextDocumentFormatting ( provid provider :: forall m. FormattingMethod m => SMethod m -> PluginMethodHandler IdeState m provider m ide _pid params | Just nfp <- LSP.uriToNormalizedFilePath $ LSP.toNormalizedUri uri = do - mVirtualFileContents <- - liftIO $ runAction "mkFormattingHandlers" ide $ fmap snd $ getFileContents nfp - case mVirtualFileContents of + contentsMaybe <- liftIO $ runAction "mkFormattingHandlers" ide $ fmap snd $ 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 contents nfp opts + 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 diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 25493da9a4..52cd07bfd0 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -156,9 +156,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 98ca6dc592..8c4804f1f3 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 (getFileContents) import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes @@ -169,8 +170,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 $ maybe (pure Nothing) (fmap snd . getFileContents) $ uriToNormalizedFilePath $ 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 @@ -204,7 +206,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/haskell-language-server.cabal b/haskell-language-server.cabal index 08c027d760..80af55d189 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -470,6 +470,7 @@ library hls-eval-plugin , mtl , parser-combinators >=1.2 , text + , text-rope , transformers , unliftio , unordered-containers @@ -849,6 +850,7 @@ library hls-module-name-plugin , hls-plugin-api == 2.9.0.0 , lsp , text + , text-rope , transformers diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index f786b6aac9..d13712df75 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 @@ -899,29 +898,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 @@ -1183,31 +1168,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 1af405e124..6530bcfca4 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-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-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 4bc5ae0f59..ed8698316d 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -11,7 +11,6 @@ import Control.DeepSeq import Control.Lens ((^.)) import Control.Monad.Extra import Control.Monad.IO.Class -import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe (runMaybeT) import qualified Data.ByteString as BS import Data.Hashable @@ -322,8 +321,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.getFileContents" ide $ maybe (pure Nothing) (fmap snd . getFileContents) $ uriToNormalizedFilePath $ 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. @@ -332,7 +331,7 @@ completion recorder ide _ complParams = do Nothing -> pure . InR $ InR Null Just (fields, _) -> do - let pref = Ghcide.getCompletionPrefix position cnts + let pref = Ghcide.getCompletionPrefixFromRope position cnts let res = produceCompletions pref path fields liftIO $ fmap InL res Nothing -> pure . InR $ InR Null 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-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 4d9ace1163..9caf170485 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -40,7 +40,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 (getFileContents) import Development.IDE.Core.Rules (IdeState, runAction) import Development.IDE.Core.RuleTypes (LinkableResult (linkableHomeMod), @@ -210,7 +212,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_ @@ -305,12 +307,14 @@ 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.getFileContents" state $ + maybe (pure Nothing) (fmap snd . getFileContents) $ uriToNormalizedFilePath $ 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 50c17e4a6e..59848bcb0b 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -37,7 +37,6 @@ import Control.Lens ((?~), (^.)) import Control.Monad 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 (..), @@ -57,6 +56,7 @@ 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) @@ -368,7 +368,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 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 5c3f4ba781..9ca4f68585 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -32,6 +32,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, @@ -43,6 +44,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), @@ -57,7 +59,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, @@ -112,8 +113,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 $ fmap snd $ 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 99d9c2831b..3e46231db2 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 (fmap snd (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 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..0928b91799 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 @@ -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.GetFileContents" ide $ maybe (pure Nothing) (fmap snd . getFileContents) $ LSP.uriToNormalizedFilePath $ 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-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 16fbb7a5ff..50a7baeaec 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 @@ -42,6 +41,7 @@ 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 (getFileContents) import Development.IDE.Core.Rules import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service @@ -97,8 +97,8 @@ import Language.LSP.Protocol.Types (ApplyWorkspa UInt, WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), type (|?) (InL, InR), - uriToFilePath) -import Language.LSP.VFS (virtualFileText) + uriToFilePath, + uriToNormalizedFilePath) import qualified Text.Fuzzy.Parallel as TFP import qualified Text.Regex.Applicative as RE import Text.Regex.TDFA ((=~), (=~~)) @@ -123,15 +123,14 @@ 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.getFileContents" state $ maybe (pure Nothing) (fmap (fmap Rope.toText . snd) . getFileContents) $ uriToNormalizedFilePath $ 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 + actions = caRemoveRedundantImports parsedModule contents allDiags range uri + <> caRemoveInvalidExports parsedModule contents allDiags range uri pure $ InL actions ------------------------------------------------------------------------------------------------- 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-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 6e913d8367..30621765e2 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 @@ -474,7 +475,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 From 59292ee332c2cb7f23d9174aa1ec97da4f78b1c5 Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Thu, 27 Jun 2024 22:46:51 -0600 Subject: [PATCH 3/7] Rename `getFileContents` to `getFileModTimeContents` --- ghcide/src/Development/IDE.hs | 2 +- ghcide/src/Development/IDE/Core/FileStore.hs | 6 +++--- ghcide/src/Development/IDE/Core/PluginUtils.hs | 2 +- ghcide/src/Development/IDE/Core/Rules.hs | 6 +++--- ghcide/src/Development/IDE/Plugin/Completions.hs | 4 ++-- ghcide/src/Development/IDE/Spans/Pragmas.hs | 4 ++-- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 2 +- plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs | 2 +- plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs | 6 +++--- plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 6 +++--- plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs | 4 ++-- plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs | 2 +- plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs | 4 ++-- .../src/Development/IDE/Plugin/CodeAction.hs | 4 ++-- plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs | 2 +- 15 files changed, 28 insertions(+), 28 deletions(-) diff --git a/ghcide/src/Development/IDE.hs b/ghcide/src/Development/IDE.hs index 7ec68bc8af..cf08128900 100644 --- a/ghcide/src/Development/IDE.hs +++ b/ghcide/src/Development/IDE.hs @@ -10,7 +10,7 @@ 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 (getFileModTimeContents) 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 c4215c05db..4ba011a402 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -3,7 +3,7 @@ {-# LANGUAGE TypeFamilies #-} module Development.IDE.Core.FileStore( - getFileContents, + getFileModTimeContents, getVersionedTextDoc, setFileModified, setSomethingModified, @@ -192,8 +192,8 @@ getFileContentsImpl file = do -- | Returns the modification time and the contents. -- For VFS paths, the modification time is the current time. -getFileContents :: NormalizedFilePath -> Action (UTCTime, Maybe Rope) -getFileContents f = do +getFileModTimeContents :: NormalizedFilePath -> Action (UTCTime, Maybe Rope) +getFileModTimeContents f = do (fv, contents) <- use_ GetFileContents f modTime <- case modificationTime fv of Just t -> pure t diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index 3915b14ee3..80e450b5c6 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -189,7 +189,7 @@ mkFormattingHandlers f = mkPluginHandler SMethod_TextDocumentFormatting ( provid 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 $ fmap snd $ getFileContents nfp + contentsMaybe <- liftIO $ runAction "mkFormattingHandlers" ide $ fmap snd $ getFileModTimeContents nfp case contentsMaybe of Just contents -> do let (typ, mtoken) = case m of diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 07c2ba9dd6..b160de3cb2 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -99,7 +99,7 @@ import Data.Typeable (cast) import Development.IDE.Core.Compile import Development.IDE.Core.FileExists hiding (Log, LogShake) -import Development.IDE.Core.FileStore (getFileContents, +import Development.IDE.Core.FileStore (getFileModTimeContents, getModTime) import Development.IDE.Core.IdeConfiguration import Development.IDE.Core.OfInterest hiding (Log, @@ -221,7 +221,7 @@ toIdeResult = either (, Nothing) (([],) . Just) -- TODO: return text --> return rope getSourceFileSource :: NormalizedFilePath -> Action BS.ByteString getSourceFileSource nfp = do - (_, msource) <- getFileContents nfp + (_, msource) <- getFileModTimeContents nfp case msource of Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath nfp) Just source -> pure $ T.encodeUtf8 $ Rope.toText source @@ -862,7 +862,7 @@ 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 . Rope.toText <$> mFileContent) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 605c90d441..a61489c5a7 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -19,7 +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 (getFileContents) +import Development.IDE.Core.FileStore (getFileModTimeContents) import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes @@ -167,7 +167,7 @@ getCompletionsLSP ide plId ,_position=position ,_context=completionContext} = ExceptT $ do contentsMaybe <- - liftIO $ runAction "Completion" ide $ maybe (pure Nothing) (fmap snd . getFileContents) $ uriToNormalizedFilePath $ toNormalizedUri uri + liftIO $ runAction "Completion" ide $ maybe (pure Nothing) (fmap snd . getFileModTimeContents) $ uriToNormalizedFilePath $ toNormalizedUri uri fmap Right $ case (contentsMaybe, uriToFilePath' uri) of (Just cnts, Just path) -> do let npath = toNormalizedFilePath' path diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index 60519a63a5..6a654ccdd3 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -17,7 +17,7 @@ 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 (srcSpanToRange, IdeState, NormalizedFilePath, GhcSession (..), getFileModTimeContents, hscEnv, runAction) import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util import qualified Language.LSP.Protocol.Types as LSP @@ -58,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 $ getFileModTimeContents nfp pure $ getNextPragmaInfo sessionDynFlags fileContents -- Pre-declaration comments parser ----------------------------------------------------- diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index ed8698316d..00a04b3168 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -321,7 +321,7 @@ completion :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.M completion recorder ide _ complParams = do let (TextDocumentIdentifier uri) = complParams ^. JL.textDocument position = complParams ^. JL.position - mContents <- liftIO $ runAction "cabal-plugin.getFileContents" ide $ maybe (pure Nothing) (fmap snd . getFileContents) $ uriToNormalizedFilePath $ toNormalizedUri uri + mContents <- liftIO $ runAction "cabal-plugin.getFileModTimeContents" ide $ maybe (pure Nothing) (fmap snd . getFileModTimeContents) $ uriToNormalizedFilePath $ 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. 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..395dc33cc3 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs @@ -65,7 +65,7 @@ insertPragmaIfNotPresent state nfp pragma = do (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE "classplugin.insertPragmaIfNotPresent.GhcSession" state $ useWithStaleE GhcSession nfp (_, fileContents) <- liftIO $ runAction "classplugin.insertPragmaIfNotPresent.GetFileContents" state - $ getFileContents nfp + $ getFileModTimeContents nfp (pm, _) <- runActionE "classplugin.insertPragmaIfNotPresent.GetParsedModuleWithComments" state $ useWithStaleE GetParsedModuleWithComments nfp let exts = getExtensions pm 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 d660526a86..4afd70b3fb 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -42,7 +42,7 @@ 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 (getFileContents) +import Development.IDE.Core.FileStore (getFileModTimeContents) import Development.IDE.Core.Rules (IdeState, runAction) import Development.IDE.Core.RuleTypes (LinkableResult (linkableHomeMod), @@ -304,8 +304,8 @@ moduleText state uri = do contents <- handleMaybeM (PluginInternalError "mdlText") $ liftIO $ - runAction "eval.getFileContents" state $ - maybe (pure Nothing) (fmap snd . getFileContents) $ uriToNormalizedFilePath $ toNormalizedUri uri + runAction "eval.getFileModTimeContents" state $ + maybe (pure Nothing) (fmap snd . getFileModTimeContents) $ uriToNormalizedFilePath $ toNormalizedUri uri pure $ Rope.toText contents testsBySection :: [Section] -> [(Section, EvalId, Test)] diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 59848bcb0b..1ddcf0a4e4 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -193,7 +193,7 @@ type instance RuleResult GetHlintDiagnostics = () -- | This rule is recomputed when: -- | - A file has been edited via -- | - `getIdeas` -> `getParsedModule` in any case --- | - `getIdeas` -> `getFileContents` if the hls ghc does not match the hlint default ghc +-- | - `getIdeas` -> `getFileModTimeContents` if the hls ghc does not match the hlint default ghc -- | - The client settings have changed, to honour the `hlintOn` setting, via `getClientConfigAction` -- | - The hlint specific settings have changed, via `getHlintSettingsRule` rules :: Recorder (WithPriority Log) -> PluginId -> Rules () @@ -307,7 +307,7 @@ getIdeas recorder nfp = do then return Nothing else do flags' <- setExtensions flags - (_, contents) <- getFileContents nfp + (_, contents) <- getFileModTimeContents nfp let fp = fromNormalizedFilePath nfp let contents' = T.unpack . Rope.toText <$> contents Just <$> liftIO (parseModuleEx flags' fp contents') @@ -521,7 +521,7 @@ applyHint recorder ide nfp mhint verTxtDocId = let commands = map ideaRefactoring ideas' logWith recorder Debug $ LogGeneratedIdeas nfp commands let fp = fromNormalizedFilePath nfp - (_, fmap Rope.toText -> mbOldContent) <- liftIO $ runAction' $ getFileContents nfp + (_, fmap Rope.toText -> mbOldContent) <- liftIO $ runAction' $ getFileModTimeContents 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 8a1cdd1ea7..d7e95b340e 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -43,7 +43,7 @@ import Development.IDE (GetParsedModule (GetParse realSrcSpanToRange, rootDir, runAction, useWithStale, (<+>)) -import Development.IDE.Core.FileStore (getFileContents) +import Development.IDE.Core.FileStore (getFileModTimeContents) import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping (toCurrentRange) import Development.IDE.GHC.Compat (GenLocated (L), @@ -112,7 +112,7 @@ action recorder state uri = do nfp <- getNormalizedFilePathE uri fp <- uriToFilePathE uri - contents <- liftIO $ runAction "ModuleName.getFileContents" state $ fmap snd $ getFileContents nfp + contents <- liftIO $ runAction "ModuleName.getFileModTimeContents" state $ fmap snd $ getFileModTimeContents nfp let emptyModule = maybe True (T.null . T.strip . Rope.toText) contents correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nfp fp diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs index 3e46231db2..eae49c6ae7 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -79,7 +79,7 @@ jumpToNote state _ param let Position l c = param ^. L.position contents <- err "Error getting file contents" - =<< liftIO (runAction "notes.getfileContents" state (fmap snd (getFileContents nfp))) + =<< liftIO (runAction "notes.getfileContents" state (fmap snd (getFileModTimeContents 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 diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index 0928b91799..74b546e487 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -79,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 $ getFileModTimeContents normalizedFilePath parsedModule <- liftIO $ runAction "Pragmas.GetParsedModule" state $ getParsedModule normalizedFilePath let parsedModuleDynFlags = ms_hspp_opts . pm_mod_summary <$> parsedModule nextPragmaInfo = Pragmas.getNextPragmaInfo sessionDynFlags fileContents @@ -197,7 +197,7 @@ completion :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCompletion completion ide _ complParams = do let (LSP.TextDocumentIdentifier uri) = complParams ^. L.textDocument position@(Position ln col) = complParams ^. L.position - contents <- liftIO $ runAction "Pragmas.GetFileContents" ide $ maybe (pure Nothing) (fmap snd . getFileContents) $ LSP.uriToNormalizedFilePath $ toNormalizedUri uri + contents <- liftIO $ runAction "Pragmas.GetFileContents" ide $ maybe (pure Nothing) (fmap snd . getFileModTimeContents) $ LSP.uriToNormalizedFilePath $ toNormalizedUri uri fmap LSP.InL $ case (contents, uriToFilePath' uri) of (Just cnts, Just _path) -> pure $ result $ getCompletionPrefixFromRope position cnts 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 2961fe4d40..dbc79f33f9 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -41,7 +41,7 @@ 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 (getFileContents) +import Development.IDE.Core.FileStore (getFileModTimeContents) import Development.IDE.Core.Rules import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service @@ -123,7 +123,7 @@ import GHC.Types.SrcLoc (srcSpanToRea -- | Generate code actions. codeAction :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) range _) = do - contents <- liftIO $ runAction "hls-refactor-plugin.codeAction.getFileContents" state $ maybe (pure Nothing) (fmap (fmap Rope.toText . snd) . getFileContents) $ uriToNormalizedFilePath $ toNormalizedUri uri + contents <- liftIO $ runAction "hls-refactor-plugin.codeAction.getFileModTimeContents" state $ maybe (pure Nothing) (fmap (fmap Rope.toText . snd) . getFileModTimeContents) $ uriToNormalizedFilePath $ toNormalizedUri uri liftIO $ do let mbFile = toNormalizedFilePath' <$> uriToFilePath uri allDiags <- atomically $ fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index 198d2ed0f6..0cb4eeb0c9 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -780,7 +780,7 @@ getCPPmodule recorder state session t = do contents <- do (_, mbContentsVFS) <- - runAction "Retrie.GetFileContents" state $ getFileContents nt + runAction "Retrie.GetFileContents" state $ getFileModTimeContents nt case mbContentsVFS of Just contents -> return $ Rope.toText contents Nothing -> T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath nt) From 3cb9f15b473645aad36ddf7e18dc4cfa01d4e5b5 Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Thu, 27 Jun 2024 23:12:11 -0600 Subject: [PATCH 4/7] Add util functions for common cases of Shake VFS file access --- ghcide/src/Development/IDE.hs | 4 +++- ghcide/src/Development/IDE/Core/FileStore.hs | 9 +++++++++ ghcide/src/Development/IDE/Core/PluginUtils.hs | 2 +- ghcide/src/Development/IDE/Core/Rules.hs | 5 +++-- ghcide/src/Development/IDE/Plugin/Completions.hs | 4 ++-- ghcide/src/Development/IDE/Spans/Pragmas.hs | 4 ++-- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 2 +- plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs | 4 ++-- plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs | 7 ++++--- plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 6 +++--- .../hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs | 4 ++-- plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs | 2 +- plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs | 4 ++-- .../src/Development/IDE/Plugin/CodeAction.hs | 9 +++++---- plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs | 4 ++-- 15 files changed, 42 insertions(+), 28 deletions(-) diff --git a/ghcide/src/Development/IDE.hs b/ghcide/src/Development/IDE.hs index cf08128900..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 (getFileModTimeContents) +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 4ba011a402..3de21e175d 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -4,6 +4,8 @@ module Development.IDE.Core.FileStore( getFileModTimeContents, + getFileContents, + getUriContents, getVersionedTextDoc, setFileModified, setSomethingModified, @@ -206,6 +208,13 @@ getFileModTimeContents f = do pure $ posixSecondsToUTCTime posix 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 diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index 80e450b5c6..8f1da496e8 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -189,7 +189,7 @@ mkFormattingHandlers f = mkPluginHandler SMethod_TextDocumentFormatting ( provid 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 $ fmap snd $ getFileModTimeContents nfp + contentsMaybe <- liftIO $ runAction "mkFormattingHandlers" ide $ getFileContents nfp case contentsMaybe of Just contents -> do let (typ, mtoken) = case m of diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index b160de3cb2..5923f2b2d2 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -99,7 +99,8 @@ import Data.Typeable (cast) import Development.IDE.Core.Compile import Development.IDE.Core.FileExists hiding (Log, LogShake) -import Development.IDE.Core.FileStore (getFileModTimeContents, +import Development.IDE.Core.FileStore (getFileContents, + getFileModTimeContents, getModTime) import Development.IDE.Core.IdeConfiguration import Development.IDE.Core.OfInterest hiding (Log, @@ -221,7 +222,7 @@ toIdeResult = either (, Nothing) (([],) . Just) -- TODO: return text --> return rope getSourceFileSource :: NormalizedFilePath -> Action BS.ByteString getSourceFileSource nfp = do - (_, msource) <- getFileModTimeContents nfp + msource <- getFileContents nfp case msource of Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath nfp) Just source -> pure $ T.encodeUtf8 $ Rope.toText source diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index a61489c5a7..0564855177 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -19,7 +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 (getFileModTimeContents) +import Development.IDE.Core.FileStore (getUriContents) import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes @@ -167,7 +167,7 @@ getCompletionsLSP ide plId ,_position=position ,_context=completionContext} = ExceptT $ do contentsMaybe <- - liftIO $ runAction "Completion" ide $ maybe (pure Nothing) (fmap snd . getFileModTimeContents) $ uriToNormalizedFilePath $ toNormalizedUri uri + liftIO $ runAction "Completion" ide $ getUriContents $ toNormalizedUri uri fmap Right $ case (contentsMaybe, uriToFilePath' uri) of (Just cnts, Just path) -> do let npath = toNormalizedFilePath' path diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index 6a654ccdd3..4df16c6704 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -17,7 +17,7 @@ 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 (..), getFileModTimeContents, hscEnv, runAction) +import Development.IDE (srcSpanToRange, IdeState, NormalizedFilePath, GhcSession (..), getFileContents, hscEnv, runAction) import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util import qualified Language.LSP.Protocol.Types as LSP @@ -58,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 $ getFileModTimeContents nfp + fileContents <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp pure $ getNextPragmaInfo sessionDynFlags fileContents -- Pre-declaration comments parser ----------------------------------------------------- diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 00a04b3168..c8c13c4126 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -321,7 +321,7 @@ completion :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.M completion recorder ide _ complParams = do let (TextDocumentIdentifier uri) = complParams ^. JL.textDocument position = complParams ^. JL.position - mContents <- liftIO $ runAction "cabal-plugin.getFileModTimeContents" ide $ maybe (pure Nothing) (fmap snd . getFileModTimeContents) $ uriToNormalizedFilePath $ toNormalizedUri uri + 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. 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 395dc33cc3..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,8 +64,8 @@ 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 - $ getFileModTimeContents nfp + fileContents <- liftIO $ runAction "classplugin.insertPragmaIfNotPresent.GetFileContents" state + $ getFileContents nfp (pm, _) <- runActionE "classplugin.insertPragmaIfNotPresent.GetParsedModuleWithComments" state $ useWithStaleE GetParsedModuleWithComments nfp let exts = getExtensions pm 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 4afd70b3fb..3117a5327f 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -42,7 +42,7 @@ 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 (getFileModTimeContents) +import Development.IDE.Core.FileStore (getUriContents) import Development.IDE.Core.Rules (IdeState, runAction) import Development.IDE.Core.RuleTypes (LinkableResult (linkableHomeMod), @@ -304,8 +304,9 @@ moduleText state uri = do contents <- handleMaybeM (PluginInternalError "mdlText") $ liftIO $ - runAction "eval.getFileModTimeContents" state $ - maybe (pure Nothing) (fmap snd . getFileModTimeContents) $ uriToNormalizedFilePath $ toNormalizedUri uri + runAction "eval.getUriContents" state $ + getUriContents $ + toNormalizedUri uri pure $ Rope.toText contents testsBySection :: [Section] -> [(Section, EvalId, Test)] diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 1ddcf0a4e4..807b997f2f 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -193,7 +193,7 @@ type instance RuleResult GetHlintDiagnostics = () -- | This rule is recomputed when: -- | - A file has been edited via -- | - `getIdeas` -> `getParsedModule` in any case --- | - `getIdeas` -> `getFileModTimeContents` if the hls ghc does not match the hlint default ghc +-- | - `getIdeas` -> `getFileContents` if the hls ghc does not match the hlint default ghc -- | - The client settings have changed, to honour the `hlintOn` setting, via `getClientConfigAction` -- | - The hlint specific settings have changed, via `getHlintSettingsRule` rules :: Recorder (WithPriority Log) -> PluginId -> Rules () @@ -307,7 +307,7 @@ getIdeas recorder nfp = do then return Nothing else do flags' <- setExtensions flags - (_, contents) <- getFileModTimeContents nfp + contents <- getFileContents nfp let fp = fromNormalizedFilePath nfp let contents' = T.unpack . Rope.toText <$> contents Just <$> liftIO (parseModuleEx flags' fp contents') @@ -521,7 +521,7 @@ applyHint recorder ide nfp mhint verTxtDocId = let commands = map ideaRefactoring ideas' logWith recorder Debug $ LogGeneratedIdeas nfp commands let fp = fromNormalizedFilePath nfp - (_, fmap Rope.toText -> mbOldContent) <- liftIO $ runAction' $ getFileModTimeContents 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 d7e95b340e..b2ea962a9a 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -43,7 +43,7 @@ import Development.IDE (GetParsedModule (GetParse realSrcSpanToRange, rootDir, runAction, useWithStale, (<+>)) -import Development.IDE.Core.FileStore (getFileModTimeContents) +import Development.IDE.Core.FileStore (getFileContents) import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping (toCurrentRange) import Development.IDE.GHC.Compat (GenLocated (L), @@ -112,7 +112,7 @@ action recorder state uri = do nfp <- getNormalizedFilePathE uri fp <- uriToFilePathE uri - contents <- liftIO $ runAction "ModuleName.getFileModTimeContents" state $ fmap snd $ getFileModTimeContents nfp + 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 diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs index eae49c6ae7..1c40ea76b3 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -79,7 +79,7 @@ jumpToNote state _ param let Position l c = param ^. L.position contents <- err "Error getting file contents" - =<< liftIO (runAction "notes.getfileContents" state (fmap snd (getFileModTimeContents nfp))) + =<< 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 diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index 74b546e487..3bca988580 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -79,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 $ getFileModTimeContents 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 @@ -197,7 +197,7 @@ completion :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCompletion completion ide _ complParams = do let (LSP.TextDocumentIdentifier uri) = complParams ^. L.textDocument position@(Position ln col) = complParams ^. L.position - contents <- liftIO $ runAction "Pragmas.GetFileContents" ide $ maybe (pure Nothing) (fmap snd . getFileModTimeContents) $ LSP.uriToNormalizedFilePath $ 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 $ getCompletionPrefixFromRope position cnts 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 dbc79f33f9..452d853020 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -41,7 +41,7 @@ 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 (getFileModTimeContents) +import Development.IDE.Core.FileStore (getUriContents) import Development.IDE.Core.Rules import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service @@ -123,14 +123,15 @@ import GHC.Types.SrcLoc (srcSpanToRea -- | Generate code actions. codeAction :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) range _) = do - contents <- liftIO $ runAction "hls-refactor-plugin.codeAction.getFileModTimeContents" state $ maybe (pure Nothing) (fmap (fmap Rope.toText . snd) . getFileModTimeContents) $ uriToNormalizedFilePath $ toNormalizedUri uri + contents <- liftIO $ runAction "hls-refactor-plugin.codeAction.getUriContents" state $ getUriContents $ toNormalizedUri uri liftIO $ do 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 contents allDiags range uri - <> caRemoveInvalidExports parsedModule contents allDiags range uri + textContents = fmap Rope.toText contents + actions = caRemoveRedundantImports parsedModule textContents allDiags range uri + <> caRemoveInvalidExports parsedModule textContents allDiags range uri pure $ InL actions ------------------------------------------------------------------------------------------------- diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index 0cb4eeb0c9..e65eafa52b 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -779,8 +779,8 @@ getCPPmodule recorder state session t = do return (fixities, parsed) contents <- do - (_, mbContentsVFS) <- - runAction "Retrie.GetFileContents" state $ getFileModTimeContents nt + mbContentsVFS <- + runAction "Retrie.GetFileContents" state $ getFileContents nt case mbContentsVFS of Just contents -> return $ Rope.toText contents Nothing -> T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath nt) From 99ee9216f7071f3e2b87296078f3c3f4db54e16c Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Thu, 27 Jun 2024 23:36:22 -0600 Subject: [PATCH 5/7] Cleanup --- .../src/Development/IDE/Plugin/CodeAction.hs | 3 +-- 1 file changed, 1 insertion(+), 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 452d853020..367628e48d 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -96,8 +96,7 @@ import Language.LSP.Protocol.Types (ApplyWorkspa UInt, WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), type (|?) (InL, InR), - uriToFilePath, - uriToNormalizedFilePath) + uriToFilePath) import qualified Text.Fuzzy.Parallel as TFP import qualified Text.Regex.Applicative as RE import Text.Regex.TDFA ((=~), (=~~)) From a16fa4609c419d52c0112209405c45f014d3cca7 Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Mon, 1 Jul 2024 18:32:09 -0600 Subject: [PATCH 6/7] Fix warning --- plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs | 1 - 1 file changed, 1 deletion(-) 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 b9b7c818dc..800980ae4a 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -122,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. From 0b63299b28ac05d644479ac3023e92efba9bf13e Mon Sep 17 00:00:00 2001 From: Fendor Date: Fri, 16 Aug 2024 15:15:27 +0200 Subject: [PATCH 7/7] Install notification handlers for cabal files The cabal formatters read the file contents from the shake VFS. Thus, we need to make sure there are notification handlers that add the cabal files to the VFS! Formatters have to depend on the `hls-cabal-plugin` to have the necessary notification handlers installed during test time. --- haskell-language-server.cabal | 6 ++++++ plugins/hls-cabal-fmt-plugin/test/Main.hs | 19 +++++++++++++++++-- plugins/hls-cabal-gild-plugin/test/Main.hs | 19 +++++++++++++++++-- 3 files changed, 40 insertions(+), 4 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index e3b612536f..ad46096dee 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) 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/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"