Skip to content

Commit e9c2f55

Browse files
authored
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
1 parent efe8913 commit e9c2f55

File tree

1 file changed

+12
-0
lines changed
  • hls-graph/src/Development/IDE/Graph/Internal

1 file changed

+12
-0
lines changed

hls-graph/src/Development/IDE/Graph/Internal/Types.hs

+12
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@
66
module Development.IDE.Graph.Internal.Types where
77

88
import Control.Concurrent.STM (STM)
9+
import Control.Monad ((>=>))
910
import Control.Monad.Catch
1011
import Control.Monad.IO.Class
1112
import Control.Monad.Trans.Reader
@@ -78,6 +79,10 @@ data SAction = SAction {
7879
getDatabase :: Action Database
7980
getDatabase = Action $ asks actionDatabase
8081

82+
-- | waitForDatabaseRunningKeysAction waits for all keys in the database to finish running.
83+
waitForDatabaseRunningKeysAction :: Action ()
84+
waitForDatabaseRunningKeysAction = getDatabase >>= liftIO . waitForDatabaseRunningKeys
85+
8186
---------------------------------------------------------------------
8287
-- DATABASE
8388

@@ -110,6 +115,9 @@ data Database = Database {
110115
databaseValues :: !(Map Key KeyDetails)
111116
}
112117

118+
waitForDatabaseRunningKeys :: Database -> IO ()
119+
waitForDatabaseRunningKeys = getDatabaseValues >=> mapM_ (waitRunning . snd)
120+
113121
getDatabaseValues :: Database -> IO [(Key, Status)]
114122
getDatabaseValues = atomically
115123
. (fmap.fmap) (second keyStatus)
@@ -136,6 +144,10 @@ getResult (Clean re) = Just re
136144
getResult (Dirty m_re) = m_re
137145
getResult (Running _ _ _ m_re) = m_re -- watch out: this returns the previous result
138146

147+
waitRunning :: Status -> IO ()
148+
waitRunning Running{..} = runningWait
149+
waitRunning _ = return ()
150+
139151
data Result = Result {
140152
resultValue :: !Value,
141153
resultBuilt :: !Step, -- ^ the step when it was last recomputed

0 commit comments

Comments
 (0)