@@ -23,6 +23,7 @@ import Data.ByteString.Base16 (encode)
23
23
import qualified Data.ByteString.Char8 as B
24
24
import Data.Default
25
25
import Data.Either
26
+ import Data.Function
26
27
import qualified Data.HashMap.Strict as HM
27
28
import qualified Data.HashSet as HashSet
28
29
import Data.IORef
@@ -255,16 +256,16 @@ showEvent lock (EventFileDiagnostics (toNormalizedFilePath' -> file) diags) =
255
256
showEvent lock e = withLock lock $ print e
256
257
257
258
258
- cradleToSessionOpts :: Cradle a -> FilePath -> IO ComponentOptions
259
+ cradleToSessionOpts :: Cradle a -> FilePath -> IO ( Either [ CradleError ] ComponentOptions )
259
260
cradleToSessionOpts cradle file = do
260
261
let showLine s = putStrLn (" > " ++ s)
261
262
cradleRes <- runCradle (cradleOptsProg cradle) showLine file
262
263
opts <- case cradleRes of
263
- CradleSuccess r -> pure r
264
- CradleFail err -> throwIO err
265
- -- TODO Rather than failing here, we should ignore any files that use this cradle.
266
- -- That will require some more changes .
267
- CradleNone -> fail " 'none' cradle is not yet supported "
264
+ CradleSuccess r -> pure ( Right r)
265
+ CradleFail err -> return ( Left [ err])
266
+ -- For the None cradle perhaps we still want to report an Info
267
+ -- message about the fact that the file is being ignored .
268
+ CradleNone -> return ( Left [] )
268
269
pure opts
269
270
270
271
emptyHscEnv :: IORef NameCache -> IO HscEnv
@@ -294,7 +295,7 @@ setNameCache nc hsc = hsc { hsc_NC = nc }
294
295
-- This is the key function which implements multi-component support. All
295
296
-- components mapping to the same hie,yaml file are mapped to the same
296
297
-- HscEnv which is updated as new components are discovered.
297
- loadSession :: FilePath -> Action (FilePath -> Action HscEnvEq )
298
+ loadSession :: FilePath -> Action (FilePath -> Action ( IdeResult HscEnvEq ) )
298
299
loadSession dir = do
299
300
nc <- ideNc <$> getShakeExtras
300
301
liftIO $ do
@@ -334,16 +335,21 @@ loadSession dir = do
334
335
-- We will modify the unitId and DynFlags used for
335
336
-- compilation but these are the true source of
336
337
-- information.
337
- new_deps = (thisInstalledUnitId df, df, targets, cfp, dep_info) : maybe [] snd oldDeps
338
+ new_deps = (thisInstalledUnitId df, df, targets, cfp, opts, dep_info) : maybe [] snd oldDeps
338
339
-- Get all the unit-ids for things in this component
339
- inplace = map (\ (a, _, _, _, _) -> a) new_deps
340
+ inplace = map (\ (a, _, _, _, _, _) -> a) new_deps
341
+
342
+ -- Note [Avoiding bad interface files]
343
+ new_deps' <- forM new_deps $ \ (uid, df1, ts, cfp, opts, di) -> do
344
+ -- let (uid, (df1, _target, ts, cfp, opts, di)) = do_one componentInfo
340
345
-- Remove all inplace dependencies from package flags for
341
346
-- components in this HscEnv
342
- rearrange (uid, (df, uids), ts, cfp, di) = (uid, (df, uids, ts, cfp, di))
343
- do_one (uid,df, ts, cfp, di) = rearrange (uid, removeInplacePackages inplace df, ts, cfp, di)
347
+ let (df2, uids) = removeInplacePackages inplace df1
348
+ let prefix = show $ thisInstalledUnitId df1
349
+ df <- setCacheDir prefix (sort $ map show uids) opts df2
344
350
-- All deps, but without any packages which are also loaded
345
351
-- into memory
346
- new_deps' = map do_one new_deps
352
+ pure $ (uid, (df, uids, ts, cfp, opts, di))
347
353
-- Make a new HscEnv, we have to recompile everything from
348
354
-- scratch again (for now)
349
355
-- It's important to keep the same NameCache though for reasons
@@ -371,22 +377,22 @@ loadSession dir = do
371
377
-- TODO Handle the case where there is no hie.yaml
372
378
-- Make a map from unit-id to DynFlags, this is used when trying to
373
379
-- resolve imports.
374
- let uids = map (\ (iuid, (df, _uis, _targets, _cfp, _di)) -> (iuid, df)) (new : old_deps)
380
+ let uids = map (\ (iuid, (df, _uis, _targets, _cfp, _opts, _di)) -> (iuid, df)) (new : old_deps)
375
381
376
382
-- For each component, now make a new HscEnvEq which contains the
377
383
-- HscEnv for the hie.yaml file but the DynFlags for that component
378
384
--
379
385
-- Then look at the targets for each component and create a map
380
386
-- from FilePath to the HscEnv
381
- let new_cache (_iuid, (df, _uis, targets, cfp, di)) = do
387
+ let new_cache (_iuid, (df, _uis, targets, cfp, _opts, di)) = do
382
388
let hscEnv' = hscEnv { hsc_dflags = df
383
389
, hsc_IC = (hsc_IC hscEnv) { ic_dflags = df } }
384
390
385
391
versionMismatch <- checkGhcVersion
386
392
henv <- case versionMismatch of
387
393
Just mismatch -> return mismatch
388
394
Nothing -> newHscEnvEq hscEnv' uids
389
- let res = (henv, di)
395
+ let res = (( [] , Just henv) , di)
390
396
print res
391
397
392
398
let is = importPaths df
@@ -438,10 +444,19 @@ loadSession dir = do
438
444
void $ forkIO $ do
439
445
putStrLn $ " Consulting the cradle for " <> show file
440
446
cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
441
- opts <- cradleToSessionOpts cradle cfp
442
- print opts
443
- (cs, res)<- session (hieYaml, toNormalizedFilePath' cfp, opts)
444
- signalBarrier finished_barrier (cs, fst res)
447
+ eopts <- cradleToSessionOpts cradle cfp
448
+ print eopts
449
+ case eopts of
450
+ Right opts -> do
451
+ (cs, res) <- session (hieYaml, toNormalizedFilePath' cfp, opts)
452
+ signalBarrier finished_barrier (cs, fst res)
453
+ Left err -> do
454
+ dep_info <- getDependencyInfo ([fp | Just fp <- [hieYaml]])
455
+ let ncfp = toNormalizedFilePath' cfp
456
+ let res = (map (renderCradleError ncfp) err, Nothing )
457
+ modifyVar_ fileToFlags $ \ var -> do
458
+ pure $ Map. insertWith HM. union hieYaml (HM. singleton ncfp (res, dep_info)) var
459
+ signalBarrier finished_barrier ([(ncfp, (res, dep_info) )], res)
445
460
waitBarrier finished_barrier
446
461
447
462
dummyAs <- async $ return (error " Uninitialised" )
@@ -477,8 +492,70 @@ loadSession dir = do
477
492
return opts
478
493
479
494
480
-
481
-
495
+ {- Note [Avoiding bad interface files]
496
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
497
+ Originally, we set the cache directory for the various components once
498
+ on the first occurrence of the component.
499
+ This works fine if these components have no references to each other,
500
+ but you have components that depend on each other, the interface files are
501
+ updated for each component.
502
+ After restarting the session and only opening the component that depended
503
+ on the other, suddenly the interface files of this component are stale.
504
+ However, from the point of view of `ghcide`, they do not look stale,
505
+ thus, not regenerated and the IDE shows weird errors such as:
506
+ ```
507
+ typecheckIface
508
+ Declaration for Rep_ClientRunFlags
509
+ Axiom branches Rep_ClientRunFlags:
510
+ Failed to load interface for ‘Distribution.Simple.Flag’
511
+ Use -v to see a list of the files searched for.
512
+ ```
513
+ and
514
+ ```
515
+ expectJust checkFamInstConsistency
516
+ CallStack (from HasCallStack):
517
+ error, called at compiler\\utils\\Maybes.hs:55:27 in ghc:Maybes
518
+ expectJust, called at compiler\\typecheck\\FamInst.hs:461:30 in ghc:FamInst
519
+ ```
520
+
521
+ To mitigate this, we set the cache directory for each component dependent
522
+ on the components of the current `HscEnv`, additionally to the component options
523
+ of the respective components.
524
+ Assume two components, c1, c2, where c2 depends on c1, and the options of the
525
+ respective components are co1, co2.
526
+ If we want to load component c2, followed by c1, we set the cache directory for
527
+ each component in this way:
528
+
529
+ * Load component c2
530
+ * (Cache Directory State)
531
+ - name of c2 + co2
532
+ * Load component c1
533
+ * (Cache Directory State)
534
+ - name of c2 + name of c1 + co2
535
+ - name of c2 + name of c1 + co1
536
+
537
+ Overall, we created three cache directories. If we opened c1 first, then we
538
+ create a fourth cache directory.
539
+ This makes sure that interface files are always correctly updated.
540
+
541
+ Since this causes a lot of recompilation, we only update the cache-directory,
542
+ if the dependencies of a component have really changed.
543
+ E.g. when you load two executables, they can not depend on each other. They
544
+ should be filtered out, such that we dont have to re-compile everything.
545
+ -}
546
+
547
+
548
+ setCacheDir :: MonadIO m => String -> [String ] -> ComponentOptions -> DynFlags -> m DynFlags
549
+ setCacheDir prefix hscComponents comps dflags = do
550
+ cacheDir <- liftIO $ getCacheDir prefix (hscComponents ++ componentOptions comps)
551
+ pure $ dflags
552
+ & setHiDir cacheDir
553
+ & setDefaultHieDir cacheDir
554
+
555
+
556
+ renderCradleError :: NormalizedFilePath -> CradleError -> FileDiagnostic
557
+ renderCradleError nfp (CradleError _ec t) =
558
+ ideErrorText nfp (T. unlines (map T. pack t))
482
559
483
560
484
561
checkDependencyInfo :: Map. Map FilePath (Maybe UTCTime ) -> IO Bool
@@ -534,9 +611,8 @@ memoIO op = do
534
611
return (Map. insert k res mp, res)
535
612
Just res -> return (mp, res)
536
613
537
- setOptions :: GhcMonad m => ComponentOptions -> DynFlags -> m (DynFlags , [Target ])
614
+ setOptions :: GhcMonad m => ComponentOptions -> DynFlags -> m (DynFlags , [Target ])
538
615
setOptions (ComponentOptions theOpts compRoot _) dflags = do
539
- cacheDir <- liftIO $ getCacheDir theOpts
540
616
(dflags_, targets) <- addCmdOpts theOpts dflags
541
617
let dflags' = makeDynFlagsAbsolute compRoot dflags_
542
618
let dflags'' =
@@ -545,8 +621,6 @@ setOptions (ComponentOptions theOpts compRoot _) dflags = do
545
621
-- disabled, generated directly by ghcide instead
546
622
-- also, it can confuse the interface stale check
547
623
dontWriteHieFiles $
548
- setHiDir cacheDir $
549
- setDefaultHieDir cacheDir $
550
624
setIgnoreInterfacePragmas $
551
625
setLinkerOptions $
552
626
disableOptimisation dflags'
@@ -579,12 +653,12 @@ setHiDir f d =
579
653
-- override user settings to avoid conflicts leading to recompilation
580
654
d { hiDir = Just f}
581
655
582
- getCacheDir :: [String ] -> IO FilePath
583
- getCacheDir opts = IO. getXdgDirectory IO. XdgCache (cacheDir </> opts_hash)
656
+ getCacheDir :: String -> [String ] -> IO FilePath
657
+ getCacheDir prefix opts = IO. getXdgDirectory IO. XdgCache (cacheDir </> prefix ++ " - " ++ opts_hash)
584
658
where
585
659
-- Create a unique folder per set of different GHC options, assuming that each different set of
586
660
-- GHC options will create incompatible interface files.
587
- opts_hash = B. unpack $ encode $ H. finalize $ H. updates H. init (map B. pack opts)
661
+ opts_hash = B. unpack $ encode $ H. finalize $ H. updates H. init $ (map B. pack opts)
588
662
589
663
-- Prefix for the cache path
590
664
cacheDir :: String
0 commit comments