From 0edc8b21d71e37549b9ea24feca1e65ff236376e Mon Sep 17 00:00:00 2001 From: Peter Becich Date: Sat, 6 Jul 2024 22:10:49 -0700 Subject: [PATCH] search parent dirs for workspace https://github.com/purescript/spago/issues/1237 --- src/Spago/Config.purs | 53 +++++++++++++++++++++++++++++++++++++++---- src/Spago/Paths.purs | 13 +++++++++++ test/Spago/Paths.purs | 21 +++++++++++++++++ 3 files changed, 82 insertions(+), 5 deletions(-) create mode 100644 test/Spago/Paths.purs diff --git a/src/Spago/Config.purs b/src/Spago/Config.purs index a30058206..1827472cc 100644 --- a/src/Spago/Config.purs +++ b/src/Spago/Config.purs @@ -38,6 +38,7 @@ import Data.Enum as Enum import Data.Graph as Graph import Data.HTTP.Method as Method import Data.Int as Int +import Data.List (List(..), (:)) import Data.Map as Map import Data.Nullable (Nullable) import Data.Nullable as Nullable @@ -47,6 +48,7 @@ import Data.Set.NonEmpty (NonEmptySet) import Data.Set.NonEmpty as NonEmptySet import Data.String (CodePoint, Pattern(..)) import Data.String as String +import Data.Traversable (sequence) import Dodo as Log import Effect.Aff as Aff import Effect.Uncurried (EffectFn2, EffectFn3, runEffectFn2, runEffectFn3) @@ -164,6 +166,17 @@ type ReadWorkspaceOptions = , migrateConfig :: Boolean } +type PrelimWorkspace = + { backend :: Maybe Core.BackendConfig + , buildOpts :: Maybe + { censorLibraryWarnings :: Maybe Core.CensorBuildWarnings + , output :: Maybe String + , statVerbosity :: Maybe Core.StatVerbosity + } + , extraPackages :: Maybe (Map PackageName Core.ExtraPackage) + , packageSet :: Maybe Core.SetAddress + } + -- | Reads all the configurations in the tree and builds up the Map of local -- | packages to be integrated in the package set readWorkspace :: ∀ a. ReadWorkspaceOptions -> Spago (Registry.RegistryEnv a) Workspace @@ -180,6 +193,36 @@ readWorkspace { maybeSelectedPackage, pureBuild, migrateConfig } = do false, true -> logWarn $ "Your " <> path <> " is using an outdated format. Run Spago with the --migrate flag to update it to the latest version." _, false -> pure unit + logInfo "Gathering all the spago configs higher in the tree..." + let + higherPaths :: List FilePath + higherPaths = Array.toUnfoldable $ Paths.toGitSearchPath Paths.cwd + + checkForWorkspace :: forall a. FilePath + -> Spago (LogEnv a) (Maybe PrelimWorkspace) + checkForWorkspace config = do + result <- readConfig config + case result of + Left _ -> pure Nothing + Right { yaml: { workspace: Nothing } } -> pure Nothing + Right { yaml: { workspace: Just ws } } -> pure (Just ws) + + searchHigherPaths :: forall a. List FilePath -> Spago (LogEnv a) (Maybe PrelimWorkspace) + searchHigherPaths Nil = pure Nothing + searchHigherPaths (path : otherPaths) = do + mYaml :: Maybe String <- map Array.head $ liftAff $ Glob.gitignoringGlob path [ "./spago.yaml" ] + case mYaml of + Nothing -> searchHigherPaths otherPaths + Just foundSpagoYaml -> do + mWorkspace :: Maybe PrelimWorkspace <- checkForWorkspace foundSpagoYaml + case mWorkspace of + Nothing -> searchHigherPaths otherPaths + workspace -> pure workspace + + mHigherConfigPath <- searchHigherPaths higherPaths + for_ mHigherConfigPath $ \higherConfigPath -> do + logDebug $ [ toDoc "Found workspace at higher path:" ] + -- First try to read the config in the root. It _has_ to contain a workspace -- configuration, or we fail early. { workspace, package: maybePackage, workspaceDoc } <- readConfig "spago.yaml" >>= case _ of @@ -199,10 +242,10 @@ readWorkspace { maybeSelectedPackage, pureBuild, migrateConfig } = do doMigrateConfig "spago.yaml" config pure { workspace, package, workspaceDoc: doc } - logDebug "Gathering all the spago configs in the tree..." - otherConfigPaths <- liftAff $ Glob.gitignoringGlob Paths.cwd [ "**/spago.yaml" ] - unless (Array.null otherConfigPaths) do - logDebug $ [ toDoc "Found packages at these paths:", Log.indent $ Log.lines (map toDoc otherConfigPaths) ] + logDebug "Gathering all the spago configs lower in the tree..." + otherLowerConfigPaths <- liftAff $ Glob.gitignoringGlob Paths.cwd [ "**/spago.yaml" ] + unless (Array.null otherLowerConfigPaths) do + logDebug $ [ toDoc "Found packages at these lower paths:", Log.indent $ Log.lines (map toDoc otherLowerConfigPaths) ] -- We read all of them in, and only read the package section, if any. let @@ -220,7 +263,7 @@ readWorkspace { maybeSelectedPackage, pureBuild, migrateConfig } = do Right config -> do Right { config, hasTests, configPath: path, packagePath: Path.dirname path } - { right: otherPackages, left: failedPackages } <- partitionMap identity <$> traverse readWorkspaceConfig otherConfigPaths + { right: otherPackages, left: failedPackages } <- partitionMap identity <$> traverse readWorkspaceConfig otherLowerConfigPaths unless (Array.null failedPackages) do logWarn $ [ toDoc "Failed to read some configs:" ] <> failedPackages diff --git a/src/Spago/Paths.purs b/src/Spago/Paths.purs index 224b004f3..2ec27255e 100644 --- a/src/Spago/Paths.purs +++ b/src/Spago/Paths.purs @@ -6,6 +6,8 @@ import Effect.Unsafe (unsafePerformEffect) import Node.Path (FilePath) import Node.Path as Path import Node.Process as Process +import Data.Array (cons, replicate, reverse) +import Data.String (joinWith) type NodePaths = { config :: FilePath @@ -38,6 +40,17 @@ toLocalCachePath rootDir = Path.concat [ rootDir, ".spago" ] toLocalCachePackagesPath :: FilePath -> FilePath toLocalCachePackagesPath rootDir = Path.concat [ toLocalCachePath rootDir, "p" ] +-- search maximum 4 levels up the tree to find the Git project, if it exists +toGitSearchPath :: FilePath -> Array FilePath +toGitSearchPath rootDir = reverse $ makeSearchPaths rootDir 2 where + makeSearchPath :: FilePath -> Int -> FilePath + makeSearchPath wd i = joinWith "" $ cons wd $ cons "/" $ replicate i "../" + + makeSearchPaths :: FilePath -> Int -> Array FilePath + makeSearchPaths wd 0 = pure wd + makeSearchPaths wd i | i > 0 = cons (makeSearchPath wd i) (makeSearchPaths wd (i - 1)) + makeSearchPaths _ _ = mempty + registryPath ∷ FilePath registryPath = Path.concat [ globalCachePath, "registry" ] diff --git a/test/Spago/Paths.purs b/test/Spago/Paths.purs new file mode 100644 index 000000000..fa4c5bf9f --- /dev/null +++ b/test/Spago/Paths.purs @@ -0,0 +1,21 @@ +module Test.Spago.Paths where + +import Test.Prelude + +import Test.Spec (Spec) +import Test.Spec as Spec +import Test.Spec.Assertions as Assert + +import Spago.Paths (toGitSearchPath) + +spec :: Spec Unit +spec = Spec.around withTempDir do + Spec.describe "paths" do + Spec.it "generate four paths to parent directories of working directory, plus working directory" \ _ -> do + toGitSearchPath "~/a/b/c/d/e" `Assert.shouldEqual` + [ "~/a/b/c/d/e" + , "~/a/b/c/d/e/../" + , "~/a/b/c/d/e/../../" + , "~/a/b/c/d/e/../../../" + , "~/a/b/c/d/e/../../../../" + ]