@@ -216,7 +216,7 @@ type IdeRule k v =
216216-- mappings from @(FilePath, k)@ to @RuleResult k@.
217217data IdeState = IdeState
218218 {shakeDb :: ShakeDatabase
219− ,shakeAbort :: Var (IO ()) -- close whoever was running last
219+ ,shakeAbort :: MVar (IO ()) -- close whoever was running last
220220 ,shakeClose :: IO ()
221221 ,shakeExtras :: ShakeExtras
222222 ,shakeProfileDir :: Maybe FilePath
@@ -298,7 +298,7 @@ shakeOpen eventer logger shakeProfileDir (IdeReportProgress reportProgress) opts
298298 , shakeProgress = if reportProgress then lspShakeProgress eventer else const (pure ())
299299 }
300300 rules
301− shakeAbort <- newVar $ return ()
301+ shakeAbort <- newMVar $ return ()
302302 shakeDb <- shakeDb
303303 return IdeState{..}
304304
@@ -336,31 +336,47 @@ shakeProfile :: IdeState -> FilePath -> IO ()
336336shakeProfile IdeState{..} = shakeProfileDatabase shakeDb
337337
338338shakeShut :: IdeState -> IO ()
339−shakeShut IdeState{..} = withVar shakeAbort $ \stop -> do
339+shakeShut IdeState{..} = withMVar shakeAbort $ \stop -> do
340340 -- Shake gets unhappy if you try to close when there is a running
341341 -- request so we first abort that.
342342 stop
343343 shakeClose
344344
345+-- | This is a variant of withMVar where the first argument is run unmasked and if it throws
346+-- an exception, the previous value is restored while the second argument is executed masked.
347+withMVar' :: MVar a -> (a -> IO b) -> (b -> IO (a, c)) -> IO c
348+withMVar' var unmasked masked = mask $ \restore -> do
349+ a <- takeMVar var
350+ b <- restore (unmasked a) `onException` putMVar var a
351+ (a', c) <- masked b
352+ putMVar var a'
353+ pure c
354+
345355-- | Spawn immediately. If you are already inside a call to shakeRun that will be aborted with an exception.
346356shakeRun :: IdeState -> [Action a] -> IO (IO [a])
347−-- FIXME: If there is already a shakeRun queued up and waiting to send me a kill, I should probably
348−-- not even start, which would make issues with async exceptions less problematic.
349−shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts = modifyVar shakeAbort $ \stop -> do
350− (stopTime,_) <- duration stop
351− logDebug logger $ T.pack $ "Starting shakeRun (aborting the previous one took " ++ showDuration stopTime ++ ")"
352− bar <- newBarrier
353− start <- offsetTime
354− thread <- forkFinally (shakeRunDatabaseProfile shakeProfileDir shakeDb acts) $ \res -> do
355− runTime <- start
356− let res' = case res of
357− Left e -> "exception: " <> displayException e
358− Right _ -> "completed"
359− logDebug logger $ T.pack $
360− "Finishing shakeRun (took " ++ showDuration runTime ++ ", " ++ res' ++ ")"
361− signalBarrier bar res
362− -- important: we send an async exception to the thread, then wait for it to die, before continuing
363− return (do killThread thread; void $ waitBarrier bar, either throwIO return =<< waitBarrier bar)
357+shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts =
358+ withMVar'
359+ shakeAbort
360+ (\stop -> do
361+ (stopTime,_) <- duration stop
362+ logDebug logger $ T.pack $ "Starting shakeRun (aborting the previous one took " ++ showDuration stopTime ++ ")"
363+ bar <- newBarrier
364+ start <- offsetTime
365+ pure (start, bar))
366+ -- It is crucial to be masked here, otherwise we can get killed
367+ -- between spawning the new thread and updating shakeAbort.
368+ -- See https://github.com/digital-asset/ghcide/issues/79
369+ (\(start, bar) -> do
370+ thread <- forkFinally (shakeRunDatabaseProfile shakeProfileDir shakeDb acts) $ \res -> do
371+ runTime <- start
372+ let res' = case res of
373+ Left e -> "exception: " <> displayException e
374+ Right _ -> "completed"
375+ logDebug logger $ T.pack $
376+ "Finishing shakeRun (took " ++ showDuration runTime ++ ", " ++ res' ++ ")"
377+ signalBarrier bar res
378+ -- important: we send an async exception to the thread, then wait for it to die, before continuing
379+ pure (killThread thread >> void (waitBarrier bar), either throwIO return =<< waitBarrier bar))
364380
365381getDiagnostics :: IdeState -> IO [FileDiagnostic]
366382getDiagnostics IdeState{shakeExtras = ShakeExtras{diagnostics}} = do