6
6
module Development.IDE.Graph.Internal.Types where
7
7
8
8
import Control.Concurrent.STM (STM )
9
+ import Control.Monad ((>=>) )
9
10
import Control.Monad.Catch
10
11
import Control.Monad.IO.Class
11
12
import Control.Monad.Trans.Reader
@@ -78,6 +79,10 @@ data SAction = SAction {
78
79
getDatabase :: Action Database
79
80
getDatabase = Action $ asks actionDatabase
80
81
82
+ -- | waitForDatabaseRunningKeysAction waits for all keys in the database to finish running.
83
+ waitForDatabaseRunningKeysAction :: Action ()
84
+ waitForDatabaseRunningKeysAction = getDatabase >>= liftIO . waitForDatabaseRunningKeys
85
+
81
86
---------------------------------------------------------------------
82
87
-- DATABASE
83
88
@@ -110,6 +115,9 @@ data Database = Database {
110
115
databaseValues :: ! (Map Key KeyDetails )
111
116
}
112
117
118
+ waitForDatabaseRunningKeys :: Database -> IO ()
119
+ waitForDatabaseRunningKeys = getDatabaseValues >=> mapM_ (waitRunning . snd )
120
+
113
121
getDatabaseValues :: Database -> IO [(Key , Status )]
114
122
getDatabaseValues = atomically
115
123
. (fmap . fmap ) (second keyStatus)
@@ -136,6 +144,10 @@ getResult (Clean re) = Just re
136
144
getResult (Dirty m_re) = m_re
137
145
getResult (Running _ _ _ m_re) = m_re -- watch out: this returns the previous result
138
146
147
+ waitRunning :: Status -> IO ()
148
+ waitRunning Running {.. } = runningWait
149
+ waitRunning _ = return ()
150
+
139
151
data Result = Result {
140
152
resultValue :: ! Value ,
141
153
resultBuilt :: ! Step , -- ^ the step when it was last recomputed
0 commit comments