Speed up Packages.getTransitiveDeps by caching subcomputations (#409)

This reduces the time needed for a no-op `spago install` on acme-spago from 3.7s to 0.1s (on my machine)
purescript · Sep 19, 2019 · 457c920 · 457c920
1 parent 2feb89c
commit 457c920
Show file tree

Hide file tree

Showing 2 changed files with 37 additions and 29 deletions.
diff --git a/src/Spago/Packages.hs b/src/Spago/Packages.hs
@@ -17,24 +17,25 @@ module Spago.Packages
 
 import           Spago.Prelude
 
-import           Data.Aeson              as Aeson
-import qualified Data.List               as List
-import qualified Data.Map                as Map
-import qualified Data.Set                as Set
-import qualified Data.Text               as Text
-import qualified Data.Text.Lazy          as LT
-import qualified Data.Text.Lazy.Encoding as LT
-
-import           Spago.Config            (Config (..))
-import qualified Spago.Config            as Config
-import qualified Spago.FetchPackage      as Fetch
-import           Spago.GlobalCache       (CacheFlag (..))
-import qualified Spago.Messages          as Messages
-import qualified Spago.PackageSet        as PackageSet
-import qualified Spago.Purs              as Purs
-import qualified Spago.Templates         as Templates
-
-import           Spago.Types             as PackageSet
+import qualified Control.Monad.State.Lazy as State
+import           Data.Aeson               as Aeson
+import qualified Data.List                as List
+import qualified Data.Map                 as Map
+import qualified Data.Set                 as Set
+import qualified Data.Text                as Text
+import qualified Data.Text.Lazy           as LT
+import qualified Data.Text.Lazy.Encoding  as LT
+
+import           Spago.Config             (Config (..))
+import qualified Spago.Config             as Config
+import qualified Spago.FetchPackage       as Fetch
+import           Spago.GlobalCache        (CacheFlag (..))
+import qualified Spago.Messages           as Messages
+import qualified Spago.PackageSet         as PackageSet
+import qualified Spago.Purs               as Purs
+import qualified Spago.Templates          as Templates
+
+import           Spago.Types              as PackageSet
 
 
 -- | Init a new Spago project:
@@ -114,12 +115,10 @@ getProjectDeps Config{..} = getTransitiveDeps packageSet dependencies
 
 
 -- | Return the transitive dependencies of a list of packages
---   Code basically from here:
---   https://github.com/purescript/psc-package/blob/648da70ae9b7ed48216ed03f930c1a6e8e902c0e/app/Main.hs#L227
 getTransitiveDeps :: Spago m => PackageSet -> [PackageName] -> m [(PackageName, Package)]
 getTransitiveDeps PackageSet{..} deps = do
   echoDebug "Getting transitive deps"
-  let (packageMap, notFoundErrors, cycleErrors) = foldMap (go Set.empty Set.empty Set.empty) deps
+  let (packageMap, notFoundErrors, cycleErrors) = State.evalState (fold <$> traverse (go mempty) deps) mempty
 
   handleErrors (Map.toList packageMap) (Set.toList notFoundErrors) (Set.toList cycleErrors)
   where
@@ -130,15 +129,22 @@ getTransitiveDeps PackageSet{..} deps = do
 
     pkgCycleMsg (CycleError pkg) = "  - " <> packageName pkg
 
-    go seen notFoundErrors cycleErrors dep
+    go seen dep
       | dep `Set.member` seen =
-          (packagesDB, notFoundErrors, Set.insert (CycleError dep) cycleErrors)
-      | otherwise = case Map.lookup dep packagesDB of
-          Nothing ->
-            (packagesDB , Set.insert (NotFoundError dep) notFoundErrors, cycleErrors)
-          Just packageInfo@Package{..} -> do
-            let (m, notFoundErrors', cycleErrors') = foldMap (go (Set.insert dep seen) notFoundErrors cycleErrors) dependencies
-            (Map.insert dep packageInfo m, notFoundErrors', cycleErrors')
+          pure (mempty, mempty, Set.singleton $ CycleError dep)
+      | otherwise = do
+          cache <- State.get
+          case Map.lookup dep cache of
+            Just allDeps ->
+              pure (allDeps, mempty, mempty)
+            Nothing | Just packageInfo@Package{..} <- Map.lookup dep packagesDB -> do
+              (childDeps, notFoundErrors, cycleErrors) <- fold <$> traverse (go (Set.insert dep seen)) dependencies
+              let allDeps = Map.insert dep packageInfo childDeps
+              when (null notFoundErrors && null cycleErrors) $ do
+                State.modify $ Map.insert dep allDeps
+              pure (allDeps, notFoundErrors, cycleErrors)
+            Nothing ->
+              pure (mempty, Set.singleton $ NotFoundError dep, mempty)
 
 
 pkgNotFoundMsg :: Map PackageName Package -> NotFoundError PackageName -> Text

diff --git a/src/Spago/Prelude.hs b/src/Spago/Prelude.hs
@@ -19,6 +19,7 @@ module Spago.Prelude
   , Seq (..)
   , IsString
   , Map
+  , Set
   , Generic
   , Alternative
   , Pretty
@@ -105,6 +106,7 @@ import           Data.List.NonEmpty                    (NonEmpty (..))
 import           Data.Map                              (Map)
 import           Data.Maybe                            as X
 import           Data.Sequence                         (Seq (..))
+import           Data.Set                              (Set)
 import           Data.String                           (IsString)
 import           Data.Text.Prettyprint.Doc             (Pretty)
 import qualified Data.Time                             as Time