mirror of
https://github.com/haskell/ghcide.git
synced 2024-09-11 05:36:09 +03:00
Fix performance of getFileExists (#322)
* Improve hover performance by speeding up getFileExists We touch the file system only the first time. After that, we rely on the lsp client to tell us if a file is created or deleted Fixes #101
This commit is contained in:
parent
703bb82a1d
commit
2d9314ae1d
@ -93,10 +93,10 @@ main = do
|
||||
-- very important we only call loadSession once, and it's fast, so just do it before starting
|
||||
session <- loadSession dir
|
||||
let options = (defaultIdeOptions $ return session)
|
||||
{ optReportProgress = clientSupportsProgress caps
|
||||
{ optReportProgress = clientSupportsProgress caps
|
||||
, optShakeProfiling = argsShakeProfiling
|
||||
}
|
||||
initialise (mainRule >> action kick) getLspId event (logger minBound) options vfs
|
||||
initialise caps (mainRule >> action kick) getLspId event (logger minBound) options vfs
|
||||
else do
|
||||
putStrLn $ "Ghcide setup tester in " ++ dir ++ "."
|
||||
putStrLn "Report bugs at https://github.com/digital-asset/ghcide/issues"
|
||||
@ -125,7 +125,7 @@ main = do
|
||||
let grab file = fromMaybe (head sessions) $ do
|
||||
cradle <- Map.lookup file filesToCradles
|
||||
Map.lookup cradle cradlesToSessions
|
||||
ide <- initialise mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) (defaultIdeOptions $ return $ return . grab) vfs
|
||||
ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) (defaultIdeOptions $ return $ return . grab) vfs
|
||||
|
||||
putStrLn "\nStep 6/6: Type checking the files"
|
||||
setFilesOfInterest ide $ Set.fromList $ map toNormalizedFilePath files
|
||||
|
13
ghcide.cabal
13
ghcide.cabal
@ -121,6 +121,7 @@ library
|
||||
Development.IDE.Core.Debouncer
|
||||
Development.IDE.Core.Compile
|
||||
Development.IDE.Core.Preprocessor
|
||||
Development.IDE.Core.FileExists
|
||||
Development.IDE.GHC.Compat
|
||||
Development.IDE.GHC.CPP
|
||||
Development.IDE.GHC.Error
|
||||
@ -230,4 +231,16 @@ test-suite ghcide-tests
|
||||
Development.IDE.Test
|
||||
Development.IDE.Test.Runfiles
|
||||
default-extensions:
|
||||
BangPatterns
|
||||
DeriveFunctor
|
||||
DeriveGeneric
|
||||
GeneralizedNewtypeDeriving
|
||||
LambdaCase
|
||||
NamedFieldPuns
|
||||
OverloadedStrings
|
||||
RecordWildCards
|
||||
ScopedTypeVariables
|
||||
StandaloneDeriving
|
||||
TupleSections
|
||||
TypeApplications
|
||||
ViewPatterns
|
||||
|
187
src/Development/IDE/Core/FileExists.hs
Normal file
187
src/Development/IDE/Core/FileExists.hs
Normal file
@ -0,0 +1,187 @@
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Development.IDE.Core.FileExists
|
||||
( fileExistsRules
|
||||
, modifyFileExists
|
||||
, getFileExists
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent.Extra
|
||||
import Control.Exception
|
||||
import Control.Monad.Extra
|
||||
import qualified Data.Aeson as A
|
||||
import Data.Binary
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.Map.Strict ( Map )
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Development.IDE.Core.FileStore
|
||||
import Development.IDE.Core.Shake
|
||||
import Development.IDE.Types.Location
|
||||
import Development.Shake
|
||||
import Development.Shake.Classes
|
||||
import GHC.Generics
|
||||
import Language.Haskell.LSP.Messages
|
||||
import Language.Haskell.LSP.Types
|
||||
import Language.Haskell.LSP.Types.Capabilities
|
||||
import qualified System.Directory as Dir
|
||||
|
||||
-- | A map for tracking the file existence
|
||||
type FileExistsMap = (Map NormalizedFilePath Bool)
|
||||
|
||||
-- | A wrapper around a mutable 'FileExistsMap'
|
||||
newtype FileExistsMapVar = FileExistsMapVar (Var FileExistsMap)
|
||||
|
||||
instance IsIdeGlobal FileExistsMapVar
|
||||
|
||||
-- | Grab the current global value of 'FileExistsMap' without acquiring a dependency
|
||||
getFileExistsMapUntracked :: Action FileExistsMap
|
||||
getFileExistsMapUntracked = do
|
||||
FileExistsMapVar v <- getIdeGlobalAction
|
||||
liftIO $ readVar v
|
||||
|
||||
-- | Modify the global store of file exists
|
||||
modifyFileExistsAction :: (FileExistsMap -> IO FileExistsMap) -> Action ()
|
||||
modifyFileExistsAction f = do
|
||||
FileExistsMapVar var <- getIdeGlobalAction
|
||||
liftIO $ modifyVar_ var f
|
||||
|
||||
-- | Modify the global store of file exists
|
||||
modifyFileExists :: IdeState -> [(NormalizedFilePath, Bool)] -> IO ()
|
||||
modifyFileExists state changes = do
|
||||
FileExistsMapVar var <- getIdeGlobalState state
|
||||
changesMap <- evaluate $ Map.fromList changes
|
||||
|
||||
-- Masked to ensure that the previous values are flushed together with the map update
|
||||
mask $ \_ -> do
|
||||
-- update the map
|
||||
modifyVar_ var $ evaluate . Map.union changesMap
|
||||
-- flush previous values
|
||||
mapM_ (deleteValue state GetFileExists . fst) changes
|
||||
|
||||
-------------------------------------------------------------------------------------
|
||||
|
||||
type instance RuleResult GetFileExists = Bool
|
||||
|
||||
data GetFileExists = GetFileExists
|
||||
deriving (Eq, Show, Typeable, Generic)
|
||||
|
||||
instance NFData GetFileExists
|
||||
instance Hashable GetFileExists
|
||||
instance Binary GetFileExists
|
||||
|
||||
-- | Returns True if the file exists
|
||||
-- Note that a file is not considered to exist unless it is saved to disk.
|
||||
-- In particular, VFS existence is not enough.
|
||||
-- Consider the following example:
|
||||
-- 1. The file @A.hs@ containing the line @import B@ is added to the files of interest
|
||||
-- Since @B.hs@ is neither open nor exists, GetLocatedImports finds Nothing
|
||||
-- 2. The editor creates a new buffer @B.hs@
|
||||
-- Unless the editor also sends a @DidChangeWatchedFile@ event, ghcide will not pick it up
|
||||
-- Most editors, e.g. VSCode, only send the event when the file is saved to disk.
|
||||
getFileExists :: NormalizedFilePath -> Action Bool
|
||||
getFileExists fp = use_ GetFileExists fp
|
||||
|
||||
-- | Installs the 'getFileExists' rules.
|
||||
-- Provides a fast implementation if client supports dynamic watched files.
|
||||
-- Creates a global state as a side effect in that case.
|
||||
fileExistsRules :: IO LspId -> ClientCapabilities -> VFSHandle -> Rules ()
|
||||
fileExistsRules getLspId ClientCapabilities{_workspace}
|
||||
| Just WorkspaceClientCapabilities{_didChangeWatchedFiles} <- _workspace
|
||||
, Just DidChangeWatchedFilesClientCapabilities{_dynamicRegistration} <- _didChangeWatchedFiles
|
||||
, Just True <- _dynamicRegistration
|
||||
= fileExistsRulesFast getLspId
|
||||
| otherwise = fileExistsRulesSlow
|
||||
|
||||
-- Requires an lsp client that provides WatchedFiles notifications.
|
||||
fileExistsRulesFast :: IO LspId -> VFSHandle -> Rules ()
|
||||
fileExistsRulesFast getLspId vfs = do
|
||||
addIdeGlobal . FileExistsMapVar =<< liftIO (newVar [])
|
||||
defineEarlyCutoff $ \GetFileExists file -> do
|
||||
fileExistsMap <- getFileExistsMapUntracked
|
||||
let mbFilesWatched = Map.lookup file fileExistsMap
|
||||
case mbFilesWatched of
|
||||
Just fv -> pure (summarizeExists fv, ([], Just fv))
|
||||
Nothing -> do
|
||||
exist <- liftIO $ getFileExistsVFS vfs file
|
||||
ShakeExtras { eventer } <- getShakeExtras
|
||||
|
||||
-- add a listener for VFS Create/Delete file events,
|
||||
-- taking the FileExistsMap lock to prevent race conditions
|
||||
-- that would lead to multiple listeners for the same path
|
||||
modifyFileExistsAction $ \x -> do
|
||||
case Map.insertLookupWithKey (\_ x _ -> x) file exist x of
|
||||
(Nothing, x') -> do
|
||||
-- if the listener addition fails, we never recover. This is a bug.
|
||||
addListener eventer file
|
||||
return x'
|
||||
(Just _, _) ->
|
||||
-- if the key was already there, do nothing
|
||||
return x
|
||||
|
||||
pure (summarizeExists exist, ([], Just exist))
|
||||
where
|
||||
addListener eventer fp = do
|
||||
reqId <- getLspId
|
||||
let
|
||||
req = RequestMessage "2.0" reqId ClientRegisterCapability regParams
|
||||
fpAsId = T.pack $ fromNormalizedFilePath fp
|
||||
regParams = RegistrationParams (List [registration])
|
||||
registration = Registration fpAsId
|
||||
WorkspaceDidChangeWatchedFiles
|
||||
(Just (A.toJSON regOptions))
|
||||
regOptions =
|
||||
DidChangeWatchedFilesRegistrationOptions { watchers = List [watcher] }
|
||||
watcher = FileSystemWatcher { globPattern = fromNormalizedFilePath fp
|
||||
, kind = Just 5 -- Create and Delete events only
|
||||
}
|
||||
|
||||
eventer $ ReqRegisterCapability req
|
||||
|
||||
summarizeExists :: Bool -> Maybe BS.ByteString
|
||||
summarizeExists x = Just $ if x then BS.singleton 1 else BS.empty
|
||||
|
||||
fileExistsRulesSlow:: VFSHandle -> Rules ()
|
||||
fileExistsRulesSlow vfs = do
|
||||
defineEarlyCutoff $ \GetFileExists file -> do
|
||||
alwaysRerun
|
||||
exist <- liftIO $ getFileExistsVFS vfs file
|
||||
pure (summarizeExists exist, ([], Just exist))
|
||||
|
||||
getFileExistsVFS :: VFSHandle -> NormalizedFilePath -> IO Bool
|
||||
getFileExistsVFS vfs file = do
|
||||
-- we deliberately and intentionally wrap the file as an FilePath WITHOUT mkAbsolute
|
||||
-- so that if the file doesn't exist, is on a shared drive that is unmounted etc we get a properly
|
||||
-- cached 'No' rather than an exception in the wrong place
|
||||
handle (\(_ :: IOException) -> return False) $
|
||||
(isJust <$> getVirtualFile vfs (filePathToUri' file)) ||^
|
||||
Dir.doesFileExist (fromNormalizedFilePath file)
|
||||
|
||||
--------------------------------------------------------------------------------------------------
|
||||
-- The message definitions below probably belong in haskell-lsp-types
|
||||
|
||||
data DidChangeWatchedFilesRegistrationOptions = DidChangeWatchedFilesRegistrationOptions
|
||||
{ watchers :: List FileSystemWatcher
|
||||
}
|
||||
|
||||
instance A.ToJSON DidChangeWatchedFilesRegistrationOptions where
|
||||
toJSON DidChangeWatchedFilesRegistrationOptions {..} =
|
||||
A.object ["watchers" A..= watchers]
|
||||
|
||||
data FileSystemWatcher = FileSystemWatcher
|
||||
{ -- | The glob pattern to watch.
|
||||
-- For details on glob pattern syntax, check the spec: https://microsoft.github.io/language-server-protocol/specifications/specification-3-14/#workspace_didChangeWatchedFiles
|
||||
globPattern :: String
|
||||
-- | The kind of event to subscribe to. Defaults to all.
|
||||
-- Defined as a bitmap of Create(1), Change(2), and Delete(4)
|
||||
, kind :: Maybe Int
|
||||
}
|
||||
|
||||
instance A.ToJSON FileSystemWatcher where
|
||||
toJSON FileSystemWatcher {..} =
|
||||
A.object
|
||||
$ ["globPattern" A..= globPattern]
|
||||
++ [ "kind" A..= x | Just x <- [kind] ]
|
@ -4,7 +4,8 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Development.IDE.Core.FileStore(
|
||||
getFileExists, getFileContents,
|
||||
getFileContents,
|
||||
getVirtualFile,
|
||||
setBufferModified,
|
||||
setSomethingModified,
|
||||
fileStoreRules,
|
||||
@ -20,16 +21,14 @@ import Fingerprint
|
||||
import StringBuffer
|
||||
import Development.IDE.GHC.Orphans()
|
||||
import Development.IDE.GHC.Util
|
||||
|
||||
import Development.IDE.Core.Shake
|
||||
import Control.Concurrent.Extra
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Control.Monad.Extra
|
||||
import qualified System.Directory as Dir
|
||||
import Development.Shake
|
||||
import Development.Shake.Classes
|
||||
import Development.IDE.Core.Shake
|
||||
import Control.Exception
|
||||
import GHC.Generics
|
||||
import Data.Either.Extra
|
||||
@ -90,17 +89,8 @@ makeLSPVFSHandle lspFuncs = VFSHandle
|
||||
-- | 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 StringBuffer)
|
||||
|
||||
-- | Does the file exist.
|
||||
type instance RuleResult GetFileExists = Bool
|
||||
|
||||
type instance RuleResult FingerprintSource = Fingerprint
|
||||
|
||||
data GetFileExists = GetFileExists
|
||||
deriving (Eq, Show, Generic)
|
||||
instance Hashable GetFileExists
|
||||
instance NFData GetFileExists
|
||||
instance Binary GetFileExists
|
||||
|
||||
data GetFileContents = GetFileContents
|
||||
deriving (Eq, Show, Generic)
|
||||
instance Hashable GetFileContents
|
||||
@ -122,16 +112,6 @@ fingerprintSourceRule =
|
||||
pure ([], Just fingerprint)
|
||||
where fpStringBuffer (StringBuffer buf len cur) = withForeignPtr buf $ \ptr -> fingerprintData (ptr `plusPtr` cur) len
|
||||
|
||||
getFileExistsRule :: VFSHandle -> Rules ()
|
||||
getFileExistsRule vfs =
|
||||
defineEarlyCutoff $ \GetFileExists file -> do
|
||||
alwaysRerun
|
||||
res <- liftIO $ handle (\(_ :: IOException) -> return False) $
|
||||
(isJust <$> getVirtualFile vfs (filePathToUri' file)) ||^
|
||||
Dir.doesFileExist (fromNormalizedFilePath file)
|
||||
return (Just $ if res then BS.singleton '1' else BS.empty, ([], Just res))
|
||||
|
||||
|
||||
getModificationTimeRule :: VFSHandle -> Rules ()
|
||||
getModificationTimeRule vfs =
|
||||
defineEarlyCutoff $ \GetModificationTime file -> do
|
||||
@ -154,6 +134,8 @@ getModificationTimeRule vfs =
|
||||
-- time spent checking file modifications (which happens on every change)
|
||||
-- from > 0.5s to ~0.15s.
|
||||
-- We might also want to try speeding this up on Windows at some point.
|
||||
-- TODO leverage DidChangeWatchedFile lsp notifications on clients that
|
||||
-- support them, as done for GetFileExists
|
||||
getModTime :: FilePath -> IO BS.ByteString
|
||||
getModTime f =
|
||||
#ifdef mingw32_HOST_OS
|
||||
@ -198,20 +180,11 @@ ideTryIOException fp act =
|
||||
getFileContents :: NormalizedFilePath -> Action (FileVersion, Maybe StringBuffer)
|
||||
getFileContents = use_ GetFileContents
|
||||
|
||||
getFileExists :: NormalizedFilePath -> Action Bool
|
||||
getFileExists =
|
||||
-- we deliberately and intentionally wrap the file as an FilePath WITHOUT mkAbsolute
|
||||
-- so that if the file doesn't exist, is on a shared drive that is unmounted etc we get a properly
|
||||
-- cached 'No' rather than an exception in the wrong place
|
||||
use_ GetFileExists
|
||||
|
||||
|
||||
fileStoreRules :: VFSHandle -> Rules ()
|
||||
fileStoreRules vfs = do
|
||||
addIdeGlobal vfs
|
||||
getModificationTimeRule vfs
|
||||
getFileContentsRule vfs
|
||||
getFileExistsRule vfs
|
||||
fingerprintSourceRule
|
||||
|
||||
|
||||
|
@ -37,7 +37,8 @@ import Development.IDE.Types.Options
|
||||
import Development.IDE.Spans.Calculate
|
||||
import Development.IDE.Import.DependencyInformation
|
||||
import Development.IDE.Import.FindImports
|
||||
import Development.IDE.Core.FileStore
|
||||
import Development.IDE.Core.FileExists
|
||||
import Development.IDE.Core.FileStore (getFileContents, getSourceFingerprint)
|
||||
import Development.IDE.Types.Diagnostics
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.GHC.Util
|
||||
|
@ -23,13 +23,15 @@ import Control.Concurrent.Async
|
||||
import Data.Maybe
|
||||
import Development.IDE.Types.Options (IdeOptions(..))
|
||||
import Control.Monad
|
||||
import Development.IDE.Core.FileStore
|
||||
import Development.IDE.Core.FileStore (VFSHandle, fileStoreRules)
|
||||
import Development.IDE.Core.FileExists (fileExistsRules)
|
||||
import Development.IDE.Core.OfInterest
|
||||
import Development.IDE.Types.Logger
|
||||
import Development.Shake
|
||||
import Data.Either.Extra
|
||||
import qualified Language.Haskell.LSP.Messages as LSP
|
||||
import qualified Language.Haskell.LSP.Types as LSP
|
||||
import qualified Language.Haskell.LSP.Types.Capabilities as LSP
|
||||
|
||||
import Development.IDE.Core.Shake
|
||||
|
||||
@ -42,14 +44,15 @@ instance IsIdeGlobal GlobalIdeOptions
|
||||
-- Exposed API
|
||||
|
||||
-- | Initialise the Compiler Service.
|
||||
initialise :: Rules ()
|
||||
initialise :: LSP.ClientCapabilities
|
||||
-> Rules ()
|
||||
-> IO LSP.LspId
|
||||
-> (LSP.FromServerMessage -> IO ())
|
||||
-> Logger
|
||||
-> IdeOptions
|
||||
-> VFSHandle
|
||||
-> IO IdeState
|
||||
initialise mainRule getLspId toDiags logger options vfs =
|
||||
initialise caps mainRule getLspId toDiags logger options vfs =
|
||||
shakeOpen
|
||||
getLspId
|
||||
toDiags
|
||||
@ -63,6 +66,7 @@ initialise mainRule getLspId toDiags logger options vfs =
|
||||
addIdeGlobal $ GlobalIdeOptions options
|
||||
fileStoreRules vfs
|
||||
ofInterestRules
|
||||
fileExistsRules getLspId caps vfs
|
||||
mainRule
|
||||
|
||||
writeProfile :: IdeState -> FilePath -> IO ()
|
||||
|
@ -20,6 +20,7 @@
|
||||
-- between runs. To deserialise a Shake value, we just consult Values.
|
||||
module Development.IDE.Core.Shake(
|
||||
IdeState,
|
||||
ShakeExtras(..), getShakeExtras,
|
||||
IdeRule, IdeResult, GetModificationTime(..),
|
||||
shakeOpen, shakeShut,
|
||||
shakeRun,
|
||||
@ -38,7 +39,8 @@ module Development.IDE.Core.Shake(
|
||||
FileVersion(..),
|
||||
Priority(..),
|
||||
updatePositionMapping,
|
||||
OnDiskRule(..)
|
||||
deleteValue,
|
||||
OnDiskRule(..),
|
||||
) where
|
||||
|
||||
import Development.Shake hiding (ShakeValue, doesFileExist)
|
||||
@ -257,6 +259,16 @@ setValues state key file val = modifyVar_ state $ \vals -> do
|
||||
-- Force to make sure the old HashMap is not retained
|
||||
evaluate $ HMap.insert (file, Key key) (fmap toDyn val) vals
|
||||
|
||||
-- | Delete the value stored for a given ide build key
|
||||
deleteValue
|
||||
:: (Typeable k, Hashable k, Eq k, Show k)
|
||||
=> IdeState
|
||||
-> k
|
||||
-> NormalizedFilePath
|
||||
-> IO ()
|
||||
deleteValue IdeState{shakeExtras = ShakeExtras{state}} key file = modifyVar_ state $ \vals ->
|
||||
evaluate $ HMap.delete (file, Key key) vals
|
||||
|
||||
-- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value.
|
||||
getValues :: forall k v. IdeRule k v => Var Values -> k -> NormalizedFilePath -> IO (Maybe (Value v))
|
||||
getValues state key file = do
|
||||
|
@ -2,26 +2,30 @@
|
||||
-- SPDX-License-Identifier: Apache-2.0
|
||||
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module Development.IDE.LSP.Notifications
|
||||
( setHandlersNotifications
|
||||
) where
|
||||
|
||||
import Language.Haskell.LSP.Types
|
||||
import Development.IDE.LSP.Server
|
||||
import qualified Language.Haskell.LSP.Core as LSP
|
||||
import qualified Language.Haskell.LSP.Types as LSP
|
||||
import qualified Language.Haskell.LSP.Core as LSP
|
||||
import Language.Haskell.LSP.Types
|
||||
import qualified Language.Haskell.LSP.Types as LSP
|
||||
|
||||
import Development.IDE.Types.Logger
|
||||
import Development.IDE.Core.Service
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Core.Service
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Logger
|
||||
|
||||
import Control.Monad.Extra
|
||||
import qualified Data.Set as S
|
||||
import Control.Monad.Extra
|
||||
import Data.Foldable as F
|
||||
import Data.Maybe
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import Development.IDE.Core.FileStore
|
||||
import Development.IDE.Core.OfInterest
|
||||
import Development.IDE.Core.FileStore (setSomethingModified)
|
||||
import Development.IDE.Core.FileExists (modifyFileExists)
|
||||
import Development.IDE.Core.OfInterest
|
||||
|
||||
|
||||
whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
|
||||
@ -52,4 +56,17 @@ setHandlersNotifications = PartialHandlers $ \WithMessage{..} x -> return x
|
||||
whenUriFile _uri $ \file -> do
|
||||
modifyFilesOfInterest ide (S.delete file)
|
||||
logInfo (ideLogger ide) $ "Closed text document: " <> getUri _uri
|
||||
}
|
||||
,LSP.didChangeWatchedFilesNotificationHandler = withNotification (LSP.didChangeWatchedFilesNotificationHandler x) $
|
||||
\_ ide (DidChangeWatchedFilesParams fileEvents) -> do
|
||||
let events =
|
||||
mapMaybe
|
||||
(\(FileEvent uri ev) ->
|
||||
(, ev /= FcDeleted) . toNormalizedFilePath
|
||||
<$> LSP.uriToFilePath uri
|
||||
)
|
||||
( F.toList fileEvents )
|
||||
let msg = Text.pack $ show events
|
||||
logInfo (ideLogger ide) $ "Files created or deleted: " <> msg
|
||||
modifyFileExists ide events
|
||||
setSomethingModified ide
|
||||
}
|
@ -20,7 +20,8 @@ import qualified Data.Text as T
|
||||
import Development.IDE.Test
|
||||
import Development.IDE.Test.Runfiles
|
||||
import Development.IDE.Types.Location
|
||||
import Language.Haskell.LSP.Test
|
||||
import qualified Language.Haskell.LSP.Test as LSPTest
|
||||
import Language.Haskell.LSP.Test hiding (openDoc')
|
||||
import Language.Haskell.LSP.Types
|
||||
import Language.Haskell.LSP.Types.Capabilities
|
||||
import System.Environment.Blank (setEnv)
|
||||
@ -1583,7 +1584,8 @@ run s = withTempDir $ \dir -> do
|
||||
-- HIE calls getXgdDirectory which assumes that HOME is set.
|
||||
-- Only sets HOME if it wasn't already set.
|
||||
setEnv "HOME" "/homeless-shelter" False
|
||||
runSessionWithConfig conf cmd fullCaps { _window = Just $ WindowClientCapabilities $ Just True } dir s
|
||||
let lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities $ Just True }
|
||||
runSessionWithConfig conf cmd lspTestCaps dir s
|
||||
where
|
||||
conf = defaultConfig
|
||||
-- If you uncomment this you can see all logging
|
||||
@ -1626,3 +1628,10 @@ unitTests = do
|
||||
[ testCase "empty file path" $
|
||||
uriToFilePath' (fromNormalizedUri $ filePathToUri' "") @?= Just ""
|
||||
]
|
||||
|
||||
-- | Wrapper around 'LSPTest.openDoc'' that sends file creation events
|
||||
openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
|
||||
openDoc' fp name contents = do
|
||||
res@(TextDocumentIdentifier uri) <- LSPTest.openDoc' fp name contents
|
||||
sendNotification WorkspaceDidChangeWatchedFiles (DidChangeWatchedFilesParams $ List [FileEvent uri FcCreated])
|
||||
return res
|
Loading…
Reference in New Issue
Block a user