Skip to content

Commit 0a7f639

Browse files
committed
Adapt to mpickering latest, wip/propogate
At 489370672e7117e6c79e47b2ab4b31d0e7fe412d
1 parent 1f9ac76 commit 0a7f639

File tree

2 files changed

+29
-17
lines changed

2 files changed

+29
-17
lines changed

exe/Main.hs

Lines changed: 28 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -407,7 +407,7 @@ loadSession dir = liftIO $ do
407407
modifyVar_ fileToFlags $ \var -> do
408408
pure $ Map.insert hieYaml (HM.fromList (cs ++ cached_targets)) var
409409

410-
return res
410+
return (cs, res)
411411

412412
lock <- newLock
413413

@@ -431,7 +431,7 @@ loadSession dir = liftIO $ do
431431
case HM.lookup (toNormalizedFilePath' cfp) v of
432432
Just opts -> do
433433
--putStrLn $ "Cached component of " <> show file
434-
pure (fst opts)
434+
pure ([], fst opts)
435435
Nothing-> do
436436
finished_barrier <- newBarrier
437437
-- fork a new thread here which won't be killed by shake
@@ -441,8 +441,8 @@ loadSession dir = liftIO $ do
441441
cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
442442
opts <- cradleToSessionOpts cradle cfp
443443
print opts
444-
res <- fst <$> session (hieYaml, toNormalizedFilePath' cfp, opts)
445-
signalBarrier finished_barrier res
444+
(cs, res)<- session (hieYaml, toNormalizedFilePath' cfp, opts)
445+
signalBarrier finished_barrier (cs, fst res)
446446
waitBarrier finished_barrier
447447

448448
dummyAs <- async $ return (error "Uninitialised")
@@ -453,18 +453,30 @@ loadSession dir = liftIO $ do
453453
hieYaml <- cradleLoc file
454454
sessionOpts (hieYaml, file)
455455
-- The lock is on the `runningCradle` resource
456-
return $ \file -> liftIO $ withLock lock $ do
457-
as <- readIORef runningCradle
458-
finished <- poll as
459-
case finished of
460-
Just {} -> do
461-
as <- async $ getOptions file
462-
writeIORef runningCradle as
463-
wait as
464-
-- If it's not finished then wait and then get options, this could of course be killed still
465-
Nothing -> do
466-
_ <- wait as
467-
getOptions file
456+
return $ \file -> do
457+
(cs, opts) <-
458+
liftIO $ withLock lock $ do
459+
as <- readIORef runningCradle
460+
finished <- poll as
461+
case finished of
462+
Just {} -> do
463+
as <- async $ getOptions file
464+
writeIORef runningCradle as
465+
wait as
466+
-- If it's not finished then wait and then get options, this could of course be killed still
467+
Nothing -> do
468+
_ <- wait as
469+
getOptions file
470+
let cfps = map fst cs
471+
-- Delayed to avoid recursion and only run if something changed.
472+
unless (null cs) (
473+
delay "InitialLoad" $ void $ do
474+
cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) cfps
475+
mmt <- uses GetModificationTime cfps'
476+
let cs_exist = catMaybes (zipWith (<$) cfps' mmt)
477+
uses GetModIface cs_exist)
478+
return opts
479+
468480

469481

470482

0 commit comments

Comments
 (0)