From b6e8ce4d43022952699e95516b84f7e6caf8b31e Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 9 Jun 2024 19:48:17 +0800 Subject: [PATCH 1/3] wait for database running keys --- hls-graph/src/Development/IDE/Graph/Internal/Types.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs index 8f67b83a9c..5c99702e71 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs @@ -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 @@ -110,6 +111,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 +140,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 From ee0f03733dae7b127333c9623d5a1f1eed33ac56 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 9 Jun 2024 20:02:21 +0800 Subject: [PATCH 2/3] add `waitForDatabaseRunningKeysAction` --- hls-graph/src/Development/IDE/Graph/Internal/Types.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs index 5c99702e71..50b52fd43e 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs @@ -79,6 +79,9 @@ data SAction = SAction { getDatabase :: Action Database getDatabase = Action $ asks actionDatabase +waitForDatabaseRunningKeysAction :: Action () +waitForDatabaseRunningKeysAction = getDatabase >>= liftIO . waitForDatabaseRunningKeys + --------------------------------------------------------------------- -- DATABASE From e239056280fbefee456f7546183dfdd68d0c720d Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 9 Jun 2024 20:03:05 +0800 Subject: [PATCH 3/3] add comments --- hls-graph/src/Development/IDE/Graph/Internal/Types.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs index 50b52fd43e..c70cf6ff1c 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs @@ -79,6 +79,7 @@ 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