search parent dirs for workspace

purescript#1237

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
 

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" ]
 

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