@@ -83,7 +83,7 @@ import Control.Concurrent.STM.Stats (atomicallyNamed)
83
83
import Control.Concurrent.Strict
84
84
import Control.DeepSeq
85
85
import Control.Exception.Extra hiding (bracket_ )
86
- import Control.Lens (over , (%~ ) , (& ) , (? ~) )
86
+ import Control.Lens ((& ) , (?~ ) , (% ~) )
87
87
import Control.Monad.Extra
88
88
import Control.Monad.IO.Class
89
89
import Control.Monad.Reader
@@ -121,8 +121,6 @@ import Data.Vector (Vector)
121
121
import qualified Data.Vector as Vector
122
122
import Development.IDE.Core.Debouncer
123
123
import Development.IDE.Core.FileUtils (getModTime )
124
- import Development.IDE.Core.HaskellErrorIndex hiding (Log )
125
- import qualified Development.IDE.Core.HaskellErrorIndex as HaskellErrorIndex
126
124
import Development.IDE.Core.PositionMapping
127
125
import Development.IDE.Core.ProgressReporting
128
126
import Development.IDE.Core.RuleTypes
@@ -198,7 +196,6 @@ data Log
198
196
| LogShakeGarbageCollection ! T. Text ! Int ! Seconds
199
197
-- * OfInterest Log messages
200
198
| LogSetFilesOfInterest ! [(NormalizedFilePath , FileOfInterestStatus )]
201
- | LogInitializeHaskellErrorIndex ! HaskellErrorIndex. Log
202
199
deriving Show
203
200
204
201
instance Pretty Log where
@@ -242,8 +239,6 @@ instance Pretty Log where
242
239
LogSetFilesOfInterest ofInterest ->
243
240
" Set files of interst to" <> Pretty. line
244
241
<> indent 4 (pretty $ fmap (first fromNormalizedFilePath) ofInterest)
245
- LogInitializeHaskellErrorIndex hei ->
246
- " Haskell Error Index:" <+> pretty hei
247
242
248
243
-- | We need to serialize writes to the database, so we send any function that
249
244
-- needs to write to the database over the channel, where it will be picked up by
@@ -339,8 +334,6 @@ data ShakeExtras = ShakeExtras
339
334
-- ^ Queue of restart actions to be run.
340
335
, loaderQueue :: TQueue (IO () )
341
336
-- ^ Queue of loader actions to be run.
342
- , haskellErrorIndex :: Maybe HaskellErrorIndex
343
- -- ^ List of errors in the Haskell Error Index (errors.haskell.org)
344
337
}
345
338
346
339
type WithProgressFunc = forall a .
@@ -711,7 +704,6 @@ shakeOpen recorder lspEnv defaultConfig idePlugins debouncer
711
704
dirtyKeys <- newTVarIO mempty
712
705
-- Take one VFS snapshot at the start
713
706
vfsVar <- newTVarIO =<< vfsSnapshot lspEnv
714
- haskellErrorIndex <- initHaskellErrorIndex (cmapWithPrio LogInitializeHaskellErrorIndex recorder)
715
707
pure ShakeExtras {shakeRecorder = recorder, .. }
716
708
shakeDb <-
717
709
shakeNewDatabase
@@ -1332,25 +1324,24 @@ traceA (A Failed{}) = "Failed"
1332
1324
traceA (A Stale {}) = " Stale"
1333
1325
traceA (A Succeeded {}) = " Success"
1334
1326
1335
- updateFileDiagnostics
1336
- :: Recorder (WithPriority Log )
1327
+ updateFileDiagnostics :: MonadIO m
1328
+ => Recorder (WithPriority Log )
1337
1329
-> NormalizedFilePath
1338
1330
-> Maybe Int32
1339
1331
-> Key
1340
1332
-> ShakeExtras
1341
1333
-> [FileDiagnostic ] -- ^ current results
1342
- -> Action ()
1334
+ -> m ()
1343
1335
updateFileDiagnostics recorder fp ver k ShakeExtras {diagnostics, hiddenDiagnostics, publishedDiagnostics, debouncer, lspEnv, ideTesting} current0 = do
1344
- hei <- haskellErrorIndex <$> getShakeExtras
1345
1336
liftIO $ withTrace (" update diagnostics " <> fromString(fromNormalizedFilePath fp)) $ \ addTag -> do
1346
1337
addTag " key" (show k)
1347
- current <- traverse (attachHEI hei) $ map (over fdLspDiagnosticL diagsFromRule) current0
1348
1338
let (currentShown, currentHidden) = partition ((== ShowDiag ) . fdShouldShowDiagnostic) current
1349
1339
uri = filePathToUri' fp
1350
1340
addTagUnsafe :: String -> String -> String -> a -> a
1351
1341
addTagUnsafe msg t x v = unsafePerformIO(addTag (msg <> t) x) `seq` v
1352
1342
update :: (forall a . String -> String -> a -> a ) -> [FileDiagnostic ] -> STMDiagnosticStore -> STM [FileDiagnostic ]
1353
1343
update addTagUnsafeMethod new store = addTagUnsafeMethod " count" (show $ Prelude. length new) $ setStageDiagnostics addTagUnsafeMethod uri ver (renderKey k) new store
1344
+ current = map (fdLspDiagnosticL %~ diagsFromRule) current0
1354
1345
addTag " version" (show ver)
1355
1346
mask_ $ do
1356
1347
-- Mask async exceptions to ensure that updated diagnostics are always
@@ -1374,15 +1365,6 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti
1374
1365
LSP. PublishDiagnosticsParams (fromNormalizedUri uri') (fmap fromIntegral ver) (map fdLspDiagnostic newDiags)
1375
1366
return action
1376
1367
where
1377
- attachHEI :: Maybe HaskellErrorIndex -> FileDiagnostic -> IO FileDiagnostic
1378
- attachHEI mbHei diag
1379
- | Just hei <- mbHei
1380
- , SomeStructuredMessage msg <- fdStructuredMessage diag
1381
- , Just heiError <- hei `heiGetError` errMsgDiagnostic msg
1382
- = pure $ diag & fdLspDiagnosticL %~ attachHeiErrorCodeDescription heiError
1383
- | otherwise
1384
- = pure diag
1385
-
1386
1368
diagsFromRule :: Diagnostic -> Diagnostic
1387
1369
diagsFromRule c@ Diagnostic {_range}
1388
1370
| coerce ideTesting = c & L. relatedInformation ?~
0 commit comments