diff --git a/src/Spago/Config.purs b/src/Spago/Config.purs index e0f0444fb..6c841e2c0 100644 --- a/src/Spago/Config.purs +++ b/src/Spago/Config.purs @@ -199,10 +199,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 +220,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..4885a2ede 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) +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 = makeSearchPaths rootDir 4 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..d49dbb37e --- /dev/null +++ b/test/Spago/Paths.purs @@ -0,0 +1,20 @@ +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" \ _ -> 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/../../../" + ]