66module Development.IDE.Graph.Internal.Types where
77
88import Control.Concurrent.STM (STM )
9+ import Control.Monad ((>=>) )
910import Control.Monad.Catch
1011import Control.Monad.IO.Class
1112import Control.Monad.Trans.Reader
@@ -78,6 +79,10 @@ data SAction = SAction {
7879getDatabase :: Action Database
7980getDatabase = 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+
113121getDatabaseValues :: Database -> IO [(Key , Status )]
114122getDatabaseValues = atomically
115123 . (fmap . fmap ) (second keyStatus)
@@ -136,6 +144,10 @@ getResult (Clean re) = Just re
136144getResult (Dirty m_re) = m_re
137145getResult (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+
139151data Result = Result {
140152 resultValue :: ! Value ,
141153 resultBuilt :: ! Step , -- ^ the step when it was last recomputed
0 commit comments