use modification time rule

Author: soulomoon

ghcide/session-loader/Development/IDE/Session.hs

@@ -109,6 +109,7 @@ import           Data.HashMap.Strict                  (HashMap)
 import           Data.HashSet                         (HashSet)
 import qualified Data.HashSet                         as Set
 import           Database.SQLite.Simple
+import           Development.IDE                      (Rules, getFileExists)
 import           Development.IDE.Core.Tracing         (withTrace)
 import           Development.IDE.Session.Diagnostics  (renderCradleError)
 import           Development.IDE.Types.Shake          (Key, WithHieDb,
@@ -128,7 +129,6 @@ import qualified Data.Set                             as OS
 import qualified Development.IDE.GHC.Compat.Util      as Compat
 import           GHC.Data.Graph.Directed
 
-import           Development.IDE                      (Rules, getFileExists)
 import           GHC.Data.Bag
 import           GHC.Driver.Env                       (hsc_all_home_unit_ids)
 import           GHC.Driver.Errors.Types
@@ -541,7 +541,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do
           hscEnv <- liftIO $ emptyHscEnv ideNc _libDir
           all_target_details <- liftIO $ newComponentCache recorder optExtensions hieYaml _cfp hscEnv old_deps new_deps rootDir
 
-          this_dep_info <- liftIO $ getDependencyInfo $ maybeToList hieYaml
+          this_dep_info <- getDependencyInfo $ maybeToList hieYaml
           -- this should be added to deps
           let (all_targets, this_flags_map, this_options)
                 = case HM.lookup _cfp flags_map' of
@@ -579,7 +579,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do
           hscEnv <- liftIO $ emptyHscEnv ideNc libDir
           newTargetDfs <- liftIO $ evalGhcEnv hscEnv $ setOptions cfp opts (hsc_dflags hscEnv) rootDir
           let deps = componentDependencies opts ++ maybeToList hieYaml
-          dep_info <- liftIO $ getDependencyInfo deps
+          dep_info <- getDependencyInfo deps
           -- Now lookup to see whether we are combining with an existing HscEnv
           -- or making a new one. The lookup returns the HscEnv and a list of
           -- information about other components loaded into the HscEnv
@@ -716,7 +716,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do
                         session (hieYaml, cfp, opts, libDir)
               -- Failure case, either a cradle error or the none cradle
               Left err -> do
-                dep_info <- liftIO $ getDependencyInfo (maybeToList hieYaml)
+                dep_info <- getDependencyInfo (maybeToList hieYaml)
                 let res = (map (\err' -> renderCradleError err' cradle cfp) err, Nothing)
                 liftIO $ atomically $ modifyTVar' fileToFlags $
                     Map.insertWith HM.union hieYaml (HM.singleton cfp (res, dep_info))
@@ -741,7 +741,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do
                       Just (opts, old_di) -> do
                             -- need to differ two kinds of invocation, one is the file is changed
                             -- other is the cache version bumped
-                            deps_ok <- liftIO $ checkDependencyInfo old_di
+                            deps_ok <- checkDependencyInfo old_di
                             if not deps_ok
                               then do
                                 logWith recorder Debug $ LogClearingCache file
@@ -750,15 +750,14 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do
                               else return $ Just (opts, Map.keys old_di, [], [])
                       Nothing -> return Nothing
           --   install cache version check to get notified when the cache is changed
-          -- todo but some how it is informing other, then other inform us, causing a loop
+          v <- useNoFile_ SessionCacheVersion
+          logWith recorder Debug $ LogCacheVersion file v
+
           case someThing of
             Just result@(_, deps, _files, _keys) -> do
                 mapM_ addDependency deps
                 return $ Just result
             Nothing -> do
-                v <- useNoFile_ SessionCacheVersion
-                logWith recorder Debug $ LogCacheVersion file v
-
                 catchError file hieYaml $ do
                     result@(_, deps, files, keys) <- consultCradle file
                     -- add the deps to the Shake graph
@@ -1128,7 +1127,7 @@ setCacheDirs recorder CacheDirs{..} dflags = do
 -- we can then make a rule to build each entry in the map
 
 -- See Note [Multi Cradle Dependency Info]
-type DependencyInfo = Map.Map FilePath (Maybe UTCTime)
+type DependencyInfo = Map.Map FilePath FileVersion
 type HieMap = Map.Map (Maybe FilePath) [RawComponentInfo]
 -- | Maps a "hie.yaml" location to all its Target Filepaths and options.
 type FlagsMap = Map.Map (Maybe FilePath) (HM.HashMap NormalizedFilePath (IdeResult HscEnvEq, DependencyInfo))
@@ -1187,7 +1186,7 @@ data ComponentInfo = ComponentInfo
 
 -- | Check if any dependency has been modified lately.
 --  it depend on the last result
-checkDependencyInfo :: DependencyInfo -> IO Bool
+checkDependencyInfo :: DependencyInfo -> Action Bool
 checkDependencyInfo old_di = do
   di <- getDependencyInfo (Map.keys old_di)
   return (di == old_di)
@@ -1202,15 +1201,17 @@ checkDependencyInfo old_di = do
 -- | Computes a mapping from a filepath to its latest modification date.
 -- See Note [Multi Cradle Dependency Info] why we do this ourselves instead
 -- of letting shake take care of it.
-getDependencyInfo :: [FilePath] -> IO DependencyInfo
+getDependencyInfo :: [FilePath] -> Action DependencyInfo
 getDependencyInfo fs = Map.fromList <$> mapM do_one fs
-
   where
-    safeTryIO :: IO a -> IO (Either IOException a)
-    safeTryIO = Safe.try
-
-    do_one :: FilePath -> IO (FilePath, Maybe UTCTime)
-    do_one fp = (fp,) . eitherToMaybe <$> safeTryIO (getModificationTime fp)
+    -- safeTryIO :: Action a -> Action (Either IOException a)
+    -- safeTryIO = Safe.try
+
+    do_one :: FilePath -> Action (FilePath, FileVersion)
+    do_one fpp =  do
+        let fp = toNormalizedFilePath' fpp
+        fv <- use_ GetModificationTime fp
+        return (fromNormalizedFilePath fp, fv)
 
 -- | This function removes all the -package flags which refer to packages we
 -- are going to deal with ourselves. For example, if a executable depends