From 0544cd0d0de5497a41e4b40028c4a54bcc0e9765 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 29 Apr 2021 09:06:01 +0100 Subject: [PATCH 1/4] Replace the unsafe getmodtime with the one from the posix package We don't need the 2X faster but unsafe getmodtime anymore since GetModificationTime is not called O(N) anymore, but only O(FOI) times, where N is the number of known targets and FOI is the number of files of interest --- ghcide/ghcide.cabal | 2 - ghcide/src/Development/IDE/Core/FileStore.hs | 41 ++++++-------------- ghcide/src/Development/IDE/Core/RuleTypes.hs | 8 ++-- 3 files changed, 14 insertions(+), 37 deletions(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index fb1c792053..7ba852f08b 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -108,8 +108,6 @@ library else build-depends: unix - c-sources: - cbits/getmodtime.c default-extensions: ApplicativeDo diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 5fc511d327..f341a37207 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -37,16 +37,17 @@ import Data.Maybe import qualified Data.Rope.UTF16 as Rope import qualified Data.Text as T import Data.Time +import Data.Time.Clock.POSIX import Development.IDE.Core.OfInterest (OfInterestVar (..), getFilesOfInterest) import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake import Development.IDE.GHC.Orphans () +import Development.IDE.Graph import Development.IDE.Import.DependencyInformation import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Options -import Development.IDE.Graph import HieDb.Create (deleteMissingRealFiles) import Ide.Plugin.Config (CheckParents (..)) import System.IO.Error @@ -62,6 +63,7 @@ import Foreign.Marshal (alloca) import Foreign.Ptr import Foreign.Storable import qualified System.Posix.Error as Posix +import System.Posix.Files (getFileStatus, modificationTimeHiRes) #endif import qualified Development.IDE.Types.Logger as L @@ -126,7 +128,7 @@ getModificationTimeImpl :: VFSHandle (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion)) getModificationTimeImpl vfs isWatched missingFileDiags file = do let file' = fromNormalizedFilePath file - let wrap time@(l,s) = (Just $ LBS.toStrict $ B.encode time, ([], Just $ ModificationTime l s)) + let wrap time = (Just $ LBS.toStrict $ B.encode $ toRational time, ([], Just $ ModificationTime time)) mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file case mbVirtual of Just (virtualFileVersion -> ver) -> do @@ -192,38 +194,17 @@ resetFileStore ideState changes = mask $ \_ -> -- 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 (Int64, Int64) +getModTime :: FilePath -> IO POSIXTime getModTime f = #ifdef mingw32_HOST_OS - do time <- Dir.getModificationTime f - let !day = fromInteger $ toModifiedJulianDay $ utctDay time - !dayTime = fromInteger $ diffTimeToPicoseconds $ utctDayTime time - pure (day, dayTime) + Dir.getModificationTime f #else - withCString f $ \f' -> - alloca $ \secPtr -> - alloca $ \nsecPtr -> do - Posix.throwErrnoPathIfMinus1Retry_ "getmodtime" f $ c_getModTime f' secPtr nsecPtr - CTime sec <- peek secPtr - CLong nsec <- peek nsecPtr - pure (sec, nsec) - --- Sadly even unix’s getFileStatus + modificationTimeHiRes is still about twice as slow --- as doing the FFI call ourselves :(. -foreign import ccall "getmodtime" c_getModTime :: CString -> Ptr CTime -> Ptr CLong -> IO Int + modificationTimeHiRes <$> getFileStatus f #endif modificationTime :: FileVersion -> Maybe UTCTime -modificationTime VFSVersion{} = Nothing -modificationTime (ModificationTime large small) = Just $ internalTimeToUTCTime large small - -internalTimeToUTCTime :: Int64 -> Int64 -> UTCTime -internalTimeToUTCTime large small = -#ifdef mingw32_HOST_OS - UTCTime (ModifiedJulianDay $ fromIntegral large) (picosecondsToDiffTime $ fromIntegral small) -#else - systemToUTCTime $ MkSystemTime large (fromIntegral small) -#endif +modificationTime VFSVersion{} = Nothing +modificationTime (ModificationTime posix) = Just $ posixSecondsToUTCTime posix getFileContentsRule :: VFSHandle -> Rules () getFileContentsRule vfs = define $ \GetFileContents file -> getFileContentsImpl vfs file @@ -260,8 +241,8 @@ getFileContents f = do liftIO $ case foi of IsFOI Modified{} -> getCurrentTime _ -> do - (large,small) <- getModTime $ fromNormalizedFilePath f - pure $ internalTimeToUTCTime large small + posix <- getModTime $ fromNormalizedFilePath f + pure $ posixSecondsToUTCTime posix return (modTime, txt) fileStoreRules :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules () diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index ff1282abdf..228a063cea 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -21,14 +21,15 @@ import Data.Aeson.Types (Value) import Data.Binary import Data.Hashable import qualified Data.Map as M +import Data.Time.Clock.POSIX import Data.Typeable import Development.IDE.GHC.Compat hiding (HieFileResult) import Development.IDE.GHC.Util +import Development.IDE.Graph import Development.IDE.Import.DependencyInformation import Development.IDE.Types.HscEnvEq (HscEnvEq) import Development.IDE.Types.KnownTargets -import Development.IDE.Graph import GHC.Generics (Generic) import HscTypes (HomeModInfo, @@ -39,7 +40,6 @@ import HscTypes (HomeModInfo, import qualified Data.Binary as B import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LBS -import Data.Int (Int64) import Data.Text (Text) import Data.Time import Development.IDE.Import.FindImports (ArtifactsLocation) @@ -295,9 +295,7 @@ type instance RuleResult GetModificationTime = FileVersion data FileVersion = VFSVersion !Int - | ModificationTime - !Int64 -- ^ Large unit (platform dependent, do not make assumptions) - !Int64 -- ^ Small unit (platform dependent, do not make assumptions) + | ModificationTime !POSIXTime deriving (Show, Generic) instance NFData FileVersion From 9238fd1d7516eb3d420ff439a9a523f26fe40240 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 29 Apr 2021 20:45:56 +0100 Subject: [PATCH 2/4] Fix Windows build --- ghcide/src/Development/IDE/Core/FileStore.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index f341a37207..8b051b9b9b 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -197,7 +197,7 @@ resetFileStore ideState changes = mask $ \_ -> getModTime :: FilePath -> IO POSIXTime getModTime f = #ifdef mingw32_HOST_OS - Dir.getModificationTime f + utcTimeToPOSIXSeconds <$> Dir.getModificationTime f #else modificationTimeHiRes <$> getFileStatus f #endif From d9be4074d4e534a8dbc7d90697172e4e2da602f5 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 29 Apr 2021 20:47:02 +0100 Subject: [PATCH 3/4] redundant imports --- ghcide/src/Development/IDE/Core/FileStore.hs | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 8b051b9b9b..f396c21ccc 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -55,15 +55,7 @@ import System.IO.Error #ifdef mingw32_HOST_OS import qualified System.Directory as Dir #else -import Data.Time.Clock.System (SystemTime (MkSystemTime), - systemToUTCTime) -import Foreign.C.String -import Foreign.C.Types -import Foreign.Marshal (alloca) -import Foreign.Ptr -import Foreign.Storable -import qualified System.Posix.Error as Posix -import System.Posix.Files (getFileStatus, modificationTimeHiRes) +import System.Posix.Files ( getFileStatus, modificationTimeHiRes) #endif import qualified Development.IDE.Types.Logger as L From b717faabbdef6d0e7e9c4e135c137524316e06d1 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 30 Apr 2021 20:15:42 +0100 Subject: [PATCH 4/4] add a test --- ghcide/src/Development/IDE/Core/FileStore.hs | 4 ++-- ghcide/test/exe/Main.hs | 18 ++++++++++++++++++ 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index f396c21ccc..fb780c94b2 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -19,7 +19,8 @@ module Development.IDE.Core.FileStore( resetInterfaceStore, getModificationTimeImpl, addIdeGlobal, - getFileContentsImpl + getFileContentsImpl, + getModTime ) where import Control.Concurrent.STM (atomically) @@ -31,7 +32,6 @@ import Control.Monad.IO.Class import qualified Data.ByteString as BS import Data.Either.Extra import qualified Data.HashMap.Strict as HM -import Data.Int (Int64) import qualified Data.Map.Strict as Map import Data.Maybe import qualified Data.Rope.UTF16 as Rope diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 00916920d9..707ea4e999 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -102,6 +102,9 @@ import Data.IORef.Extra (atomicModifyIORef_) import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide import Text.Regex.TDFA ((=~)) import qualified Progress +import Development.IDE.Core.FileStore (getModTime) +import Control.Concurrent (threadDelay) +import Text.Printf (printf) waitForProgressBegin :: Session () waitForProgressBegin = skipManyTill anyMessage $ satisfyMaybe $ \case @@ -5492,9 +5495,24 @@ unitTests = do actualOrder <- liftIO $ readIORef orderRef liftIO $ actualOrder @?= reverse [(1::Int)..20] + , testCase "timestamps have millisecond resolution" $ do + resolution_us <- findResolution_us 1 + let msg = printf "Timestamps do not have millisecond resolution: %dus" resolution_us + assertBool msg (resolution_us <= 1000) , Progress.tests ] +findResolution_us :: Int -> IO Int +findResolution_us delay_us | delay_us >= 1000000 = error "Unable to compute timestamp resolution" +findResolution_us delay_us = withTempFile $ \f -> withTempFile $ \f' -> do + writeFile f "" + threadDelay delay_us + writeFile f' "" + t <- getModTime f + t' <- getModTime f' + if t /= t' then return delay_us else findResolution_us (delay_us * 10) + + testIde :: IDE.Arguments -> Session () -> IO () testIde arguments session = do config <- getConfigFromEnv