Replace the unsafe getmodtime with safe posix calls (haskell#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

ghcide/ghcide.cabal

@@ -108,8 +108,6 @@ library
     else
       build-depends:
         unix
-      c-sources:
-        cbits/getmodtime.c
 
     default-extensions:
         ApplicativeDo

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,37 +32,30 @@ 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
 
 #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 ()

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

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