Skip to content

Commit 50ee7fa

Browse files
pepeiborrapepeiborra
authored
Replace the unsafe getmodtime with safe posix calls (#1778)
* 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 * Fix Windows build * redundant imports * add a test
1 parent 52b1293 commit 50ee7fa

File tree

4 files changed

+34
-47
lines changed

4 files changed

+34
-47
lines changed

‎ghcide/ghcide.cabal

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -108,8 +108,6 @@ library
108108
else
109109
build-depends:
110110
unix
111-
c-sources:
112-
cbits/getmodtime.c
113111

114112
default-extensions:
115113
ApplicativeDo

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

Lines changed: 13 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,8 @@ module Development.IDE.Core.FileStore(
1919
resetInterfaceStore,
2020
getModificationTimeImpl,
2121
addIdeGlobal,
22-
getFileContentsImpl
22+
getFileContentsImpl,
23+
getModTime
2324
) where
2425

2526
import Control.Concurrent.STM (atomically)
@@ -31,37 +32,30 @@ import Control.Monad.IO.Class
3132
import qualified Data.ByteString as BS
3233
import Data.Either.Extra
3334
import qualified Data.HashMap.Strict as HM
34-
import Data.Int (Int64)
3535
import qualified Data.Map.Strict as Map
3636
import Data.Maybe
3737
import qualified Data.Rope.UTF16 as Rope
3838
import qualified Data.Text as T
3939
import Data.Time
40+
import Data.Time.Clock.POSIX
4041
import Development.IDE.Core.OfInterest (OfInterestVar (..),
4142
getFilesOfInterest)
4243
import Development.IDE.Core.RuleTypes
4344
import Development.IDE.Core.Shake
4445
import Development.IDE.GHC.Orphans ()
46+
import Development.IDE.Graph
4547
import Development.IDE.Import.DependencyInformation
4648
import Development.IDE.Types.Diagnostics
4749
import Development.IDE.Types.Location
4850
import Development.IDE.Types.Options
49-
import Development.IDE.Graph
5051
import HieDb.Create (deleteMissingRealFiles)
5152
import Ide.Plugin.Config (CheckParents (..))
5253
import System.IO.Error
5354

5455
#ifdef mingw32_HOST_OS
5556
import qualified System.Directory as Dir
5657
#else
57-
import Data.Time.Clock.System (SystemTime (MkSystemTime),
58-
systemToUTCTime)
59-
import Foreign.C.String
60-
import Foreign.C.Types
61-
import Foreign.Marshal (alloca)
62-
import Foreign.Ptr
63-
import Foreign.Storable
64-
import qualified System.Posix.Error as Posix
58+
import System.Posix.Files ( getFileStatus, modificationTimeHiRes)
6559
#endif
6660

6761
import qualified Development.IDE.Types.Logger as L
@@ -126,7 +120,7 @@ getModificationTimeImpl :: VFSHandle
126120
(Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
127121
getModificationTimeImpl vfs isWatched missingFileDiags file = do
128122
let file' = fromNormalizedFilePath file
129-
let wrap time@(l,s) = (Just $ LBS.toStrict $ B.encode time, ([], Just $ ModificationTime l s))
123+
let wrap time = (Just $ LBS.toStrict $ B.encode $ toRational time, ([], Just $ ModificationTime time))
130124
mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file
131125
case mbVirtual of
132126
Just (virtualFileVersion -> ver) -> do
@@ -192,38 +186,17 @@ resetFileStore ideState changes = mask $ \_ ->
192186
-- We might also want to try speeding this up on Windows at some point.
193187
-- TODO leverage DidChangeWatchedFile lsp notifications on clients that
194188
-- support them, as done for GetFileExists
195-
getModTime :: FilePath -> IO (Int64, Int64)
189+
getModTime :: FilePath -> IO POSIXTime
196190
getModTime f =
197191
#ifdef mingw32_HOST_OS
198-
do time <- Dir.getModificationTime f
199-
let !day = fromInteger $ toModifiedJulianDay $ utctDay time
200-
!dayTime = fromInteger $ diffTimeToPicoseconds $ utctDayTime time
201-
pure (day, dayTime)
192+
utcTimeToPOSIXSeconds <$> Dir.getModificationTime f
202193
#else
203-
withCString f $ \f' ->
204-
alloca $ \secPtr ->
205-
alloca $ \nsecPtr -> do
206-
Posix.throwErrnoPathIfMinus1Retry_ "getmodtime" f $ c_getModTime f' secPtr nsecPtr
207-
CTime sec <- peek secPtr
208-
CLong nsec <- peek nsecPtr
209-
pure (sec, nsec)
210-
211-
-- Sadly even unix’s getFileStatus + modificationTimeHiRes is still about twice as slow
212-
-- as doing the FFI call ourselves :(.
213-
foreign import ccall "getmodtime" c_getModTime :: CString -> Ptr CTime -> Ptr CLong -> IO Int
194+
modificationTimeHiRes <$> getFileStatus f
214195
#endif
215196

216197
modificationTime :: FileVersion -> Maybe UTCTime
217-
modificationTime VFSVersion{} = Nothing
218-
modificationTime (ModificationTime large small) = Just $ internalTimeToUTCTime large small
219-
220-
internalTimeToUTCTime :: Int64 -> Int64 -> UTCTime
221-
internalTimeToUTCTime large small =
222-
#ifdef mingw32_HOST_OS
223-
UTCTime (ModifiedJulianDay $ fromIntegral large) (picosecondsToDiffTime $ fromIntegral small)
224-
#else
225-
systemToUTCTime $ MkSystemTime large (fromIntegral small)
226-
#endif
198+
modificationTime VFSVersion{} = Nothing
199+
modificationTime (ModificationTime posix) = Just $ posixSecondsToUTCTime posix
227200

228201
getFileContentsRule :: VFSHandle -> Rules ()
229202
getFileContentsRule vfs = define $ \GetFileContents file -> getFileContentsImpl vfs file
@@ -260,8 +233,8 @@ getFileContents f = do
260233
liftIO $ case foi of
261234
IsFOI Modified{} -> getCurrentTime
262235
_ -> do
263-
(large,small) <- getModTime $ fromNormalizedFilePath f
264-
pure $ internalTimeToUTCTime large small
236+
posix <- getModTime $ fromNormalizedFilePath f
237+
pure $ posixSecondsToUTCTime posix
265238
return (modTime, txt)
266239

267240
fileStoreRules :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules ()

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

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -21,14 +21,15 @@ import Data.Aeson.Types (Value)
2121
import Data.Binary
2222
import Data.Hashable
2323
import qualified Data.Map as M
24+
import Data.Time.Clock.POSIX
2425
import Data.Typeable
2526
import Development.IDE.GHC.Compat hiding
2627
(HieFileResult)
2728
import Development.IDE.GHC.Util
29+
import Development.IDE.Graph
2830
import Development.IDE.Import.DependencyInformation
2931
import Development.IDE.Types.HscEnvEq (HscEnvEq)
3032
import Development.IDE.Types.KnownTargets
31-
import Development.IDE.Graph
3233
import GHC.Generics (Generic)
3334

3435
import HscTypes (HomeModInfo,
@@ -39,7 +40,6 @@ import HscTypes (HomeModInfo,
3940
import qualified Data.Binary as B
4041
import Data.ByteString (ByteString)
4142
import qualified Data.ByteString.Lazy as LBS
42-
import Data.Int (Int64)
4343
import Data.Text (Text)
4444
import Data.Time
4545
import Development.IDE.Import.FindImports (ArtifactsLocation)
@@ -295,9 +295,7 @@ type instance RuleResult GetModificationTime = FileVersion
295295

296296
data FileVersion
297297
= VFSVersion !Int
298-
| ModificationTime
299-
!Int64 -- ^ Large unit (platform dependent, do not make assumptions)
300-
!Int64 -- ^ Small unit (platform dependent, do not make assumptions)
298+
| ModificationTime !POSIXTime
301299
deriving (Show, Generic)
302300

303301
instance NFData FileVersion

‎ghcide/test/exe/Main.hs

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -102,6 +102,9 @@ import Data.IORef.Extra (atomicModifyIORef_)
102102
import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
103103
import Text.Regex.TDFA ((=~))
104104
import qualified Progress
105+
import Development.IDE.Core.FileStore (getModTime)
106+
import Control.Concurrent (threadDelay)
107+
import Text.Printf (printf)
105108

106109
waitForProgressBegin :: Session ()
107110
waitForProgressBegin = skipManyTill anyMessage $ satisfyMaybe $ \case
@@ -5492,9 +5495,24 @@ unitTests = do
54925495
actualOrder <- liftIO $ readIORef orderRef
54935496

54945497
liftIO $ actualOrder @?= reverse [(1::Int)..20]
5498+
, testCase "timestamps have millisecond resolution" $ do
5499+
resolution_us <- findResolution_us 1
5500+
let msg = printf "Timestamps do not have millisecond resolution: %dus" resolution_us
5501+
assertBool msg (resolution_us <= 1000)
54955502
, Progress.tests
54965503
]
54975504

5505+
findResolution_us :: Int -> IO Int
5506+
findResolution_us delay_us | delay_us >= 1000000 = error "Unable to compute timestamp resolution"
5507+
findResolution_us delay_us = withTempFile $ \f -> withTempFile $ \f' -> do
5508+
writeFile f ""
5509+
threadDelay delay_us
5510+
writeFile f' ""
5511+
t <- getModTime f
5512+
t' <- getModTime f'
5513+
if t /= t' then return delay_us else findResolution_us (delay_us * 10)
5514+
5515+
54985516
testIde :: IDE.Arguments -> Session () -> IO ()
54995517
testIde arguments session = do
55005518
config <- getConfigFromEnv

0 commit comments

Comments
 (0)