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..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,22 +32,22 @@ 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 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 @@ -54,14 +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) #endif import qualified Development.IDE.Types.Logger as L @@ -126,7 +120,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 +186,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) + utcTimeToPOSIXSeconds <$> 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 +233,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 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