Move getDiagnostics to STM

Author: pepeiborra

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

@@ -757,13 +757,13 @@ instantiateDelayedAction (DelayedAction _ s p a) = do
       d' = DelayedAction (Just u) s p a'
   return (b, d')
 
-getDiagnostics :: IdeState -> IO [FileDiagnostic]
+getDiagnostics :: IdeState -> STM [FileDiagnostic]
 getDiagnostics IdeState{shakeExtras = ShakeExtras{diagnostics}} = do
-    atomically $ getAllDiagnostics diagnostics
+    getAllDiagnostics diagnostics
 
-getHiddenDiagnostics :: IdeState -> IO [FileDiagnostic]
+getHiddenDiagnostics :: IdeState -> STM [FileDiagnostic]
 getHiddenDiagnostics IdeState{shakeExtras = ShakeExtras{hiddenDiagnostics}} = do
-    atomically $ getAllDiagnostics hiddenDiagnostics
+    getAllDiagnostics hiddenDiagnostics
 
 -- | Find and release old keys from the state Hashmap
 --   For the record, there are other state sources that this process does not release:

ghcide/src/Development/IDE/Plugin/CodeAction.hs

@@ -21,6 +21,7 @@ module Development.IDE.Plugin.CodeAction
 import           Control.Applicative                               ((<|>))
 import           Control.Arrow                                     (second,
                                                                     (>>>))
+import           Control.Concurrent.STM.Stats                      (atomically)
 import           Control.Monad                                     (guard, join)
 import           Control.Monad.IO.Class
 import           Data.Char
@@ -90,7 +91,7 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range Cod
   liftIO $ do
     let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
         mbFile = toNormalizedFilePath' <$> uriToFilePath uri
-    diag <- fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state
+    diag <- atomically $ fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state
     (join -> parsedModule) <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModule `traverse` mbFile
     let
       actions = caRemoveRedundantImports parsedModule text diag xs uri

ghcide/src/Development/IDE/Plugin/TypeLenses.hs

@@ -12,6 +12,7 @@ module Development.IDE.Plugin.TypeLenses (
   GlobalBindingTypeSigsResult (..),
 ) where
 
+import           Control.Concurrent.STM.Stats        (atomically)
 import           Control.DeepSeq                     (rwhnf)
 import           Control.Monad                       (mzero)
 import           Control.Monad.Extra                 (whenMaybe)
@@ -100,8 +101,8 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif
       bindings <- runAction "codeLens.GetBindings" ideState (use GetBindings filePath)
       gblSigs <- runAction "codeLens.GetGlobalBindingTypeSigs" ideState (use GetGlobalBindingTypeSigs filePath)
 
-      diag <- getDiagnostics ideState
-      hDiag <- getHiddenDiagnostics ideState
+      diag <- atomically $ getDiagnostics ideState
+      hDiag <- atomically $ getHiddenDiagnostics ideState
 
       let toWorkSpaceEdit tedit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing
           generateLensForGlobal sig@GlobalBindingTypeSig{..} = do