use the type check modsummary

haskell · Jul 3, 2024 · 3747ae5 · 3747ae5
1 parent f0ba40b
commit 3747ae5
Show file tree

Hide file tree

Showing 3 changed files with 15 additions and 2 deletions.
diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs
@@ -125,6 +125,7 @@ import           GHC.Driver.Errors.Types
 import           GHC.Types.Error                     (errMsgDiagnostic,
                                                       singleMessage)
 import           GHC.Unit.State
+import Debug.Trace (traceM)
 
 data Log
   = LogSettingInitialDynFlags
@@ -530,7 +531,10 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
                   -- See Note [Avoiding bad interface files]
                   let hscComponents = sort $ map show uids
                       cacheDirOpts = hscComponents ++ componentOptions opts
+                  let opts_hash = B.unpack $ B16.encode $ H.finalize $ H.updates H.init (map B.pack cacheDirOpts)
+                  traceM $ "Setting cache dirs for " ++ show rawComponentUnitId ++ " " ++ opts_hash ++ " " ++ show cacheDirOpts
                   cacheDirs <- liftIO $ getCacheDirs prefix cacheDirOpts
+
                   processed_df <- setCacheDirs recorder cacheDirs df2
                   -- The final component information, mostly the same but the DynFlags don't
                   -- contain any packages which are also loaded

diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs
@@ -126,6 +126,7 @@ import           GHC.Driver.Config.CoreToStg.Prep
 #if MIN_VERSION_ghc(9,7,0)
 import           Data.Foldable                          (toList)
 import           GHC.Unit.Module.Warnings
+import Development.IDE.Core.WorkerThread (awaitRunInThread)
 #else
 import           Development.IDE.Core.FileStore         (shareFilePath)
 #endif
@@ -196,6 +197,7 @@ typecheckModule (IdeDefer defer) hsc tc_helpers pm = do
     where
         demoteIfDefer = if defer then demoteTypeErrorsToWarnings else id
 
+
 -- | Install hooks to capture the splices as well as the runtime module dependencies
 captureSplicesAndDeps :: TypecheckHelpers -> HscEnv -> (HscEnv -> IO a) -> IO (a, Splices, ModuleEnv BS.ByteString)
 captureSplicesAndDeps TypecheckHelpers{..} env k = do
@@ -432,6 +434,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do
   let session = hscSetFlags (ms_hspp_opts ms) session'
       ms = pm_mod_summary $ tmrParsed tcm
 
+  traceM $ "[TRACE] Generating hi file for " ++ show (moduleName $ ms_mod ms)
   (details, guts) <- do
         -- write core file
         -- give variables unique OccNames
@@ -724,11 +727,13 @@ addRelativeImport fp modu dflags = dflags
 -- | Also resets the interface store
 atomicFileWrite :: ShakeExtras -> FilePath -> (FilePath -> IO a) -> IO a
 atomicFileWrite se targetPath write = do
+  -- awaitRunInThread (restartQueue se) $ do
+  traceM $ "[TRACE] Writing file: " <> targetPath
   let dir = takeDirectory targetPath
   createDirectoryIfMissing True dir
   (tempFilePath, cleanUp) <- newTempFileWithin dir
   (write tempFilePath >>= \x -> renameFile tempFilePath targetPath >> atomically (resetInterfaceStore se (toNormalizedFilePath' targetPath)) >> pure x)
-    `onException` cleanUp
+    `onException` (cleanUp >> throwIO (userError "atomicFileWrite: write failed"))
 
 generateHieAsts :: HscEnv -> TcModuleResult -> IO ([FileDiagnostic], Maybe (HieASTs Type))
 generateHieAsts hscEnv tcm =

diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs
@@ -169,6 +169,7 @@ import           System.Info.Extra                            (isWindows)
 
 import qualified Data.IntMap                                  as IM
 import           GHC.Fingerprint
+import Debug.Trace (traceM)
 
 
 data Log
@@ -1039,10 +1040,13 @@ usePropertyByPathAction path plId p = do
 getLinkableRule :: Recorder (WithPriority Log) -> Rules ()
 getLinkableRule recorder =
   defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetLinkable f -> do
-    ModSummaryResult{msrModSummary = ms} <- use_ GetModSummary f
+    -- ModSummaryResult{msrModSummary = ms} <- use_ GetModSummary f
+    tmr <- use_ TypeCheck f
+    let ms = tmrModSummary tmr
     HiFileResult{hirModIface, hirModDetails, hirCoreFp} <- use_ GetModIface f
     let obj_file  = ml_obj_file (ms_location ms)
         core_file = ml_core_file (ms_location ms)
+    traceM $ "GetLinkable core_file " ++ show core_file
     case hirCoreFp of
       Nothing -> error $ "called GetLinkable for a file without a linkable: " ++ show f
       Just (bin_core, fileHash) -> do