load modules concurrently purescript#4545

Author: roryc89

src/Language/PureScript/Ide.hs

@@ -43,6 +43,7 @@ import Language.PureScript.Ide.Util (discardAnn, identifierFromIdeDeclaration, n
 import Language.PureScript.Ide.Usage (findUsages)
 import System.Directory (getCurrentDirectory, getDirectoryContents, doesDirectoryExist, doesFileExist)
 import System.FilePath ((</>), normalise)
+import Control.Concurrent.Async.Lifted (mapConcurrently, mapConcurrently_)
 
 -- | Accepts a Command and runs it against psc-ide's State. This is the main
 -- entry point for the server.
@@ -219,16 +220,16 @@ loadModules moduleNames = do
   oDir <- outputDirectory
   let efPaths =
         map (\mn -> oDir </> toS (P.runModuleName mn) </> P.externsFileName) moduleNames
-  efiles <- traverse readExternFile efPaths
-  traverse_ insertExterns efiles
+  efiles <- mapConcurrently readExternFile efPaths
+  mapConcurrently_ insertExterns efiles
 
   -- We parse all source files, log eventual parse failures and insert the
   -- successful parses into the state.
   (failures, allModules) <-
     partitionEithers <$> (parseModulesFromFiles =<< findAllSourceFiles)
   unless (null failures) $
     logWarnN ("Failed to parse: " <> show failures)
-  traverse_ insertModule allModules
+  mapConcurrently_ insertModule allModules
 
   pure (TextResult ("Loaded " <> show (length efiles) <> " modules and "
                     <> show (length allModules) <> " source files."))

src/Language/PureScript/Ide/Types.hs

@@ -18,6 +18,7 @@ import Data.Map.Lazy qualified as M
 import Language.PureScript qualified as P
 import Language.PureScript.Errors.JSON qualified as P
 import Language.PureScript.Ide.Filter.Declaration (DeclarationType(..))
+import Control.Monad.Trans.Control (MonadBaseControl)
 
 type ModuleIdent = Text
 type ModuleMap a = Map P.ModuleName a
@@ -173,7 +174,7 @@ data IdeEnvironment =
   , ideCacheDbTimestamp :: IORef (Maybe UTCTime)
   }
 
-type Ide m = (MonadIO m, MonadReader IdeEnvironment m)
+type Ide m = (MonadIO m, MonadBaseControl IO m, MonadReader IdeEnvironment m)
 
 data IdeState = IdeState
   { ideFileState :: IdeFileState