Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Get files from Shake VFS from within plugin handlers #4328

Merged
merged 13 commits into from
Sep 28, 2024
Merged
4 changes: 3 additions & 1 deletion ghcide/src/Development/IDE.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,9 @@ import Development.IDE.Core.Actions as X (getAtPoint,
getDefinition,
getTypeDefinition)
import Development.IDE.Core.FileExists as X (getFileExists)
import Development.IDE.Core.FileStore as X (getFileContents)
import Development.IDE.Core.FileStore as X (getFileContents,
getFileModTimeContents,
getUriContents)
import Development.IDE.Core.IdeConfiguration as X (IdeConfiguration (..),
isWorkspaceFile)
import Development.IDE.Core.OfInterest as X (getFilesOfInterestUntracked)
Expand Down
51 changes: 40 additions & 11 deletions ghcide/src/Development/IDE/Core/FileStore.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,10 @@
{-# LANGUAGE TypeFamilies #-}

module Development.IDE.Core.FileStore(
getFileModTimeContents,
getFileContents,
getUriContents,
getVersionedTextDoc,
setFileModified,
setSomethingModified,
fileStoreRules,
Expand All @@ -18,12 +21,13 @@ module Development.IDE.Core.FileStore(
isWatchSupported,
registerFileWatches,
shareFilePath,
Log(..)
Log(..),
) where

import Control.Concurrent.STM.Stats (STM, atomically)
import Control.Concurrent.STM.TQueue (writeTQueue)
import Control.Exception
import Control.Lens ((^.))
import Control.Monad.Extra
import Control.Monad.IO.Class
import qualified Data.Binary as B
Expand All @@ -33,6 +37,7 @@ import qualified Data.HashMap.Strict as HashMap
import Data.IORef
import qualified Data.Text as T
import qualified Data.Text as Text
import Data.Text.Utf16.Rope.Mixed (Rope)
import Data.Time
import Data.Time.Clock.POSIX
import Development.IDE.Core.FileUtils
Expand All @@ -56,13 +61,16 @@ import Ide.Logger (Pretty (pretty),
logWith, viaShow,
(<+>))
import qualified Ide.Logger as L
import Ide.Plugin.Config (CheckParents (..),
Config)
import Ide.Types
import qualified Language.LSP.Protocol.Lens as L
import Language.LSP.Protocol.Message (toUntypedRegistration)
import qualified Language.LSP.Protocol.Message as LSP
import Language.LSP.Protocol.Types (DidChangeWatchedFilesRegistrationOptions (DidChangeWatchedFilesRegistrationOptions),
FileSystemWatcher (..),
_watchers)
TextDocumentIdentifier (..),
VersionedTextDocumentIdentifier (..),
_watchers,
uriToNormalizedFilePath)
import qualified Language.LSP.Protocol.Types as LSP
import qualified Language.LSP.Server as LSP
import Language.LSP.VFS
Expand Down Expand Up @@ -175,20 +183,20 @@ getFileContentsRule recorder = define (cmapWithPrio LogShake recorder) $ \GetFil

getFileContentsImpl
:: NormalizedFilePath
-> Action ([FileDiagnostic], Maybe (FileVersion, Maybe T.Text))
-> Action ([FileDiagnostic], Maybe (FileVersion, Maybe Rope))
getFileContentsImpl file = do
-- need to depend on modification time to introduce a dependency with Cutoff
time <- use_ GetModificationTime file
res <- do
mbVirtual <- getVirtualFile file
pure $ virtualFileText <$> mbVirtual
pure $ _file_text <$> mbVirtual
pure ([], Just (time, res))

-- | Returns the modification time and the contents.
-- For VFS paths, the modification time is the current time.
getFileContents :: NormalizedFilePath -> Action (UTCTime, Maybe T.Text)
getFileContents f = do
(fv, txt) <- use_ GetFileContents f
getFileModTimeContents :: NormalizedFilePath -> Action (UTCTime, Maybe Rope)
getFileModTimeContents f = do
(fv, contents) <- use_ GetFileContents f
modTime <- case modificationTime fv of
Just t -> pure t
Nothing -> do
Expand All @@ -198,7 +206,29 @@ getFileContents f = do
_ -> do
posix <- getModTime $ fromNormalizedFilePath f
pure $ posixSecondsToUTCTime posix
return (modTime, txt)
return (modTime, contents)

getFileContents :: NormalizedFilePath -> Action (Maybe Rope)
getFileContents f = snd <$> use_ GetFileContents f

getUriContents :: NormalizedUri -> Action (Maybe Rope)
getUriContents uri =
join <$> traverse getFileContents (uriToNormalizedFilePath uri)

-- | Given a text document identifier, annotate it with the latest version.
--
-- Like Language.LSP.Server.Core.getVersionedTextDoc, but gets the virtual file
-- from the Shake VFS rather than the LSP VFS.
getVersionedTextDoc :: TextDocumentIdentifier -> Action VersionedTextDocumentIdentifier
getVersionedTextDoc doc = do
let uri = doc ^. L.uri
mvf <-
maybe (pure Nothing) getVirtualFile $
uriToNormalizedFilePath $ toNormalizedUri uri
let ver = case mvf of
Just (VirtualFile lspver _ _) -> lspver
Nothing -> 0
return (VersionedTextDocumentIdentifier uri ver)

fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
fileStoreRules recorder isWatched = do
Expand Down Expand Up @@ -303,4 +333,3 @@ shareFilePath k = unsafePerformIO $ do
Just v -> (km, v)
Nothing -> (HashMap.insert k k km, k)
{-# NOINLINE shareFilePath #-}

43 changes: 42 additions & 1 deletion ghcide/src/Development/IDE/Core/PluginUtils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,16 +23,23 @@ 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)
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Data.Functor.Identity
import qualified Data.Text as T
import qualified Data.Text.Utf16.Rope.Mixed as Rope
import Development.IDE.Core.FileStore
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.Service (runAction)
import Development.IDE.Core.Shake (IdeAction, IdeRule,
IdeState (shakeExtras),
mkDelayedAction,
Expand All @@ -44,6 +51,9 @@ import Development.IDE.Types.Location (NormalizedFilePath)
import qualified Development.IDE.Types.Location as Location
import qualified Ide.Logger as Logger
import Ide.Plugin.Error
import Ide.Types
import qualified Language.LSP.Protocol.Lens as LSP
import Language.LSP.Protocol.Message (SMethod (..))
import qualified Language.LSP.Protocol.Types as LSP

-- ----------------------------------------------------------------------------
Expand Down Expand Up @@ -162,3 +172,34 @@ fromCurrentRangeE mapping = maybeToExceptT (PluginInvalidUserState "fromCurrentR
-- |MaybeT version of `fromCurrentRange`
fromCurrentRangeMT :: Monad m => PositionMapping -> LSP.Range -> MaybeT m LSP.Range
fromCurrentRangeMT mapping = MaybeT . pure . fromCurrentRange mapping

-- ----------------------------------------------------------------------------
-- Formatting handlers
-- ----------------------------------------------------------------------------

-- `mkFormattingHandlers` was moved here from hls-plugin-api package so that
-- `mkFormattingHandlers` can refer to `IdeState`. `IdeState` is defined in the
-- ghcide package, but hls-plugin-api does not depend on ghcide, so `IdeState`
-- is not in scope there.

mkFormattingHandlers :: FormattingHandler IdeState -> PluginHandlers IdeState
mkFormattingHandlers f = mkPluginHandler SMethod_TextDocumentFormatting ( provider SMethod_TextDocumentFormatting)
<> mkPluginHandler SMethod_TextDocumentRangeFormatting (provider SMethod_TextDocumentRangeFormatting)
where
provider :: forall m. FormattingMethod m => SMethod m -> PluginMethodHandler IdeState m
provider m ide _pid params
| Just nfp <- LSP.uriToNormalizedFilePath $ LSP.toNormalizedUri uri = do
contentsMaybe <- liftIO $ runAction "mkFormattingHandlers" ide $ getFileContents nfp
case contentsMaybe of
Just contents -> do
let (typ, mtoken) = case m of
SMethod_TextDocumentFormatting -> (FormatText, params ^. LSP.workDoneToken)
SMethod_TextDocumentRangeFormatting -> (FormatRange (params ^. LSP.range), params ^. LSP.workDoneToken)
_ -> Prelude.error "mkFormattingHandlers: impossible"
f ide mtoken typ (Rope.toText contents) nfp opts
Nothing -> throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri

| otherwise = throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri
where
uri = params ^. LSP.textDocument . LSP.uri
opts = params ^. LSP.options
4 changes: 2 additions & 2 deletions ghcide/src/Development/IDE/Core/RuleTypes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down
10 changes: 6 additions & 4 deletions ghcide/src/Development/IDE/Core/Rules.hs
Original file line number Diff line number Diff line change
Expand Up @@ -91,6 +91,7 @@
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
Expand All @@ -99,6 +100,7 @@
import Development.IDE.Core.FileExists hiding (Log,
LogShake)
import Development.IDE.Core.FileStore (getFileContents,
getFileModTimeContents,
getModTime)
import Development.IDE.Core.IdeConfiguration
import Development.IDE.Core.OfInterest hiding (Log,
Expand Down Expand Up @@ -220,10 +222,10 @@
-- TODO: return text --> return rope
getSourceFileSource :: NormalizedFilePath -> Action BS.ByteString
getSourceFileSource nfp = do
(_, msource) <- getFileContents nfp
msource <- getFileContents nfp
case msource of
Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath nfp)
Just source -> pure $ T.encodeUtf8 source
Just source -> pure $ T.encodeUtf8 $ Rope.toText source

-- | Parse the contents of a haskell file.
getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
Expand Down Expand Up @@ -789,7 +791,7 @@
{ source_version = ver
, old_value = m_old
, get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
, get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs

Check warning on line 794 in ghcide/src/Development/IDE/Core/Rules.hs

View workflow job for this annotation

GitHub Actions / Hlint check run

Suggestion in getModIfaceFromDiskRule in module Development.IDE.Core.Rules: Use fmap ▫︎ Found: "\\ fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs" ▫︎ Perhaps: "fmap (map (snd . fromJust . hirCoreFp)) . uses_ GetModIface"
, regenerate = regenerateHiFile session f ms
}
r <- loadInterface (hscEnv session) ms linkableType recompInfo
Expand Down Expand Up @@ -861,10 +863,10 @@
session' <- hscEnv <$> use_ GhcSession f
modify_dflags <- getModifyDynFlags dynFlagsModifyGlobal
let session = hscSetFlags (modify_dflags $ hsc_dflags session') session'
(modTime, mFileContent) <- getFileContents f
(modTime, mFileContent) <- getFileModTimeContents f
let fp = fromNormalizedFilePath f
modS <- liftIO $ runExceptT $
getModSummaryFromImports session fp modTime (textToStringBuffer <$> mFileContent)
getModSummaryFromImports session fp modTime (textToStringBuffer . Rope.toText <$> mFileContent)
case modS of
Right res -> do
-- Check for Template Haskell
Expand Down Expand Up @@ -1062,7 +1064,7 @@
-- thus bump its modification time, forcing this rule to be rerun every time.
exists <- liftIO $ doesFileExist obj_file
mobj_time <- liftIO $
if exists

Check warning on line 1067 in ghcide/src/Development/IDE/Core/Rules.hs

View workflow job for this annotation

GitHub Actions / Hlint check run

Warning in getLinkableRule in module Development.IDE.Core.Rules: Use whenMaybe ▫︎ Found: "if exists then Just <$> getModTime obj_file else pure Nothing" ▫︎ Perhaps: "whenMaybe exists (getModTime obj_file)"
then Just <$> getModTime obj_file
else pure Nothing
case mobj_time of
Expand Down
4 changes: 1 addition & 3 deletions ghcide/src/Development/IDE/Core/Shake.hs
Original file line number Diff line number Diff line change
Expand Up @@ -162,9 +162,7 @@ import Ide.Logger hiding (Priority)
import qualified Ide.Logger as Logger
import Ide.Plugin.Config
import qualified Ide.PluginUtils as HLS
import Ide.Types (IdePlugins (IdePlugins),
PluginDescriptor (pluginId),
PluginId)
import Ide.Types
import Language.LSP.Diagnostics
import qualified Language.LSP.Protocol.Lens as L
import Language.LSP.Protocol.Message
Expand Down
8 changes: 5 additions & 3 deletions ghcide/src/Development/IDE/Plugin/Completions.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ import qualified Data.HashSet as Set
import Data.Maybe
import qualified Data.Text as T
import Development.IDE.Core.Compile
import Development.IDE.Core.FileStore (getUriContents)
import Development.IDE.Core.PluginUtils
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
Expand Down Expand Up @@ -165,8 +166,9 @@ getCompletionsLSP ide plId
CompletionParams{_textDocument=TextDocumentIdentifier uri
,_position=position
,_context=completionContext} = ExceptT $ do
contents <- pluginGetVirtualFile $ toNormalizedUri uri
fmap Right $ case (contents, uriToFilePath' uri) of
contentsMaybe <-
liftIO $ runAction "Completion" ide $ getUriContents $ toNormalizedUri uri
fmap Right $ case (contentsMaybe, uriToFilePath' uri) of
(Just cnts, Just path) -> do
let npath = toNormalizedFilePath' path
(ideOpts, compls, moduleExports, astres) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do
Expand Down Expand Up @@ -200,7 +202,7 @@ getCompletionsLSP ide plId
pure (opts, fmap (,pm,binds) compls, moduleExports, astres)
case compls of
Just (cci', parsedMod, bindMap) -> do
let pfix = getCompletionPrefix position cnts
let pfix = getCompletionPrefixFromRope position cnts
case (pfix, completionContext) of
(PosPrefixInfo _ "" _ _, Just CompletionContext { _triggerCharacter = Just "."})
-> return (InL [])
Expand Down
12 changes: 7 additions & 5 deletions ghcide/src/Development/IDE/Spans/Pragmas.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -56,7 +58,7 @@ insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma = LSP.TextEdit prag
getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m NextPragmaInfo
getFirstPragma (PluginId pId) state nfp = do
(hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE (T.unpack pId <> ".GhcSession") state $ useWithStaleE GhcSession nfp
(_, fileContents) <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp
fileContents <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp
pure $ getNextPragmaInfo sessionDynFlags fileContents

-- Pre-declaration comments parser -----------------------------------------------------
Expand Down
Loading
Loading