4301 we need to implement utility to wait for all runnning keys in hls graph done (#4302)

* wait for database running keys

* add `waitForDatabaseRunningKeysAction`

* add comments
This commit is contained in:
soulomoon 2024-06-09 21:49:14 +08:00 committed by GitHub
parent efe89133b1
commit e9c2f55201
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194

View File

@ -6,6 +6,7 @@
module Development.IDE.Graph.Internal.Types where
import Control.Concurrent.STM (STM)
import Control.Monad ((>=>))
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
@ -78,6 +79,10 @@ data SAction = SAction {
getDatabase :: Action Database
getDatabase = Action $ asks actionDatabase
-- | waitForDatabaseRunningKeysAction waits for all keys in the database to finish running.
waitForDatabaseRunningKeysAction :: Action ()
waitForDatabaseRunningKeysAction = getDatabase >>= liftIO . waitForDatabaseRunningKeys
---------------------------------------------------------------------
-- DATABASE
@ -110,6 +115,9 @@ data Database = Database {
databaseValues :: !(Map Key KeyDetails)
}
waitForDatabaseRunningKeys :: Database -> IO ()
waitForDatabaseRunningKeys = getDatabaseValues >=> mapM_ (waitRunning . snd)
getDatabaseValues :: Database -> IO [(Key, Status)]
getDatabaseValues = atomically
. (fmap.fmap) (second keyStatus)
@ -136,6 +144,10 @@ getResult (Clean re) = Just re
getResult (Dirty m_re) = m_re
getResult (Running _ _ _ m_re) = m_re -- watch out: this returns the previous result
waitRunning :: Status -> IO ()
waitRunning Running{..} = runningWait
waitRunning _ = return ()
data Result = Result {
resultValue :: !Value,
resultBuilt :: !Step, -- ^ the step when it was last recomputed