From 7dba16c2b581eabd452dc206006056212ea1e4bd Mon Sep 17 00:00:00 2001 From: Peter Becich Date: Sun, 25 Aug 2024 17:03:22 -0700 Subject: [PATCH] filesystem search stops at `.git` successfully --- src/Spago/Config.purs | 68 +++++++++++++++++++++++++------------------ src/Spago/Glob.purs | 6 +++- src/Spago/Paths.purs | 4 ++- 3 files changed, 48 insertions(+), 30 deletions(-) diff --git a/src/Spago/Config.purs b/src/Spago/Config.purs index 2c29a660a..f535827e4 100644 --- a/src/Spago/Config.purs +++ b/src/Spago/Config.purs @@ -180,7 +180,7 @@ type PrelimWorkspace = -- | packages to be integrated in the package set readWorkspace :: ∀ a. ReadWorkspaceOptions -> Spago (Registry.RegistryEnv a) Workspace readWorkspace { maybeSelectedPackage, pureBuild, migrateConfig } = do - logInfo "Reading Spago workspace configuration..." + logInfo "Reading spago.yaml..." let doMigrateConfig :: FilePath -> _ -> Spago (Registry.RegistryEnv _) Unit @@ -196,40 +196,50 @@ readWorkspace { maybeSelectedPackage, pureBuild, migrateConfig } = do higherPaths :: List FilePath higherPaths = Array.toUnfoldable $ Paths.toGitSearchPath Paths.cwd - checkForWorkspace :: forall a. FilePath - -> Spago (LogEnv a) (Maybe PrelimWorkspace) + checkForWorkspace :: forall b. FilePath + -> Spago (LogEnv b) (Maybe PrelimWorkspace) checkForWorkspace config = do - logInfo $ "Checking for workspace: " <> config + logDebug $ "Checking for workspace: " <> config result <- map (map (\y -> y.yaml)) $ readConfig config case result of Left _ -> pure Nothing Right { workspace: Nothing } -> pure Nothing Right { workspace: Just ws } -> pure (Just ws) - searchHigherPaths :: forall a. List FilePath -> Spago (LogEnv a) (Maybe (Tuple FilePath PrelimWorkspace)) + searchHigherPaths :: forall c. List FilePath -> Spago (LogEnv c) (Maybe (Tuple FilePath PrelimWorkspace)) searchHigherPaths Nil = pure Nothing searchHigherPaths (path : otherPaths) = do - mGitRoot :: Maybe String <- map Array.head $ liftAff $ Glob.gitignoringGlob path [ "./.git" ] - mYaml :: Maybe String <- map (map (\yml -> path <> yml)) $ map Array.head $ liftAff $ Glob.gitignoringGlob path [ "./spago.yaml" ] - case mYaml of - Nothing -> case mGitRoot of - Nothing -> searchHigherPaths otherPaths - Just gitRoot -> do - -- directory containing .git assumed to be the root of the project; - -- do not search up the file tree further than this - logInfo $ "No Spago workspace found in any directory up to root of project: " <> gitRoot - pure Nothing - Just foundSpagoYaml -> do - mWorkspace :: Maybe PrelimWorkspace <- checkForWorkspace foundSpagoYaml + mGitRoot :: Maybe String <- map Array.head $ liftAff $ Glob.findGitGlob path + case mGitRoot of + Nothing -> do + logDebug "No project root (.git) found at: " + logDebug path + Just gitRoot -> do + logInfo "Project root (.git) found at: " + logInfo $ path <> gitRoot + mSpagoYaml :: Maybe String <- map (map (\yml -> path <> yml)) $ map Array.head $ liftAff $ Glob.gitignoringGlob path [ "./spago.yaml" ] + + case Tuple mSpagoYaml mGitRoot of + Tuple Nothing Nothing -> searchHigherPaths otherPaths + Tuple Nothing (Just gitRoot) -> do + -- directory containing .git assumed to be the root of the project; + -- do not search up the file tree further than this + logInfo $ "No Spago workspace found in any directory up to project root: " <> path <> gitRoot + pure Nothing + Tuple (Just spagoYaml) (Just gitRoot) -> do + mWorkspace :: Maybe PrelimWorkspace <- checkForWorkspace spagoYaml case mWorkspace of - Nothing -> case mGitRoot of - Nothing -> searchHigherPaths otherPaths - Just gitRoot -> do - -- directory containing .git assumed to be the root of the project; - -- do not search up the file tree further than this - logInfo $ "No Spago workspace found in any directory up to root of project: " <> gitRoot - pure Nothing - Just ws -> pure (pure (Tuple foundSpagoYaml ws)) + Nothing -> do + -- directory containing .git assumed to be the root of the project; + -- do not search up the file tree further than this + logInfo $ "No Spago workspace found in any directory up to project root: " <> path <> gitRoot + pure Nothing + Just ws -> pure (pure (Tuple spagoYaml ws)) + Tuple (Just spagoYaml) Nothing -> do + mWorkspace :: Maybe PrelimWorkspace <- checkForWorkspace spagoYaml + case mWorkspace of + Nothing -> searchHigherPaths otherPaths + Just ws -> pure (pure (Tuple spagoYaml ws)) -- First try to read the config in the root. -- Else, look for a workspace in parent directories. @@ -244,7 +254,8 @@ readWorkspace { maybeSelectedPackage, pureBuild, migrateConfig } = do , toDoc "The configuration file help can be found here https://github.com/purescript/spago#the-configuration-file" ] Right config@{ yaml: { workspace: Nothing, package }, doc } -> do - logInfo "Looking for Spago workspace configuration higher in the filesystem, up to project root (.git)..." + logInfo "Looking for Spago workspace configuration higher in the filesystem." + logInfo $ "Search limited to " <> show Paths.gitSearchDepth <> " levels, or project root (.git)..." mHigherWorkspace <- searchHigherPaths higherPaths case mHigherWorkspace of Nothing -> @@ -255,7 +266,8 @@ readWorkspace { maybeSelectedPackage, pureBuild, migrateConfig } = do , "See the relevant documentation here: https://github.com/purescript/spago#the-workspace" ] Just (Tuple higherWorkspacePath higherWorkspace) -> do - logInfo $ "Found workspace definition in " <> higherWorkspacePath + logInfo "Found workspace definition in: " + logInfo higherWorkspacePath -- TODO migrate workspace at higher directory? doMigrateConfig "spago.yaml" config pure { workspace: higherWorkspace, package, workspaceDoc: doc } @@ -263,7 +275,7 @@ readWorkspace { maybeSelectedPackage, pureBuild, migrateConfig } = do doMigrateConfig "spago.yaml" config pure { workspace, package, workspaceDoc: doc } - logDebug "Gathering all the spago configs lower in the tree..." + logDebug "Gathering all the spago configs lower in the filesystem..." 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) ] diff --git a/src/Spago/Glob.purs b/src/Spago/Glob.purs index 29838fcea..3cdd2e3f7 100644 --- a/src/Spago/Glob.purs +++ b/src/Spago/Glob.purs @@ -3,7 +3,7 @@ -- | All of this code (and the FFI file) is a series of attempts to make globbing -- | reasonably performant while still supporting all of our usecases, like ignoring -- | files based on `.gitignore` files. -module Spago.Glob (gitignoringGlob) where +module Spago.Glob (gitignoringGlob, findGitGlob) where import Spago.Prelude @@ -207,3 +207,7 @@ fsWalk cwd ignorePatterns includePatterns = Aff.makeAff \cb -> do gitignoringGlob :: String -> Array String -> Aff (Array String) gitignoringGlob dir patterns = map (withForwardSlashes <<< Path.relative dir <<< _.path) <$> fsWalk dir [ ".git" ] patterns + +findGitGlob :: String -> Aff (Array String) +findGitGlob dir = map (withForwardSlashes <<< Path.relative dir <<< _.path) + <$> fsWalk dir mempty [ "./.git" ] diff --git a/src/Spago/Paths.purs b/src/Spago/Paths.purs index 900a297da..9e67fe150 100644 --- a/src/Spago/Paths.purs +++ b/src/Spago/Paths.purs @@ -41,8 +41,10 @@ toLocalCachePackagesPath :: FilePath -> FilePath toLocalCachePackagesPath rootDir = Path.concat [ toLocalCachePath rootDir, "p" ] -- search maximum 4 levels up the tree to find all other `spago.yaml`, which may contain workspace definition +gitSearchDepth :: Int +gitSearchDepth = 4 toGitSearchPath :: FilePath -> Array FilePath -toGitSearchPath rootDir = reverse $ makeSearchPaths rootDir 4 where +toGitSearchPath rootDir = reverse $ makeSearchPaths rootDir gitSearchDepth where makeSearchPath :: FilePath -> Int -> FilePath makeSearchPath wd i = joinWith "" $ cons wd $ cons "/" $ replicate i "../"