Build workspace packages in top-sorted order

bin/src/Main.purs

@@ -476,7 +476,7 @@ main =
           Install args@{ packages, selectedPackage, ensureRanges, testDeps } -> do
             { env, fetchOpts } <- mkFetchEnv { packages, selectedPackage, ensureRanges, testDeps }
             -- TODO: --no-fetch flag
-            dependencies <- runSpago env (Fetch.run fetchOpts)
+            dependencyInfo <- runSpago env (Fetch.run fetchOpts)
             let
               buildArgs = Record.merge
                 args
@@ -488,20 +488,20 @@ main =
                 , strict: Nothing :: Maybe Boolean
                 , persistWarnings: Nothing :: Maybe Boolean
                 }
-            env' <- runSpago env (mkBuildEnv buildArgs dependencies)
+            env' <- runSpago env (mkBuildEnv buildArgs dependencyInfo)
             let options = { depsOnly: true, pursArgs: List.toUnfoldable args.pursArgs, jsonErrors: false }
             runSpago env' (Build.run options)
           Build args@{ selectedPackage, ensureRanges, jsonErrors } -> do
             { env, fetchOpts } <- mkFetchEnv { packages: mempty, selectedPackage, ensureRanges, testDeps: false }
             -- TODO: --no-fetch flag
-            dependencies <- runSpago env (Fetch.run fetchOpts)
-            buildEnv <- runSpago env (mkBuildEnv args dependencies)
+            dependencyInfo <- runSpago env (Fetch.run fetchOpts)
+            buildEnv <- runSpago env (mkBuildEnv args dependencyInfo)
             let options = { depsOnly: false, pursArgs: List.toUnfoldable args.pursArgs, jsonErrors }
             runSpago buildEnv (Build.run options)
           Publish { selectedPackage } -> do
             { env, fetchOpts } <- mkFetchEnv { packages: mempty, selectedPackage, ensureRanges: false, testDeps: false }
             -- TODO: --no-fetch flag
-            dependencies <- runSpago env (Fetch.run fetchOpts)
+            dependencyInfo <- runSpago env (Fetch.run fetchOpts)
             let
               buildArgs =
                 { selectedPackage
@@ -519,8 +519,8 @@ main =
                 , strict: Nothing :: Maybe Boolean
                 , persistWarnings: Nothing :: Maybe Boolean
                 }
-            { purs } <- runSpago env (mkBuildEnv buildArgs dependencies)
-            publishEnv <- runSpago env (mkPublishEnv dependencies purs)
+            { purs } <- runSpago env (mkBuildEnv buildArgs dependencyInfo)
+            publishEnv <- runSpago env (mkPublishEnv dependencyInfo purs)
             void $ runSpago publishEnv (Publish.publish {})
 
           Repl args@{ selectedPackage } -> do
@@ -548,37 +548,37 @@ main =
               , ensureRanges: false
               , testDeps: false
               }
-            dependencies <- runSpago env (Fetch.run fetchOpts)
-            supportPackages <- runSpago env (Repl.supportPackage env.workspace.packageSet)
-            replEnv <- runSpago env (mkReplEnv args (Map.union dependencies supportPackages))
+            dependencyInfo <- runSpago env (Fetch.run fetchOpts)
+            supportPackages <- runSpago env (Fetch.replSupportPackage env.workspace.packageSet)
+            replEnv <- runSpago env (mkReplEnv args (Map.union dependencyInfo.dependencies supportPackages))
             void $ runSpago replEnv Repl.run
 
           Bundle args@{ selectedPackage, ensureRanges } -> do
             { env, fetchOpts } <- mkFetchEnv { packages: mempty, selectedPackage, ensureRanges, testDeps: false }
             -- TODO: --no-fetch flag
-            dependencies <- runSpago env (Fetch.run fetchOpts)
+            dependencyInfo <- runSpago env (Fetch.run fetchOpts)
             -- TODO: --no-build flag
-            buildEnv <- runSpago env (mkBuildEnv args dependencies)
+            buildEnv <- runSpago env (mkBuildEnv args dependencyInfo)
             let options = { depsOnly: false, pursArgs: List.toUnfoldable args.pursArgs, jsonErrors: false }
             runSpago buildEnv (Build.run options)
             bundleEnv <- runSpago env (mkBundleEnv args)
             runSpago bundleEnv Bundle.run
           Run args@{ selectedPackage, ensureRanges } -> do
             { env, fetchOpts } <- mkFetchEnv { packages: mempty, selectedPackage, ensureRanges, testDeps: false }
             -- TODO: --no-fetch flag
-            dependencies <- runSpago env (Fetch.run fetchOpts)
+            dependencyInfo <- runSpago env (Fetch.run fetchOpts)
             -- TODO: --no-build flag
-            buildEnv <- runSpago env (mkBuildEnv args dependencies)
+            buildEnv <- runSpago env (mkBuildEnv args dependencyInfo)
             let options = { depsOnly: false, pursArgs: List.toUnfoldable args.pursArgs, jsonErrors: false }
             runSpago buildEnv (Build.run options)
             runEnv <- runSpago env (mkRunEnv args buildEnv)
             runSpago runEnv Run.run
           Test args@{ selectedPackage } -> do
             { env, fetchOpts } <- mkFetchEnv { packages: mempty, selectedPackage, ensureRanges: false, testDeps: false }
             -- TODO: --no-fetch flag
-            dependencies <- runSpago env (Fetch.run fetchOpts)
+            dependencyInfo <- runSpago env (Fetch.run fetchOpts)
             -- TODO: --no-build flag
-            buildEnv <- runSpago env (mkBuildEnv (Record.union args { ensureRanges: false }) dependencies)
+            buildEnv <- runSpago env (mkBuildEnv (Record.union args { ensureRanges: false }) dependencyInfo)
             let options = { depsOnly: false, pursArgs: List.toUnfoldable args.pursArgs, jsonErrors: false }
             runSpago buildEnv (Build.run options)
             testEnv <- runSpago env (mkTestEnv args buildEnv)
@@ -587,15 +587,15 @@ main =
             let fetchArgs = { packages: mempty, selectedPackage: Nothing, ensureRanges: false, testDeps: false }
             { env: env@{ workspace }, fetchOpts } <- mkFetchEnv fetchArgs
             -- TODO: --no-fetch flag
-            dependencies <- runSpago env (Fetch.run fetchOpts)
-            let lsEnv = { workspace, dependencies, logOptions }
+            dependencyInfo <- runSpago env (Fetch.run fetchOpts)
+            let lsEnv = { workspace, dependencies: dependencyInfo.dependencies, logOptions }
             runSpago lsEnv (Ls.listPackageSet args)
           LsDeps { selectedPackage, json, transitive } -> do
             let fetchArgs = { packages: mempty, selectedPackage, ensureRanges: false, testDeps: false }
             { env, fetchOpts } <- mkFetchEnv fetchArgs
             -- TODO: --no-fetch flag
-            dependencies <- runSpago env (Fetch.run fetchOpts)
-            lsEnv <- runSpago env (mkLsEnv dependencies)
+            dependencyInfo <- runSpago env (Fetch.run fetchOpts)
+            lsEnv <- runSpago env (mkLsEnv dependencyInfo.dependencies)
             runSpago lsEnv (Ls.listPackages { json, transitive })
 
 mkLogOptions :: GlobalArgs -> Aff LogOptions
@@ -757,9 +757,9 @@ mkBuildEnv
      , persistWarnings :: Maybe Boolean
      | r
      }
-  -> Map PackageName Package
+  -> Fetch.PackageDependencyInfo
   -> Spago (Fetch.FetchEnv ()) (Build.BuildEnv ())
-mkBuildEnv buildArgs dependencies = do
+mkBuildEnv buildArgs { packageDependencies, dependencies } = do
   { logOptions, workspace, git } <- ask
   purs <- Purs.getPurs
   let
@@ -788,12 +788,13 @@ mkBuildEnv buildArgs dependencies = do
     { logOptions
     , purs
     , git
+    , packageDependencies
     , dependencies
     , workspace: newWorkspace
     }
 
-mkPublishEnv :: forall a. Map PackageName Package -> Purs -> Spago (Fetch.FetchEnv a) (Publish.PublishEnv a)
-mkPublishEnv dependencies purs = do
+mkPublishEnv :: forall a. Fetch.PackageDependencyInfo -> Purs -> Spago (Fetch.FetchEnv a) (Publish.PublishEnv a)
+mkPublishEnv dependencyInfo purs = do
   env <- ask
   selected <- case env.workspace.selected of
     Just s -> pure s
@@ -810,7 +811,7 @@ mkPublishEnv dependencies purs = do
               [ toDoc "No package was selected for publishing. Please select (with -p) one of the following packages:"
               , indent (toDoc $ map _.package.name workspacePackages)
               ]
-  pure (Record.union { purs, selected, dependencies } env)
+  pure (Record.union { purs, selected } $ Record.union dependencyInfo env)
 
 mkReplEnv :: forall a. ReplArgs -> Map PackageName Package -> Spago (Fetch.FetchEnv a) (Repl.ReplEnv ())
 mkReplEnv replArgs dependencies = do

src/Spago/Command/Build.purs

@@ -9,14 +9,15 @@ import Spago.Prelude
 
 import Control.Alternative as Alternative
 import Data.Array as Array
+import Data.Either (note)
 import Data.Map as Map
 import Data.Set as Set
 import Data.Set.NonEmpty as NonEmptySet
 import Data.Tuple as Tuple
 import Registry.PackageName as PackageName
 import Spago.BuildInfo as BuildInfo
 import Spago.Cmd as Cmd
-import Spago.Config (Package(..), WithTestGlobs(..), Workspace, WorkspacePackage)
+import Spago.Config (Package(..), WithTestGlobs(..), Workspace, WorkspacePackage, PackageMap)
 import Spago.Config as Config
 import Spago.Git (Git)
 import Spago.Paths as Paths
@@ -27,7 +28,8 @@ import Spago.Purs.Graph as Graph
 type BuildEnv a =
   { purs :: Purs
   , git :: Git
-  , dependencies :: Map PackageName Package
+  , packageDependencies :: Map PackageName PackageMap
+  , dependencies :: PackageMap
   , logOptions :: LogOptions
   , workspace :: Workspace
   | a
@@ -42,13 +44,10 @@ type BuildOptions =
 run :: forall a. BuildOptions -> Spago (BuildEnv a) Unit
 run opts = do
   logInfo "Building..."
-  { dependencies
+  { packageDependencies
   , workspace
   , logOptions
   } <- ask
-  let
-    { yes: _monorepoPkgs, no: dependencyPkgs } = partition isWorkspacePackage $ Map.toUnfoldable dependencies
-    dependencyLibs = map (Tuple.uncurry Config.getPackageLocation) dependencyPkgs
 
   BuildInfo.writeBuildInfo
 
@@ -70,44 +69,6 @@ run opts = do
       , "Use the --json-errors flag for Spago."
       ]
 
-  let
-    psaArgs =
-      { libraryDirs: dependencyLibs
-      , color: logOptions.color
-      , jsonErrors: opts.jsonErrors
-      }
-    psaOptions =
-      { strict: fromMaybe Psa.defaultParseOptions.strict workspace.buildOptions.strict
-      , censorBuildWarnings: fromMaybe Psa.defaultParseOptions.censorBuildWarnings workspace.buildOptions.censorBuildWarnings
-      , showSource: fromMaybe Psa.defaultParseOptions.showSource workspace.buildOptions.showSource
-      , censorCodes: maybe Psa.defaultParseOptions.censorCodes NonEmptySet.toSet workspace.buildOptions.censorCodes
-      , filterCodes: maybe Psa.defaultParseOptions.filterCodes NonEmptySet.toSet workspace.buildOptions.filterCodes
-      , statVerbosity: fromMaybe Psa.defaultParseOptions.statVerbosity workspace.buildOptions.statVerbosity
-      , stashFile: do
-          Alternative.guard (not opts.depsOnly)
-          shouldStashWarnings <- workspace.buildOptions.persistWarnings
-          Alternative.guard shouldStashWarnings
-          case workspace.selected of
-            Just p -> Just $ Paths.mkLocalCachesPersistentWarningsFile $ PackageName.print p.package.name
-            Nothing -> Just Paths.localCachesPersistedWarningsEntireWorkspace
-      }
-    buildBackend = do
-      case workspace.backend of
-        Nothing -> pure unit
-        Just backend -> do
-          logInfo $ "Compiling with backend \"" <> backend.cmd <> "\""
-          logDebug $ "Running command `" <> backend.cmd <> "`"
-          let
-            moreBackendArgs = case backend.args of
-              Just as | Array.length as > 0 -> as
-              _ -> []
-          Cmd.exec backend.cmd (addOutputArgs moreBackendArgs) Cmd.defaultExecOptions >>= case _ of
-            Left err -> do
-              logDebug $ show err
-              die [ "Failed to build with backend " <> backend.cmd ]
-            Right _r ->
-              logSuccess "Backend build succeeded."
-
   {-
   TODO: before, then, else
       buildAction globs = do
@@ -132,31 +93,78 @@ run opts = do
           Just _ -> ""
       ]
 
-  let
-    selectedPackages = case workspace.selected of
-      Just p -> [ p ]
-      Nothing -> Config.getToplogicallySortedWorkspacePackages workspace.packageSet
+  selectedPackages :: Array (Tuple WorkspacePackage PackageMap) <- case workspace.selected of
+    Just p -> case Map.lookup p.package.name packageDependencies of
+      Just allDeps -> pure [ Tuple p allDeps ]
+      Nothing -> die [ "Internal error. Did not get transitive dependencies for selected package: " <> PackageName.print p.package.name ]
+    Nothing -> do
+      let
+        getTransDeps :: WorkspacePackage -> Either WorkspacePackage PackageMap
+        getTransDeps p = note p $ Map.lookup p.package.name packageDependencies
+
+        result :: Either WorkspacePackage (Array (Tuple WorkspacePackage PackageMap))
+        result = traverse (\p -> Tuple p <$> getTransDeps p) $ Config.getToplogicallySortedWorkspacePackages workspace.packageSet
+      case result of
+        Right a -> pure a
+        Left p -> die [ "Internal error. Did not get transitive dependencies for package: " <> PackageName.print p.package.name ]
 
   let buildingMultiplePackages = Array.length selectedPackages > 1
 
   when buildingMultiplePackages do
     logInfo
       $ append "Building packages in the following order:\n"
       $ Array.intercalate "\n"
-      $ Array.mapWithIndex (\i p -> show (i + 1) <> ") " <> PackageName.print p.package.name) selectedPackages
-  for_ selectedPackages \selected -> do
+      $ Array.mapWithIndex (\i (Tuple p _) -> show (i + 1) <> ") " <> PackageName.print p.package.name) selectedPackages
+  for_ selectedPackages \(Tuple selected allDependencies) -> do
     when buildingMultiplePackages do
       logInfo $ "Building package: " <> PackageName.print selected.package.name
     let
       globs = getBuildGlobs
-        { dependencies
+        { dependencies: allDependencies
         , depsOnly: opts.depsOnly
         , withTests: true
         , selected
         }
+      { no: dependencyPkgs :: Array _ } = partition isWorkspacePackage $ Map.toUnfoldable allDependencies
+      dependencyLibs = map (Tuple.uncurry Config.getPackageLocation) dependencyPkgs
+      psaArgs =
+        { libraryDirs: dependencyLibs
+        , color: logOptions.color
+        , jsonErrors: opts.jsonErrors
+        }
+      psaOptions =
+        { strict: fromMaybe Psa.defaultParseOptions.strict workspace.buildOptions.strict
+        , censorBuildWarnings: fromMaybe Psa.defaultParseOptions.censorBuildWarnings workspace.buildOptions.censorBuildWarnings
+        , showSource: fromMaybe Psa.defaultParseOptions.showSource workspace.buildOptions.showSource
+        , censorCodes: maybe Psa.defaultParseOptions.censorCodes NonEmptySet.toSet workspace.buildOptions.censorCodes
+        , filterCodes: maybe Psa.defaultParseOptions.filterCodes NonEmptySet.toSet workspace.buildOptions.filterCodes
+        , statVerbosity: fromMaybe Psa.defaultParseOptions.statVerbosity workspace.buildOptions.statVerbosity
+        , stashFile: do
+            Alternative.guard (not opts.depsOnly)
+            shouldStashWarnings <- workspace.buildOptions.persistWarnings
+            Alternative.guard shouldStashWarnings
+            case workspace.selected of
+              Just p -> Just $ Paths.mkLocalCachesPersistentWarningsFile $ PackageName.print p.package.name
+              Nothing -> Just Paths.localCachesPersistedWarningsEntireWorkspace
+        }
+
     Psa.psaCompile globs args psaArgs psaOptions
 
-    buildBackend
+    case workspace.backend of
+      Nothing -> pure unit
+      Just backend -> do
+        logInfo $ "Compiling with backend \"" <> backend.cmd <> "\""
+        logDebug $ "Running command `" <> backend.cmd <> "`"
+        let
+          moreBackendArgs = case backend.args of
+            Just as | Array.length as > 0 -> as
+            _ -> []
+        Cmd.exec backend.cmd (addOutputArgs moreBackendArgs) Cmd.defaultExecOptions >>= case _ of
+          Left err -> do
+            logDebug $ show err
+            die [ "Failed to build with backend " <> backend.cmd ]
+          Right _r ->
+            logSuccess "Backend build succeeded."
 
     when workspace.buildOptions.pedanticPackages do
       logInfo $ "Looking for unused and undeclared transitive dependencies..."
@@ -171,7 +179,7 @@ type BuildGlobsOptions =
   { withTests :: Boolean
   , depsOnly :: Boolean
   , selected :: WorkspacePackage
-  , dependencies :: Map PackageName Package
+  , dependencies :: PackageMap
   }
 
 getBuildGlobs :: BuildGlobsOptions -> Set FilePath
@@ -192,12 +200,7 @@ getBuildGlobs { selected, dependencies, withTests, depsOnly } =
   workspacePackageGlob :: WorkspacePackage -> Array String
   workspacePackageGlob p = Config.sourceGlob testGlobs p.package.name (WorkspacePackage p)
 
-  { yes: monorepoPkgs, no: dependencyPkgs } = partition isWorkspacePackage
-    $ Array.mapMaybe (\pkgName -> Tuple pkgName <$> Map.lookup pkgName dependencies)
-    $ Array.fromFoldable
-    $ Map.keys
-    $ unwrap
-    $ selected.package.dependencies
+  { yes: monorepoPkgs, no: dependencyPkgs } = partition isWorkspacePackage $ Map.toUnfoldable dependencies
 
   -- depsOnly means "no packages from the monorepo", so we filter out the workspace packages
   dependencyGlobs = (Tuple.uncurry $ Config.sourceGlob NoTestGlobs) =<< dependencyPkgs

src/Spago/Command/Bundle.purs

@@ -3,7 +3,6 @@ module Spago.Command.Bundle where
 import Spago.Prelude
 
 import Node.Path as Path
-import Data.String (Pattern(..), Replacement(..))
 import Data.String as String
 import Spago.Cmd as Cmd
 import Spago.Esbuild (Esbuild)