Skip to content

Commit 26aa9be

Browse files
soulomoonsoulomoon
committed
hls-graph: simplify AIO; scoped cancellation; fewer threads; safe cleanup
- Replace ad-hoc AIO with structured concurrency (TVar + async registry); builder returns results directly; remove lazy splitIO/unsafePerformIO - Reduce redundant thread creation; use per-key builderOne and STM retry instead of spawning; fewer races - Add AsyncParentKill (ThreadId, Step) and treat it as async; use cancelWith from Shake to scope cancellation to the current session - Mask critical sections and do uninterruptible cleanup on exception (mark Dirty) to avoid stuck Running and hangs - Adjust types/wiring (Running payload, runAIO takes Step, compute/refresh signatures); minor tweaks in ghcide Shake/Plugin.Test Fixes haskell#4718
1 parent 1263b9f commit 26aa9be

File tree

6 files changed

+129
-175
lines changed

6 files changed

+129
-175
lines changed

‎ghcide/src/Development/IDE/Core/Shake.hs‎

Lines changed: 10 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -94,7 +94,6 @@ import Data.Aeson (Result (Success),
9494
toJSON)
9595
import qualified Data.Aeson.Types as A
9696
import qualified Data.ByteString.Char8 as BS
97-
import qualified Data.ByteString.Char8 as BS8
9897
import Data.Coerce (coerce)
9998
import Data.Default
10099
import Data.Dynamic
@@ -107,8 +106,7 @@ import Data.Hashable
107106
import qualified Data.HashMap.Strict as HMap
108107
import Data.HashSet (HashSet)
109108
import qualified Data.HashSet as HSet
110-
import Data.List.Extra (foldl', partition,
111-
takeEnd)
109+
import Data.List.Extra (partition, takeEnd)
112110
import qualified Data.Map.Strict as Map
113111
import Data.Maybe
114112
import qualified Data.SortedList as SL
@@ -130,15 +128,11 @@ import Development.IDE.Types.Options as Options
130128
import qualified Language.LSP.Protocol.Message as LSP
131129
import qualified Language.LSP.Server as LSP
132130

133-
import Control.Concurrent (threadDelay)
134-
import Control.Concurrent.Extra (readVar)
135-
import Control.Monad (forever)
136131
import Data.HashMap.Strict (HashMap)
137132
import qualified Data.HashMap.Strict as HashMap
138133
import Data.Int (Int64)
139134
import Data.IORef.Extra (atomicModifyIORef'_,
140135
readIORef)
141-
import Data.Text.Encoding (encodeUtf8)
142136
import Development.IDE.Core.Tracing
143137
import Development.IDE.Core.WorkerThread
144138
import Development.IDE.GHC.Compat (NameCache,
@@ -149,18 +143,16 @@ import Development.IDE.GHC.Orphans ()
149143
import Development.IDE.Graph hiding (ShakeValue,
150144
action)
151145
import qualified Development.IDE.Graph as Shake
152-
import Development.IDE.Graph.Database (ShakeDatabase,
146+
import Development.IDE.Graph.Database (AsyncParentKill (..),
147+
ShakeDatabase,
153148
shakeGetBuildStep,
154149
shakeGetDatabaseKeys,
155150
shakeNewDatabase,
156151
shakeProfileDatabase,
157152
shakeRunDatabaseForKeys)
158-
import Development.IDE.Graph.Internal.Database (garbageCollectKeys,
159-
garbageCollectKeys1)
160-
import Development.IDE.Graph.Internal.Types (Database)
153+
import Development.IDE.Graph.Internal.Database (garbageCollectKeys1)
161154
import Development.IDE.Graph.Rule
162155
import Development.IDE.Types.Action
163-
import Development.IDE.Types.Action (isActionQueueEmpty)
164156
import Development.IDE.Types.Diagnostics
165157
import Development.IDE.Types.Exports hiding (exportsMapSize)
166158
import qualified Development.IDE.Types.Exports as ExportsMap
@@ -169,7 +161,6 @@ import Development.IDE.Types.Location
169161
import Development.IDE.Types.Monitoring (Monitoring (..))
170162
import Development.IDE.Types.Shake
171163
import qualified Focus
172-
import GHC.Base (undefined)
173164
import GHC.Fingerprint
174165
import GHC.Stack (HasCallStack)
175166
import GHC.TypeLits (KnownSymbol)
@@ -179,7 +170,6 @@ import qualified Ide.Logger as Logger
179170
import Ide.Plugin.Config
180171
import qualified Ide.PluginUtils as HLS
181172
import Ide.Types
182-
import Ide.Types (CheckParents (CheckOnSave))
183173
import qualified Language.LSP.Protocol.Lens as L
184174
import Language.LSP.Protocol.Message
185175
import Language.LSP.Protocol.Types
@@ -948,7 +938,8 @@ newSession recorder extras@ShakeExtras{..} vfsMod shakeDb acts reason newDirtyKe
948938
$ \db -> do
949939
GarbageCollectVar var <- getIdeGlobalExtras extras
950940
-- checkParentsOpt <- optCheckParents =<< getIdeOptionsIO extras
951-
isGarbageCollectionScheduled <- readVar var
941+
-- isGarbageCollectionScheduled <- readVar var
942+
let isGarbageCollectionScheduled = False
952943
when (isActionQueueEmpty && isGarbageCollectionScheduled) $ do
953944
-- reset garbage collection flag
954945
liftIO $ writeVar var False
@@ -989,8 +980,11 @@ newSession recorder extras@ShakeExtras{..} vfsMod shakeDb acts reason newDirtyKe
989980

990981
-- Cancelling is required to flush the Shake database when either
991982
-- the filesystem or the Ghc configuration have changed
983+
step <- shakeGetBuildStep shakeDb
992984
let cancelShakeSession :: IO ()
993-
cancelShakeSession = cancel workThread
985+
cancelShakeSession = do
986+
tid <- myThreadId
987+
cancelWith workThread $ AsyncParentKill tid step
994988

995989
pure (ShakeSession{..})
996990

‎ghcide/src/Development/IDE/Plugin/Test.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ import Development.IDE.Graph.Database (ShakeDatabase,
3939
shakeGetBuildStep,
4040
shakeGetCleanKeys)
4141
import Development.IDE.Graph.Internal.Types (Result (resultBuilt, resultChanged, resultVisited),
42-
Step (Step))
42+
Step)
4343
import qualified Development.IDE.Graph.Internal.Types as Graph
4444
import Development.IDE.Types.Action
4545
import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))
@@ -140,7 +140,7 @@ getDatabaseKeys :: (Graph.Result -> Step)
140140
getDatabaseKeys field db = do
141141
keys <- shakeGetCleanKeys db
142142
step <- shakeGetBuildStep db
143-
return [ k | (k, res) <- keys, field res == Step step]
143+
return [ k | (k, res) <- keys, field res == step]
144144

145145
parseAction :: CI String -> NormalizedFilePath -> Action (Either Text Bool)
146146
parseAction "typecheck" fp = Right . isJust <$> use TypeCheck fp

‎hls-graph/src/Development/IDE/Graph/Database.hs‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
module Development.IDE.Graph.Database(
2+
AsyncParentKill(..),
23
ShakeDatabase,
34
ShakeValue,
45
shakeNewDatabase,
@@ -8,8 +9,8 @@ module Development.IDE.Graph.Database(
89
shakeGetBuildStep,
910
shakeGetDatabaseKeys,
1011
shakeGetDirtySet,
11-
shakeGetCleanKeys
12-
,shakeGetBuildEdges) where
12+
shakeGetCleanKeys,
13+
shakeGetBuildEdges) where
1314
import Control.Concurrent.STM.Stats (readTVarIO)
1415
import Data.Dynamic
1516
import Data.Maybe
@@ -42,9 +43,9 @@ shakeGetDirtySet (ShakeDatabase _ _ db) =
4243
Development.IDE.Graph.Internal.Database.getDirtySet db
4344

4445
-- | Returns the build number
45-
shakeGetBuildStep :: ShakeDatabase -> IO Int
46+
shakeGetBuildStep :: ShakeDatabase -> IO Step
4647
shakeGetBuildStep (ShakeDatabase _ _ db) = do
47-
Step s <- readTVarIO $ databaseStep db
48+
s <- readTVarIO $ databaseStep db
4849
return s
4950

5051
-- Only valid if we never pull on the results, which we don't

‎hls-graph/src/Development/IDE/Graph/Internal/Action.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -81,8 +81,10 @@ actionFork act k = do
8181

8282
isAsyncException :: SomeException -> Bool
8383
isAsyncException e
84+
| Just (_ :: SomeAsyncException) <- fromException e = True
8485
| Just (_ :: AsyncCancelled) <- fromException e = True
8586
| Just (_ :: AsyncException) <- fromException e = True
87+
| Just (_ :: AsyncParentKill) <- fromException e = True
8688
| Just (_ :: ExitCode) <- fromException e = True
8789
| otherwise = False
8890

0 commit comments

Comments
 (0)