ebbe980 · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Make runActions return Return as soon as results are available (#1736)

ebbe980Moritz Kiefer7 years ago

src/Development/IDE/State/FileStore.hs+1−1

compare with master

unifiedsplit

@@ -161,7 +161,7 @@ setBufferModified state absFile mbContents = do

161 case mbContents of

162 Nothing -> removeVirtualFile (filePathToUri' absFile)

163 Just contents -> setVirtualFileContents (filePathToUri' absFile) contents

164− void $ shakeRun state []

164+ void $ shakeRun state [] (const $ pure ())

165

166

167-- would be nice to do this more efficiently...

src/Development/IDE/State/Service.hs+23−4

@@ -13,6 +13,7 @@ module Development.IDE.State.Service(

13 getServiceEnv,

14 IdeState, initialise, shutdown,

15 runAction, runActions,

16+ runActionSync, runActionsSync,

16 setFilesOfInterest, modifyFilesOfInterest,

17 setFilesOfInterest, modifyFilesOfInterest,

17 writeProfile,

18 writeProfile,

18 getDiagnostics, unsafeClearDiagnostics,

19 getDiagnostics, unsafeClearDiagnostics,

@@ -100,14 +101,32 @@ setProfiling opts shakeOpts =

100shutdown :: IdeState -> IO ()

101shutdown :: IdeState -> IO ()

101shutdown = shakeShut

102shutdown = shakeShut

102

103

103−-- | Run a single action using the supplied service.

104+-- | Run a single action using the supplied service. See `runActions`

105+-- for more details.

104runAction :: IdeState -> Action a -> IO a

106runAction :: IdeState -> Action a -> IO a

105runAction service action = head <$> runActions service [action]

107runAction service action = head <$> runActions service [action]

106

108

107-- | Run a list of actions in parallel using the supplied service.

109-- | Run a list of actions in parallel using the supplied service.

110+-- This will return as soon as the results of the actions are

111+-- available. There might still be other rules running at this point,

112+-- e.g., the ofInterestRule.

108runActions :: IdeState -> [Action a] -> IO [a]

113runActions :: IdeState -> [Action a] -> IO [a]

109−runActions x = join . shakeRun x

114+runActions x acts = do

110−

115+ var <- newBarrier

116+ _ <- shakeRun x acts (signalBarrier var)

117+ waitBarrier var

118+

119+-- | This is a synchronous variant of `runAction`. See

120+-- `runActionsSync` of more details.

121+runActionSync :: IdeState -> Action a -> IO a

122+runActionSync s a = head <$> runActionsSync s [a]

123+

124+-- | `runActionsSync` is similar to `runActions` but it will

125+-- wait for all rules (so in particular the `ofInterestRule`) to

126+-- finish running. This is mainly useful in tests, where you want

127+-- to wait for all rules to fire so you can check diagnostics.

128+runActionsSync :: IdeState -> [Action a] -> IO [a]

129+runActionsSync s acts = join $ shakeRun s acts (const $ pure ())

111

130

112-- | Set the files-of-interest which will be built and kept-up-to-date.

131-- | Set the files-of-interest which will be built and kept-up-to-date.

113setFilesOfInterest :: IdeState -> Set NormalizedFilePath -> IO ()

132setFilesOfInterest :: IdeState -> Set NormalizedFilePath -> IO ()

@@ -118,7 +137,7 @@ modifyFilesOfInterest state f = do

118 Env{..} <- getIdeGlobalState state

137 Env{..} <- getIdeGlobalState state

119 files <- modifyVar envOfInterestVar $ pure . dupe . f

138 files <- modifyVar envOfInterestVar $ pure . dupe . f

120 logDebug state $ "Set files of interest to: " <> T.pack (show $ Set.toList files)

139 logDebug state $ "Set files of interest to: " <> T.pack (show $ Set.toList files)

121− void $ shakeRun state []

140+ void $ shakeRun state [] (const $ pure ())

122

141

123getServiceEnv :: Action Env

142getServiceEnv :: Action Env

124getServiceEnv = getIdeGlobalAction

143getServiceEnv = getIdeGlobalAction

src/Development/IDE/State/Shake.hs+17−6

@@ -52,7 +52,7 @@ import qualified Data.HashMap.Strict as Map

52import qualified Data.ByteString.Char8 as BS

53import Data.Dynamic

54import Data.Maybe

55−import Data.Either

55+import Data.Either.Extra

56import Data.List.Extra

57import qualified Data.Text as T

58import Development.IDE.Logger as Logger

@@ -232,20 +232,31 @@ shakeProfile :: IdeState -> FilePath -> IO ()

232shakeProfile IdeState{..} = shakeProfileDatabase shakeDb

233

234shakeShut :: IdeState -> IO ()

235+shakeShut IdeState{..} = withVar shakeAbort $ \stop -> do

236+ -- Shake gets unhappy if you try to close when there is a running

237+ -- request so we first abort that.

238+ stop

235−shakeShut = shakeClose

239+ shakeClose

236

240

237-- | Spawn immediately, add an action to collect the results syncronously.

241-- | Spawn immediately, add an action to collect the results syncronously.

238-- If you are already inside a call to shakeRun that will be aborted with an exception.

242-- If you are already inside a call to shakeRun that will be aborted with an exception.

243+-- The callback will be fired as soon as the results are available

244+-- even if there are still other rules running while the IO action that is

245+-- being returned will wait for all rules to finish.

239−shakeRun :: IdeState -> [Action a] -> IO (IO [a])

246+shakeRun :: IdeState -> [Action a] -> ([a] -> IO ()) -> IO (IO [a])

240-- FIXME: If there is already a shakeRun queued up and waiting to send me a kill, I should probably

247-- FIXME: If there is already a shakeRun queued up and waiting to send me a kill, I should probably

241-- not even start, which would make issues with async exceptions less problematic.

248-- not even start, which would make issues with async exceptions less problematic.

242−shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts = modifyVar shakeAbort $ \stop -> do

249+shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts callback = modifyVar shakeAbort $ \stop -> do

243 (stopTime,_) <- duration stop

250 (stopTime,_) <- duration stop

244 Logger.logDebug logger $ T.pack $ "Starting shakeRun (aborting the previous one took " ++ showDuration stopTime ++ ")"

251 Logger.logDebug logger $ T.pack $ "Starting shakeRun (aborting the previous one took " ++ showDuration stopTime ++ ")"

245 bar <- newBarrier

252 bar <- newBarrier

246 start <- offsetTime

253 start <- offsetTime

254+ let act = do

255+ res <- parallel acts

256+ liftIO $ callback res

257+ pure res

247− thread <- forkFinally (shakeRunDatabaseProfile shakeDb acts) $ \res -> do

258+ thread <- forkFinally (shakeRunDatabaseProfile shakeDb [act]) $ \res -> do

248− signalBarrier bar res

259+ signalBarrier bar (mapRight head res)

249 runTime <- start

260 runTime <- start

250 Logger.logDebug logger $ T.pack $

261 Logger.logDebug logger $ T.pack $

251 "Finishing shakeRun (took " ++ showDuration runTime ++ ", " ++ (if isLeft res then "exception" else "completed") ++ ")"

262 "Finishing shakeRun (took " ++ showDuration runTime ++ ", " ++ (if isLeft res then "exception" else "completed") ++ ")"