Skip to content

Commit 3cb9f15

Browse files
awjchenawjchen
committed
Add util functions for common cases of Shake VFS file access
1 parent 59292ee commit 3cb9f15

File tree

15 files changed

+42
-28
lines changed

15 files changed

+42
-28
lines changed

‎ghcide/src/Development/IDE.hs

Lines changed: 3 additions & 1 deletion
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 (getFileModTimeContents)
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)

‎ghcide/src/Development/IDE/Core/FileStore.hs

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,8 @@
44

55
module Development.IDE.Core.FileStore(
66
getFileModTimeContents,
7+
getFileContents,
8+
getUriContents,
79
getVersionedTextDoc,
810
setFileModified,
911
setSomethingModified,
@@ -206,6 +208,13 @@ getFileModTimeContents f = do
206208
pure $ posixSecondsToUTCTime posix
207209
return (modTime, contents)
208210

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+
209218
-- | Given a text document identifier, annotate it with the latest version.
210219
--
211220
-- Like Language.LSP.Server.Core.getVersionedTextDoc, but gets the virtual file

‎ghcide/src/Development/IDE/Core/PluginUtils.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -189,7 +189,7 @@ mkFormattingHandlers f = mkPluginHandler SMethod_TextDocumentFormatting ( provid
189189
provider :: forall m. FormattingMethod m => SMethod m -> PluginMethodHandler IdeState m
190190
provider m ide _pid params
191191
| Just nfp <- LSP.uriToNormalizedFilePath $ LSP.toNormalizedUri uri = do
192-
contentsMaybe <- liftIO $ runAction "mkFormattingHandlers" ide $ fmap snd $ getFileModTimeContents nfp
192+
contentsMaybe <- liftIO $ runAction "mkFormattingHandlers" ide $ getFileContents nfp
193193
case contentsMaybe of
194194
Just contents -> do
195195
let (typ, mtoken) = case m of

‎ghcide/src/Development/IDE/Core/Rules.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -99,7 +99,8 @@ import Data.Typeable (cast)
9999
import Development.IDE.Core.Compile
100100
import Development.IDE.Core.FileExists hiding (Log,
101101
LogShake)
102-
import Development.IDE.Core.FileStore (getFileModTimeContents,
102+
import Development.IDE.Core.FileStore (getFileContents,
103+
getFileModTimeContents,
103104
getModTime)
104105
import Development.IDE.Core.IdeConfiguration
105106
import Development.IDE.Core.OfInterest hiding (Log,
@@ -221,7 +222,7 @@ toIdeResult = either (, Nothing) (([],) . Just)
221222
-- TODO: return text --> return rope
222223
getSourceFileSource :: NormalizedFilePath -> Action BS.ByteString
223224
getSourceFileSource nfp = do
224-
(_, msource) <- getFileModTimeContents nfp
225+
msource <- getFileContents nfp
225226
case msource of
226227
Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath nfp)
227228
Just source -> pure $ T.encodeUtf8 $ Rope.toText source

‎ghcide/src/Development/IDE/Plugin/Completions.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +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 (getFileModTimeContents)
22+
import Development.IDE.Core.FileStore (getUriContents)
2323
import Development.IDE.Core.PluginUtils
2424
import Development.IDE.Core.PositionMapping
2525
import Development.IDE.Core.RuleTypes
@@ -167,7 +167,7 @@ getCompletionsLSP ide plId
167167
,_position=position
168168
,_context=completionContext} = ExceptT $ do
169169
contentsMaybe <-
170-
liftIO $ runAction "Completion" ide $ maybe (pure Nothing) (fmap snd . getFileModTimeContents) $ uriToNormalizedFilePath $ toNormalizedUri uri
170+
liftIO $ runAction "Completion" ide $ getUriContents $ toNormalizedUri uri
171171
fmap Right $ case (contentsMaybe, uriToFilePath' uri) of
172172
(Just cnts, Just path) -> do
173173
let npath = toNormalizedFilePath' path

‎ghcide/src/Development/IDE/Spans/Pragmas.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ import Data.Text (Text, pack)
1717
import qualified Data.Text as Text
1818
import Data.Text.Utf16.Rope.Mixed (Rope)
1919
import qualified Data.Text.Utf16.Rope.Mixed as Rope
20-
import Development.IDE (srcSpanToRange, IdeState, NormalizedFilePath, GhcSession (..), getFileModTimeContents, hscEnv, runAction)
20+
import Development.IDE (srcSpanToRange, IdeState, NormalizedFilePath, GhcSession (..), getFileContents, hscEnv, runAction)
2121
import Development.IDE.GHC.Compat
2222
import Development.IDE.GHC.Compat.Util
2323
import qualified Language.LSP.Protocol.Types as LSP
@@ -58,7 +58,7 @@ insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma = LSP.TextEdit prag
5858
getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m NextPragmaInfo
5959
getFirstPragma (PluginId pId) state nfp = do
6060
(hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE (T.unpack pId <> ".GhcSession") state $ useWithStaleE GhcSession nfp
61-
(_, fileContents) <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileModTimeContents nfp
61+
fileContents <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp
6262
pure $ getNextPragmaInfo sessionDynFlags fileContents
6363

6464
-- Pre-declaration comments parser -----------------------------------------------------

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -321,7 +321,7 @@ completion :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.M
321321
completion recorder ide _ complParams = do
322322
let (TextDocumentIdentifier uri) = complParams ^. JL.textDocument
323323
position = complParams ^. JL.position
324-
mContents <- liftIO $ runAction "cabal-plugin.getFileModTimeContents" ide $ maybe (pure Nothing) (fmap snd . getFileModTimeContents) $ uriToNormalizedFilePath $ toNormalizedUri uri
324+
mContents <- liftIO $ runAction "cabal-plugin.getUriContents" ide $ getUriContents $ toNormalizedUri uri
325325
case (,) <$> mContents <*> uriToFilePath' uri of
326326
Just (cnts, path) -> do
327327
-- We decide on `useWithStale` here, since `useWithStaleFast` often leads to the wrong completions being suggested.

‎plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -64,8 +64,8 @@ insertPragmaIfNotPresent :: (MonadIO m)
6464
insertPragmaIfNotPresent state nfp pragma = do
6565
(hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE "classplugin.insertPragmaIfNotPresent.GhcSession" state
6666
$ useWithStaleE GhcSession nfp
67-
(_, fileContents) <- liftIO $ runAction "classplugin.insertPragmaIfNotPresent.GetFileContents" state
68-
$ getFileModTimeContents nfp
67+
fileContents <- liftIO $ runAction "classplugin.insertPragmaIfNotPresent.GetFileContents" state
68+
$ getFileContents nfp
6969
(pm, _) <- runActionE "classplugin.insertPragmaIfNotPresent.GetParsedModuleWithComments" state
7070
$ useWithStaleE GetParsedModuleWithComments nfp
7171
let exts = getExtensions pm

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ import Data.Text (Text)
4242
import qualified Data.Text as T
4343
import qualified Data.Text.Utf16.Rope.Mixed as Rope
4444
import Data.Typeable (Typeable)
45-
import Development.IDE.Core.FileStore (getFileModTimeContents)
45+
import Development.IDE.Core.FileStore (getUriContents)
4646
import Development.IDE.Core.Rules (IdeState,
4747
runAction)
4848
import Development.IDE.Core.RuleTypes (LinkableResult (linkableHomeMod),
@@ -304,8 +304,9 @@ moduleText state uri = do
304304
contents <-
305305
handleMaybeM (PluginInternalError "mdlText") $
306306
liftIO $
307-
runAction "eval.getFileModTimeContents" state $
308-
maybe (pure Nothing) (fmap snd . getFileModTimeContents) $ uriToNormalizedFilePath $ toNormalizedUri uri
307+
runAction "eval.getUriContents" state $
308+
getUriContents $
309+
toNormalizedUri uri
309310
pure $ Rope.toText contents
310311

311312
testsBySection :: [Section] -> [(Section, EvalId, Test)]

‎plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -193,7 +193,7 @@ type instance RuleResult GetHlintDiagnostics = ()
193193
-- | This rule is recomputed when:
194194
-- | - A file has been edited via
195195
-- | - `getIdeas` -> `getParsedModule` in any case
196-
-- | - `getIdeas` -> `getFileModTimeContents` if the hls ghc does not match the hlint default ghc
196+
-- | - `getIdeas` -> `getFileContents` if the hls ghc does not match the hlint default ghc
197197
-- | - The client settings have changed, to honour the `hlintOn` setting, via `getClientConfigAction`
198198
-- | - The hlint specific settings have changed, via `getHlintSettingsRule`
199199
rules :: Recorder (WithPriority Log) -> PluginId -> Rules ()
@@ -307,7 +307,7 @@ getIdeas recorder nfp = do
307307
then return Nothing
308308
else do
309309
flags' <- setExtensions flags
310-
(_, contents) <- getFileModTimeContents nfp
310+
contents <- getFileContents nfp
311311
let fp = fromNormalizedFilePath nfp
312312
let contents' = T.unpack . Rope.toText <$> contents
313313
Just <$> liftIO (parseModuleEx flags' fp contents')
@@ -521,7 +521,7 @@ applyHint recorder ide nfp mhint verTxtDocId =
521521
let commands = map ideaRefactoring ideas'
522522
logWith recorder Debug $ LogGeneratedIdeas nfp commands
523523
let fp = fromNormalizedFilePath nfp
524-
(_, fmap Rope.toText -> mbOldContent) <- liftIO $ runAction' $ getFileModTimeContents nfp
524+
mbOldContent <- fmap (fmap Rope.toText) $ liftIO $ runAction' $ getFileContents nfp
525525
oldContent <- maybe (liftIO $ fmap T.decodeUtf8 (BS.readFile fp)) return mbOldContent
526526
modsum <- liftIO $ runAction' $ use_ GetModSummary nfp
527527
let dflags = ms_hspp_opts $ msrModSummary modsum

0 commit comments

Comments
 (0)