From 2eb05940b6a3f16cd47d9c71e05deb2befbf46f1 Mon Sep 17 00:00:00 2001
From: Peter Becich <peterbecich@gmail.com>
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 | 10 +++++-----
 src/Spago/Paths.purs  | 13 +++++++++++++
 test/Spago/Paths.purs | 20 ++++++++++++++++++++
 3 files changed, 38 insertions(+), 5 deletions(-)
 create mode 100644 test/Spago/Paths.purs

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/../../../"
+        ]