From 92fb93e31b3f908ac3f5c8e47ee4d83b8118bd12 Mon Sep 17 00:00:00 2001 From: Rory Campbell Date: Thu, 1 Aug 2024 14:46:23 +0200 Subject: [PATCH 1/2] load modules concurrently #4545 --- src/Language/PureScript/Ide.hs | 7 ++++--- src/Language/PureScript/Ide/Types.hs | 3 ++- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/Language/PureScript/Ide.hs b/src/Language/PureScript/Ide.hs index 57601c3d45..42d3b5062c 100644 --- a/src/Language/PureScript/Ide.hs +++ b/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,8 +220,8 @@ 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. @@ -228,7 +229,7 @@ loadModules moduleNames = do 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.")) diff --git a/src/Language/PureScript/Ide/Types.hs b/src/Language/PureScript/Ide/Types.hs index 5fa304166b..5c5c555af2 100644 --- a/src/Language/PureScript/Ide/Types.hs +++ b/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 From 6fb43a4cea2bbcdcda66a8772e2655df4967cf55 Mon Sep 17 00:00:00 2001 From: Rory Campbell Date: Thu, 1 Aug 2024 15:26:31 +0200 Subject: [PATCH 2/2] read ide files concurrently --- src/Language/PureScript/Ide/SourceFile.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Language/PureScript/Ide/SourceFile.hs b/src/Language/PureScript/Ide/SourceFile.hs index ea49fd6a55..b74f7a1b4b 100644 --- a/src/Language/PureScript/Ide/SourceFile.hs +++ b/src/Language/PureScript/Ide/SourceFile.hs @@ -29,6 +29,8 @@ import Language.PureScript.CST qualified as CST import Language.PureScript.Ide.Error (IdeError) import Language.PureScript.Ide.Types (DefinitionSites, IdeNamespace(..), IdeNamespaced(..), TypeAnnotations) import Language.PureScript.Ide.Util (ideReadFile) +import Control.Concurrent.Async.Lifted (mapConcurrently) +import Control.Monad.Trans.Control (MonadBaseControl) parseModule :: FilePath -> Text -> Either FilePath (FilePath, P.Module) parseModule path file = @@ -37,11 +39,11 @@ parseModule path file = Right m -> Right (path, m) parseModulesFromFiles - :: (MonadIO m, MonadError IdeError m) + :: (MonadIO m, MonadBaseControl IO m, MonadError IdeError m) => [FilePath] -> m [Either FilePath (FilePath, P.Module)] parseModulesFromFiles paths = do - files <- traverse ideReadFile paths + files <- mapConcurrently ideReadFile paths pure (inParallel (map (uncurry parseModule) files)) where inParallel :: [Either e (k, a)] -> [Either e (k, a)]