Skip to content

Commit 7385915

Browse files
awjchensoulomoonmichaelpjfendor
authored
Get files from Shake VFS from within plugin handlers (#4328)
* 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: <string>:2002:5: error: [GHC-58481] parse error (possibly incorrect indentation or mismatched brackets) * 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` * Rename `getFileContents` to `getFileModTimeContents` * Add util functions for common cases of Shake VFS file access * Cleanup * Fix warning * 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. --------- Co-authored-by: soulomoon <[email protected]> Co-authored-by: Michael Peyton Jones <[email protected]> Co-authored-by: Fendor <[email protected]> Co-authored-by: fendor <[email protected]>
1 parent f628754 commit 7385915

File tree

32 files changed

+328
-211
lines changed

32 files changed

+328
-211
lines changed

Diff for: ‎ghcide/src/Development/IDE.hs

+3-1
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,9 @@ import Development.IDE.Core.Actions as X (getAtPoint,
1010
getDefinition,
1111
getTypeDefinition)
1212
import Development.IDE.Core.FileExists as X (getFileExists)
13-
import Development.IDE.Core.FileStore as X (getFileContents)
13+
import Development.IDE.Core.FileStore as X (getFileContents,
14+
getFileModTimeContents,
15+
getUriContents)
1416
import Development.IDE.Core.IdeConfiguration as X (IdeConfiguration (..),
1517
isWorkspaceFile)
1618
import Development.IDE.Core.OfInterest as X (getFilesOfInterestUntracked)

Diff for: ‎ghcide/src/Development/IDE/Core/FileStore.hs

+40-11
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,10 @@
33
{-# LANGUAGE TypeFamilies #-}
44

55
module Development.IDE.Core.FileStore(
6+
getFileModTimeContents,
67
getFileContents,
8+
getUriContents,
9+
getVersionedTextDoc,
710
setFileModified,
811
setSomethingModified,
912
fileStoreRules,
@@ -18,12 +21,13 @@ module Development.IDE.Core.FileStore(
1821
isWatchSupported,
1922
registerFileWatches,
2023
shareFilePath,
21-
Log(..)
24+
Log(..),
2225
) where
2326

2427
import Control.Concurrent.STM.Stats (STM, atomically)
2528
import Control.Concurrent.STM.TQueue (writeTQueue)
2629
import Control.Exception
30+
import Control.Lens ((^.))
2731
import Control.Monad.Extra
2832
import Control.Monad.IO.Class
2933
import qualified Data.Binary as B
@@ -33,6 +37,7 @@ import qualified Data.HashMap.Strict as HashMap
3337
import Data.IORef
3438
import qualified Data.Text as T
3539
import qualified Data.Text as Text
40+
import Data.Text.Utf16.Rope.Mixed (Rope)
3641
import Data.Time
3742
import Data.Time.Clock.POSIX
3843
import Development.IDE.Core.FileUtils
@@ -56,13 +61,16 @@ import Ide.Logger (Pretty (pretty),
5661
logWith, viaShow,
5762
(<+>))
5863
import qualified Ide.Logger as L
59-
import Ide.Plugin.Config (CheckParents (..),
60-
Config)
64+
import Ide.Types
65+
import qualified Language.LSP.Protocol.Lens as L
6166
import Language.LSP.Protocol.Message (toUntypedRegistration)
6267
import qualified Language.LSP.Protocol.Message as LSP
6368
import Language.LSP.Protocol.Types (DidChangeWatchedFilesRegistrationOptions (DidChangeWatchedFilesRegistrationOptions),
6469
FileSystemWatcher (..),
65-
_watchers)
70+
TextDocumentIdentifier (..),
71+
VersionedTextDocumentIdentifier (..),
72+
_watchers,
73+
uriToNormalizedFilePath)
6674
import qualified Language.LSP.Protocol.Types as LSP
6775
import qualified Language.LSP.Server as LSP
6876
import Language.LSP.VFS
@@ -175,20 +183,20 @@ getFileContentsRule recorder = define (cmapWithPrio LogShake recorder) $ \GetFil
175183

176184
getFileContentsImpl
177185
:: NormalizedFilePath
178-
-> Action ([FileDiagnostic], Maybe (FileVersion, Maybe T.Text))
186+
-> Action ([FileDiagnostic], Maybe (FileVersion, Maybe Rope))
179187
getFileContentsImpl file = do
180188
-- need to depend on modification time to introduce a dependency with Cutoff
181189
time <- use_ GetModificationTime file
182190
res <- do
183191
mbVirtual <- getVirtualFile file
184-
pure $ virtualFileText <$> mbVirtual
192+
pure $ _file_text <$> mbVirtual
185193
pure ([], Just (time, res))
186194

187195
-- | Returns the modification time and the contents.
188196
-- For VFS paths, the modification time is the current time.
189-
getFileContents :: NormalizedFilePath -> Action (UTCTime, Maybe T.Text)
190-
getFileContents f = do
191-
(fv, txt) <- use_ GetFileContents f
197+
getFileModTimeContents :: NormalizedFilePath -> Action (UTCTime, Maybe Rope)
198+
getFileModTimeContents f = do
199+
(fv, contents) <- use_ GetFileContents f
192200
modTime <- case modificationTime fv of
193201
Just t -> pure t
194202
Nothing -> do
@@ -198,7 +206,29 @@ getFileContents f = do
198206
_ -> do
199207
posix <- getModTime $ fromNormalizedFilePath f
200208
pure $ posixSecondsToUTCTime posix
201-
return (modTime, txt)
209+
return (modTime, contents)
210+
211+
getFileContents :: NormalizedFilePath -> Action (Maybe Rope)
212+
getFileContents f = snd <$> use_ GetFileContents f
213+
214+
getUriContents :: NormalizedUri -> Action (Maybe Rope)
215+
getUriContents uri =
216+
join <$> traverse getFileContents (uriToNormalizedFilePath uri)
217+
218+
-- | Given a text document identifier, annotate it with the latest version.
219+
--
220+
-- Like Language.LSP.Server.Core.getVersionedTextDoc, but gets the virtual file
221+
-- from the Shake VFS rather than the LSP VFS.
222+
getVersionedTextDoc :: TextDocumentIdentifier -> Action VersionedTextDocumentIdentifier
223+
getVersionedTextDoc doc = do
224+
let uri = doc ^. L.uri
225+
mvf <-
226+
maybe (pure Nothing) getVirtualFile $
227+
uriToNormalizedFilePath $ toNormalizedUri uri
228+
let ver = case mvf of
229+
Just (VirtualFile lspver _ _) -> lspver
230+
Nothing -> 0
231+
return (VersionedTextDocumentIdentifier uri ver)
202232

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

Diff for: ‎ghcide/src/Development/IDE/Core/PluginUtils.hs

+42-1
Original file line numberDiff line numberDiff line change
@@ -23,16 +23,23 @@ module Development.IDE.Core.PluginUtils
2323
, toCurrentRangeE
2424
, toCurrentRangeMT
2525
, fromCurrentRangeE
26-
, fromCurrentRangeMT) where
26+
, fromCurrentRangeMT
27+
-- Formatting handlers
28+
, mkFormattingHandlers) where
2729

30+
import Control.Lens ((^.))
31+
import Control.Monad.Error.Class (MonadError (throwError))
2832
import Control.Monad.Extra
2933
import Control.Monad.IO.Class
3034
import Control.Monad.Reader (runReaderT)
3135
import Control.Monad.Trans.Except
3236
import Control.Monad.Trans.Maybe
3337
import Data.Functor.Identity
3438
import qualified Data.Text as T
39+
import qualified Data.Text.Utf16.Rope.Mixed as Rope
40+
import Development.IDE.Core.FileStore
3541
import Development.IDE.Core.PositionMapping
42+
import Development.IDE.Core.Service (runAction)
3643
import Development.IDE.Core.Shake (IdeAction, IdeRule,
3744
IdeState (shakeExtras),
3845
mkDelayedAction,
@@ -44,6 +51,9 @@ import Development.IDE.Types.Location (NormalizedFilePath)
4451
import qualified Development.IDE.Types.Location as Location
4552
import qualified Ide.Logger as Logger
4653
import Ide.Plugin.Error
54+
import Ide.Types
55+
import qualified Language.LSP.Protocol.Lens as LSP
56+
import Language.LSP.Protocol.Message (SMethod (..))
4757
import qualified Language.LSP.Protocol.Types as LSP
4858

4959
-- ----------------------------------------------------------------------------
@@ -162,3 +172,34 @@ fromCurrentRangeE mapping = maybeToExceptT (PluginInvalidUserState "fromCurrentR
162172
-- |MaybeT version of `fromCurrentRange`
163173
fromCurrentRangeMT :: Monad m => PositionMapping -> LSP.Range -> MaybeT m LSP.Range
164174
fromCurrentRangeMT mapping = MaybeT . pure . fromCurrentRange mapping
175+
176+
-- ----------------------------------------------------------------------------
177+
-- Formatting handlers
178+
-- ----------------------------------------------------------------------------
179+
180+
-- `mkFormattingHandlers` was moved here from hls-plugin-api package so that
181+
-- `mkFormattingHandlers` can refer to `IdeState`. `IdeState` is defined in the
182+
-- ghcide package, but hls-plugin-api does not depend on ghcide, so `IdeState`
183+
-- is not in scope there.
184+
185+
mkFormattingHandlers :: FormattingHandler IdeState -> PluginHandlers IdeState
186+
mkFormattingHandlers f = mkPluginHandler SMethod_TextDocumentFormatting ( provider SMethod_TextDocumentFormatting)
187+
<> mkPluginHandler SMethod_TextDocumentRangeFormatting (provider SMethod_TextDocumentRangeFormatting)
188+
where
189+
provider :: forall m. FormattingMethod m => SMethod m -> PluginMethodHandler IdeState m
190+
provider m ide _pid params
191+
| Just nfp <- LSP.uriToNormalizedFilePath $ LSP.toNormalizedUri uri = do
192+
contentsMaybe <- liftIO $ runAction "mkFormattingHandlers" ide $ getFileContents nfp
193+
case contentsMaybe of
194+
Just contents -> do
195+
let (typ, mtoken) = case m of
196+
SMethod_TextDocumentFormatting -> (FormatText, params ^. LSP.workDoneToken)
197+
SMethod_TextDocumentRangeFormatting -> (FormatRange (params ^. LSP.range), params ^. LSP.workDoneToken)
198+
_ -> Prelude.error "mkFormattingHandlers: impossible"
199+
f ide mtoken typ (Rope.toText contents) nfp opts
200+
Nothing -> throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri
201+
202+
| otherwise = throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri
203+
where
204+
uri = params ^. LSP.textDocument . LSP.uri
205+
opts = params ^. LSP.options

Diff for: ‎ghcide/src/Development/IDE/Core/RuleTypes.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ import Development.IDE.Types.KnownTargets
3535
import GHC.Generics (Generic)
3636

3737
import Data.ByteString (ByteString)
38-
import Data.Text (Text)
38+
import Data.Text.Utf16.Rope.Mixed (Rope)
3939
import Development.IDE.Import.FindImports (ArtifactsLocation)
4040
import Development.IDE.Spans.Common
4141
import Development.IDE.Spans.LocalBindings
@@ -275,7 +275,7 @@ type instance RuleResult GetModIfaceFromDiskAndIndex = HiFileResult
275275
type instance RuleResult GetModIface = HiFileResult
276276

277277
-- | Get the contents of a file, either dirty (if the buffer is modified) or Nothing to mean use from disk.
278-
type instance RuleResult GetFileContents = (FileVersion, Maybe Text)
278+
type instance RuleResult GetFileContents = (FileVersion, Maybe Rope)
279279

280280
type instance RuleResult GetFileExists = Bool
281281

Diff for: ‎ghcide/src/Development/IDE/Core/Rules.hs

+6-4
Original file line numberDiff line numberDiff line change
@@ -91,6 +91,7 @@ import Data.Maybe
9191
import Data.Proxy
9292
import qualified Data.Text as T
9393
import qualified Data.Text.Encoding as T
94+
import qualified Data.Text.Utf16.Rope.Mixed as Rope
9495
import Data.Time (UTCTime (..))
9596
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
9697
import Data.Tuple.Extra
@@ -99,6 +100,7 @@ import Development.IDE.Core.Compile
99100
import Development.IDE.Core.FileExists hiding (Log,
100101
LogShake)
101102
import Development.IDE.Core.FileStore (getFileContents,
103+
getFileModTimeContents,
102104
getModTime)
103105
import Development.IDE.Core.IdeConfiguration
104106
import Development.IDE.Core.OfInterest hiding (Log,
@@ -220,10 +222,10 @@ toIdeResult = either (, Nothing) (([],) . Just)
220222
-- TODO: return text --> return rope
221223
getSourceFileSource :: NormalizedFilePath -> Action BS.ByteString
222224
getSourceFileSource nfp = do
223-
(_, msource) <- getFileContents nfp
225+
msource <- getFileContents nfp
224226
case msource of
225227
Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath nfp)
226-
Just source -> pure $ T.encodeUtf8 source
228+
Just source -> pure $ T.encodeUtf8 $ Rope.toText source
227229

228230
-- | Parse the contents of a haskell file.
229231
getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
@@ -861,10 +863,10 @@ getModSummaryRule displayTHWarning recorder = do
861863
session' <- hscEnv <$> use_ GhcSession f
862864
modify_dflags <- getModifyDynFlags dynFlagsModifyGlobal
863865
let session = hscSetFlags (modify_dflags $ hsc_dflags session') session'
864-
(modTime, mFileContent) <- getFileContents f
866+
(modTime, mFileContent) <- getFileModTimeContents f
865867
let fp = fromNormalizedFilePath f
866868
modS <- liftIO $ runExceptT $
867-
getModSummaryFromImports session fp modTime (textToStringBuffer <$> mFileContent)
869+
getModSummaryFromImports session fp modTime (textToStringBuffer . Rope.toText <$> mFileContent)
868870
case modS of
869871
Right res -> do
870872
-- Check for Template Haskell

Diff for: ‎ghcide/src/Development/IDE/Core/Shake.hs

+1-3
Original file line numberDiff line numberDiff line change
@@ -162,9 +162,7 @@ import Ide.Logger hiding (Priority)
162162
import qualified Ide.Logger as Logger
163163
import Ide.Plugin.Config
164164
import qualified Ide.PluginUtils as HLS
165-
import Ide.Types (IdePlugins (IdePlugins),
166-
PluginDescriptor (pluginId),
167-
PluginId)
165+
import Ide.Types
168166
import Language.LSP.Diagnostics
169167
import qualified Language.LSP.Protocol.Lens as L
170168
import Language.LSP.Protocol.Message

Diff for: ‎ghcide/src/Development/IDE/Plugin/Completions.hs

+5-3
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ import qualified Data.HashSet as Set
1919
import Data.Maybe
2020
import qualified Data.Text as T
2121
import Development.IDE.Core.Compile
22+
import Development.IDE.Core.FileStore (getUriContents)
2223
import Development.IDE.Core.PluginUtils
2324
import Development.IDE.Core.PositionMapping
2425
import Development.IDE.Core.RuleTypes
@@ -165,8 +166,9 @@ getCompletionsLSP ide plId
165166
CompletionParams{_textDocument=TextDocumentIdentifier uri
166167
,_position=position
167168
,_context=completionContext} = ExceptT $ do
168-
contents <- pluginGetVirtualFile $ toNormalizedUri uri
169-
fmap Right $ case (contents, uriToFilePath' uri) of
169+
contentsMaybe <-
170+
liftIO $ runAction "Completion" ide $ getUriContents $ toNormalizedUri uri
171+
fmap Right $ case (contentsMaybe, uriToFilePath' uri) of
170172
(Just cnts, Just path) -> do
171173
let npath = toNormalizedFilePath' path
172174
(ideOpts, compls, moduleExports, astres) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do
@@ -200,7 +202,7 @@ getCompletionsLSP ide plId
200202
pure (opts, fmap (,pm,binds) compls, moduleExports, astres)
201203
case compls of
202204
Just (cci', parsedMod, bindMap) -> do
203-
let pfix = getCompletionPrefix position cnts
205+
let pfix = getCompletionPrefixFromRope position cnts
204206
case (pfix, completionContext) of
205207
(PosPrefixInfo _ "" _ _, Just CompletionContext { _triggerCharacter = Just "."})
206208
-> return (InL [])

Diff for: ‎ghcide/src/Development/IDE/Spans/Pragmas.hs

+7-5
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,8 @@ import qualified Data.List as List
1515
import qualified Data.Maybe as Maybe
1616
import Data.Text (Text, pack)
1717
import qualified Data.Text as Text
18+
import Data.Text.Utf16.Rope.Mixed (Rope)
19+
import qualified Data.Text.Utf16.Rope.Mixed as Rope
1820
import Development.IDE (srcSpanToRange, IdeState, NormalizedFilePath, GhcSession (..), getFileContents, hscEnv, runAction)
1921
import Development.IDE.GHC.Compat
2022
import Development.IDE.GHC.Compat.Util
@@ -27,10 +29,10 @@ import qualified Data.Text as T
2729
import Development.IDE.Core.PluginUtils
2830
import qualified Language.LSP.Protocol.Lens as L
2931

30-
getNextPragmaInfo :: DynFlags -> Maybe Text -> NextPragmaInfo
31-
getNextPragmaInfo dynFlags mbSourceText =
32-
if | Just sourceText <- mbSourceText
33-
, let sourceStringBuffer = stringToStringBuffer (Text.unpack sourceText)
32+
getNextPragmaInfo :: DynFlags -> Maybe Rope -> NextPragmaInfo
33+
getNextPragmaInfo dynFlags mbSource =
34+
if | Just source <- mbSource
35+
, let sourceStringBuffer = stringToStringBuffer (Text.unpack (Rope.toText source))
3436
, POk _ parserState <- parsePreDecl dynFlags sourceStringBuffer
3537
-> case parserState of
3638
ParserStateNotDone{ nextPragma } -> nextPragma
@@ -56,7 +58,7 @@ insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma = LSP.TextEdit prag
5658
getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m NextPragmaInfo
5759
getFirstPragma (PluginId pId) state nfp = do
5860
(hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE (T.unpack pId <> ".GhcSession") state $ useWithStaleE GhcSession nfp
59-
(_, fileContents) <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp
61+
fileContents <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp
6062
pure $ getNextPragmaInfo sessionDynFlags fileContents
6163

6264
-- Pre-declaration comments parser -----------------------------------------------------

0 commit comments

Comments
 (0)