@@ -11,20 +11,22 @@
1111module Development.IDE.Core.Service(
1212 getIdeOptions,
1313 IdeState, initialise, shutdown,
14− runAction, runActions,
15− runActionSync, runActionsSync,
14+ runAction,
15+ runActionSync,
1616 writeProfile,
1717 getDiagnostics, unsafeClearDiagnostics,
1818 ideLogger
1919 ) where
2020
2121import Control.Concurrent.Extra
22+import Control.Concurrent.Async
2223import Control.Monad.Except
2324import Development.IDE.Types.Options (IdeOptions(..))
2425import Development.IDE.Core.FileStore
2526import Development.IDE.Core.OfInterest
2627import Development.IDE.Types.Logger
2728import Development.Shake hiding (Diagnostic, Env, newCache)
29+import Data.Either.Extra
2830import qualified Language.Haskell.LSP.Messages as LSP
2931
3032import Development.IDE.Core.Shake
@@ -68,32 +70,27 @@ setProfiling opts shakeOpts =
6870shutdown :: IdeState -> IO ()
6971shutdown = shakeShut
7072
71−-- | Run a single action using the supplied service. See `runActions`
72−-- for more details.
73−runAction :: IdeState -> Action a -> IO a
74−runAction service action = head <$> runActions service [action]
75−
76−-- | Run a list of actions in parallel using the supplied service.
77−-- This will return as soon as the results of the actions are
73+-- This will return as soon as the result of the action is
7874-- available. There might still be other rules running at this point,
7975-- e.g., the ofInterestRule.
80−runActions :: IdeState -> [Action a] -> IO [a]
81−runActions x acts = do
82− var <- newBarrier
83− _ <- shakeRun x acts (signalBarrier var)
84− waitBarrier var
85−
86−-- | This is a synchronous variant of `runAction`. See
87−-- `runActionsSync` of more details.
88−runActionSync :: IdeState -> Action a -> IO a
89−runActionSync s a = head <$> runActionsSync s [a]
90−
91−-- | `runActionsSync` is similar to `runActions` but it will
76+runAction :: IdeState -> Action a -> IO a
77+runAction ide action = do
78+ bar <- newBarrier
79+ res <- shakeRun ide [do v <- action; liftIO $ signalBarrier bar v; return v]
80+ -- shakeRun might throw an exception (either through action or a default rule),
81+ -- in which case action may not complete successfully, and signalBarrier might not be called.
82+ -- Therefore we wait for either res (which propagates the exception) or the barrier.
83+ -- Importantly, if the barrier does finish, cancelling res only kills waiting for the result,
84+ -- it doesn't kill the actual work
85+ fmap fromEither $ race (head <$> res) $ waitBarrier bar
86+
87+
88+-- | `runActionSync` is similar to `runAction` but it will
9289-- wait for all rules (so in particular the `ofInterestRule`) to
9390-- finish running. This is mainly useful in tests, where you want
9491-- to wait for all rules to fire so you can check diagnostics.
95−runActionsSync :: IdeState -> [Action a] -> IO [a]
96−runActionsSync s acts = join $ shakeRun s acts (const $ pure ())
92+runActionSync :: IdeState -> Action a -> IO a
93+runActionSync s act = fmap head $ join $ shakeRun s [act]
9794
9895getIdeOptions :: Action IdeOptions
9996getIdeOptions = do