Join nested IO actions of the form IO (IO ()) (#2459)

* Join nested IO actions of the form `IO (IO ())`

* Disable ApplicativeDo Language Extension

Co-authored-by: Javier Neira <[email protected]>
Co-authored-by: Pepe Iborra <[email protected]>

Author: 3 people

ghcide/ghcide.cabal

@@ -117,7 +117,6 @@ library
         unix
 
     default-extensions:
-        ApplicativeDo
         BangPatterns
         DeriveFunctor
         DeriveGeneric

ghcide/session-loader/Development/IDE/Session.hs

@@ -245,9 +245,10 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
   return $ do
     extras@ShakeExtras{logger, restartShakeSession, ideNc, knownTargetsVar, lspEnv
                       } <- getShakeExtras
-    let invalidateShakeCache = do
+    let invalidateShakeCache :: IO ()
+        invalidateShakeCache = do
             void $ modifyVar' version succ
-            atomically $ recordDirtyKeys extras GhcSessionIO [emptyFilePath]
+            join $ atomically $ recordDirtyKeys extras GhcSessionIO [emptyFilePath]
 
     IdeOptions{ optTesting = IdeTesting optTesting
               , optCheckProject = getCheckProject
@@ -264,7 +265,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
               TargetModule _ -> do
                 found <- filterM (IO.doesFileExist . fromNormalizedFilePath) targetLocations
                 return (targetTarget, found)
-          atomically $ recordDirtyKeys extras GetKnownTargets  [emptyFilePath]
+          join $ atomically $ recordDirtyKeys extras GetKnownTargets  [emptyFilePath]
           modifyVarIO' knownTargetsVar $ traverseHashed $ \known -> do
             let known' = HM.unionWith (<>) known $ HM.fromList $ map (second Set.fromList) knownTargets
             when (known /= known') $

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

@@ -1,4 +1,3 @@
-{-# LANGUAGE NoApplicativeDo #-}
 {-# LANGUAGE TypeFamilies    #-}
 module Development.IDE.Core.Actions
 ( getAtPoint

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

@@ -263,7 +263,7 @@ setFileModified state saved nfp = do
     VFSHandle{..} <- getIdeGlobalState state
     when (isJust setVirtualFileContents) $
         fail "setFileModified can't be called on this type of VFSHandle"
-    atomically $ recordDirtyKeys (shakeExtras state) GetModificationTime [nfp]
+    join $ atomically $ recordDirtyKeys (shakeExtras state) GetModificationTime [nfp]
     restartShakeSession (shakeExtras state) (fromNormalizedFilePath nfp ++ " (modified)") []
     when checkParents $
       typecheckParents state nfp

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

@@ -526,7 +526,7 @@ shakeOpen lspEnv defaultConfig logger debouncer
         _ <- async $ do
             logDebug logger "Initializing exports map from hiedb"
             em <- createExportsMapHieDb hiedb
-            modifyVar' exportsMap (<> em)
+            _ <- modifyVar' exportsMap (<> em)
             logDebug logger $ "Done initializing exports map from hiedb (" <> pack(show (ExportsMap.size em)) <> ")"
 
         progress <- do

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

@@ -1,5 +1,4 @@
 {-# LANGUAGE CPP             #-}
-{-# LANGUAGE NoApplicativeDo #-}
 {-# LANGUAGE PackageImports  #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# HLINT ignore #-}